Skip to content

Commit

Permalink
implement explicit URL downloading in 'stack new'
Browse files Browse the repository at this point in the history
  • Loading branch information
kadoban committed Dec 17, 2015
1 parent 1a221be commit c6c6638
Showing 1 changed file with 22 additions and 11 deletions.
33 changes: 22 additions & 11 deletions src/Stack/New.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ import Data.Conduit
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.Maybe.Extra (mapMaybeM)
import Data.Monoid
import Data.Set (Set)
Expand Down Expand Up @@ -112,27 +113,36 @@ loadTemplate
:: forall m r.
(HasConfig r, HasHttpManager r, MonadReader r m, MonadIO m, MonadThrow m, MonadCatch m)
=> TemplateName -> m Text
loadTemplate name =
loadTemplate name = do
templateDir <- templatesDir <$> asks getConfig
case templatePath name of
Left absFile -> loadLocalFile absFile
Right relFile ->
AbsPath absFile -> loadLocalFile absFile
UrlPath s -> do
let req = fromMaybe (error "impossible happened: already valid \
\URL couldn't be parsed")
(parseUrl s)
rel = fromMaybe backupUrlRelPath (parseRelFile s)
downloadTemplate req (templateDir </> rel)
RelPath relFile ->
catch
(loadLocalFile relFile)
(\(_ :: NewException) ->
downloadTemplate relFile)
(\(e :: NewException) ->
case relRequest relFile of
Just req -> downloadTemplate req
(templateDir </> relFile)
Nothing -> throwM e
)
where
loadLocalFile :: Path b File -> m Text
loadLocalFile path = do
exists <- fileExists path
if exists
then liftIO (T.readFile (toFilePath path))
else throwM (FailedToLoadTemplate name (toFilePath path))
downloadTemplate :: Path Rel File -> m Text
downloadTemplate rel = do
config <- asks getConfig
req <- parseUrl (defaultTemplateUrl <> "/" <> toFilePath rel)
let path :: Path Abs File
path = templatesDir config </> rel
relRequest :: MonadThrow n => Path Rel File -> n Request
relRequest rel = parseUrl (defaultTemplateUrl <> "/" <> toFilePath rel)
downloadTemplate :: Request -> Path Abs File -> m Text
downloadTemplate req path = do
_ <-
catch
(redownload req path)
Expand All @@ -141,6 +151,7 @@ loadTemplate name =
if exists
then liftIO (T.readFile (toFilePath path))
else throwM (FailedToLoadTemplate name (toFilePath path))
backupUrlRelPath = $(mkRelFile "downloaded.template.file.hsfiles")

-- | Apply and unpack a template into a directory.
applyTemplate
Expand Down

0 comments on commit c6c6638

Please sign in to comment.