Skip to content
Permalink
Browse files

Support Gitlab and Bitbucket for project template files

  • Loading branch information...
johnmendonca committed Jun 7, 2018
1 parent fdcfc70 commit 6bb37bbba07d912da1304244ecbd2ce241c2c3eb
Showing with 27 additions and 26 deletions.
  1. +5 −5 src/Stack/New.hs
  2. +22 −21 src/Stack/Types/TemplateName.hs
@@ -153,7 +153,7 @@ loadTemplate name logIt = do
else throwM (FailedToLoadTemplate name (toFilePath path))
relRequest :: Path Rel File -> Maybe Request
relRequest rel = do
rtp <- parseRepoPathWithService defaultRepoService (toFilePath rel)
rtp <- parseRepoPathWithService defaultRepoService (T.pack (toFilePath rel))
let url = urlFromRepoTemplatePath rtp
parseRequest (T.unpack url)
downloadFromUrl :: String -> Path Abs Dir -> RIO env Text
@@ -175,6 +175,10 @@ loadTemplate name logIt = do
urlFromRepoTemplatePath :: RepoTemplatePath -> Text
urlFromRepoTemplatePath (RepoTemplatePath Github user name) =
T.concat ["https://raw.githubusercontent.com", "/", user, "/stack-templates/master/", name]
urlFromRepoTemplatePath (RepoTemplatePath Gitlab user name) =
T.concat ["https://gitlab.com", "/", user, "/stack-templates/raw/master/", name]
urlFromRepoTemplatePath (RepoTemplatePath Bitbucket user name) =
T.concat ["https://bitbucket.org", "/", user, "/stack-templates/raw/master/", name]

-- | Apply and unpack a template into a directory.
applyTemplate
@@ -337,10 +341,6 @@ parseTemplateSet a = do
defaultTemplateName :: TemplateName
defaultTemplateName = $(mkTemplateName "new-template")

-- | The default service to use to download templates.
defaultRepoService :: RepoService
defaultRepoService = Github

-- | Default web URL to get a yaml file containing template metadata.
defaultTemplateInfoUrl :: String
defaultTemplateInfoUrl =
@@ -42,7 +42,7 @@ data RepoTemplatePath = RepoTemplatePath
deriving (Eq, Ord, Show)

-- | Services from which templates can be retrieved from a repository.
data RepoService = Github
data RepoService = Github | Gitlab | Bitbucket
deriving (Eq, Ord, Show)

instance FromJSON TemplateName where
@@ -114,7 +114,9 @@ mkTemplateName s =
UrlPath fp -> [|UrlPath fp|]
RepoPath (RepoTemplatePath sv u t) ->
case sv of
Github -> [|RepoTemplatePath Github u t|]
Github -> [|RepoPath $ RepoTemplatePath Github u t|]
Gitlab -> [|RepoPath $ RepoTemplatePath Gitlab u t|]
Bitbucket -> [|RepoPath $ RepoTemplatePath Bitbucket u t|]

-- | Get a text representation of the template name.
templateName :: TemplateName -> Text
@@ -124,29 +126,28 @@ templateName (TemplateName prefix _) = prefix
templatePath :: TemplateName -> TemplatePath
templatePath (TemplateName _ fp) = fp

-- | The default service to use to download templates.
defaultRepoService :: RepoService
defaultRepoService = Github

defaultRepoUser :: Text
defaultRepoUser = "commercialhaskell"

-- | Parses a template path of the form @github:user/template@.
parseRepoPath :: FilePath -> Maybe RepoTemplatePath
parseRepoPath path =
case T.stripPrefix "github:" (T.pack path) of
Just strippedPath ->
parseRepoPathWithService Github (T.unpack strippedPath)
_ -> Nothing
parseRepoPath :: String -> Maybe RepoTemplatePath
parseRepoPath s =
case T.splitOn ":" (T.pack s) of
["github" , rest] -> parseRepoPathWithService Github rest
["gitlab" , rest] -> parseRepoPathWithService Gitlab rest
["bitbucket" , rest] -> parseRepoPathWithService Bitbucket rest
[rest] -> parseRepoPathWithService defaultRepoService rest

This comment has been minimized.

Copy link
@lylek

lylek Jun 17, 2018

Owner

This line will break TEMPLATE_NAMEs in the form https://... because it will try to read them as repo requests, and, not matching "https", will default to Github. You should remove this line and move the definition of defaultRepoService back to New.hs. That's the place to do the defaulting.

_ -> Nothing

-- | Parses a template path of the form @user/template@, assuming the default service.
parseRepoPathWithService :: RepoService -> FilePath -> Maybe RepoTemplatePath
parseRepoPathWithService :: RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService service path =
case T.split (== '/') (T.pack path) of
[tname] -> Just $ RepoTemplatePath
{ rtpService = service
, rtpUser = defaultRepoUser
, rtpTemplate = tname
}
[user, tname] -> Just $ RepoTemplatePath
{ rtpService = service
, rtpUser = user
, rtpTemplate = tname
}
_ -> Nothing
case T.splitOn "/" path of
[user, name] -> Just $ RepoTemplatePath service user name
[name] -> Just $ RepoTemplatePath service defaultRepoUser name
_ -> Nothing

0 comments on commit 6bb37bb

Please sign in to comment.
You can’t perform that action at this time.