{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Template name handling.

module Stack.Types.TemplateName
  ( TemplateName
  , RepoTemplatePath (..)
  , RepoService (..)
  , TemplatePath (..)
  , templateName
  , templatePath
  , parseTemplateNameFromString
  , parseRepoPathWithService
  , templateNameArgument
  , templateParamArgument
  , defaultTemplateName
  ) where

import           Data.Aeson ( FromJSON (..), withText )
import qualified Data.Text as T
import           Network.HTTP.StackClient ( parseRequest )
import qualified Options.Applicative as O
import           Path ( parseAbsFile, parseRelFile )
import           Stack.Prelude

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Types.TemplateName" module.

newtype TypeTemplateNameException
  = DefaultTemplateNameNotParsedBug String
  deriving (Int -> TypeTemplateNameException -> ShowS
[TypeTemplateNameException] -> ShowS
TypeTemplateNameException -> String
(Int -> TypeTemplateNameException -> ShowS)
-> (TypeTemplateNameException -> String)
-> ([TypeTemplateNameException] -> ShowS)
-> Show TypeTemplateNameException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeTemplateNameException -> ShowS
showsPrec :: Int -> TypeTemplateNameException -> ShowS
$cshow :: TypeTemplateNameException -> String
show :: TypeTemplateNameException -> String
$cshowList :: [TypeTemplateNameException] -> ShowS
showList :: [TypeTemplateNameException] -> ShowS
Show, Typeable)

instance Exception TypeTemplateNameException where
  displayException :: TypeTemplateNameException -> String
displayException (DefaultTemplateNameNotParsedBug String
s) = String -> ShowS
bugReport String
"[S-7410]" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"Cannot parse default template name: "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | A template name.

data TemplateName
  = TemplateName !Text !TemplatePath
  deriving (TemplateName -> TemplateName -> Bool
(TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool) -> Eq TemplateName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateName -> TemplateName -> Bool
== :: TemplateName -> TemplateName -> Bool
$c/= :: TemplateName -> TemplateName -> Bool
/= :: TemplateName -> TemplateName -> Bool
Eq, Eq TemplateName
Eq TemplateName
-> (TemplateName -> TemplateName -> Ordering)
-> (TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> TemplateName)
-> (TemplateName -> TemplateName -> TemplateName)
-> Ord TemplateName
TemplateName -> TemplateName -> Bool
TemplateName -> TemplateName -> Ordering
TemplateName -> TemplateName -> TemplateName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TemplateName -> TemplateName -> Ordering
compare :: TemplateName -> TemplateName -> Ordering
$c< :: TemplateName -> TemplateName -> Bool
< :: TemplateName -> TemplateName -> Bool
$c<= :: TemplateName -> TemplateName -> Bool
<= :: TemplateName -> TemplateName -> Bool
$c> :: TemplateName -> TemplateName -> Bool
> :: TemplateName -> TemplateName -> Bool
$c>= :: TemplateName -> TemplateName -> Bool
>= :: TemplateName -> TemplateName -> Bool
$cmax :: TemplateName -> TemplateName -> TemplateName
max :: TemplateName -> TemplateName -> TemplateName
$cmin :: TemplateName -> TemplateName -> TemplateName
min :: TemplateName -> TemplateName -> TemplateName
Ord, Int -> TemplateName -> ShowS
[TemplateName] -> ShowS
TemplateName -> String
(Int -> TemplateName -> ShowS)
-> (TemplateName -> String)
-> ([TemplateName] -> ShowS)
-> Show TemplateName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateName -> ShowS
showsPrec :: Int -> TemplateName -> ShowS
$cshow :: TemplateName -> String
show :: TemplateName -> String
$cshowList :: [TemplateName] -> ShowS
showList :: [TemplateName] -> ShowS
Show)

data TemplatePath
  = AbsPath (Path Abs File)
    -- ^ an absolute path on the filesystem

  | RelPath String (Path Rel File)
    -- ^ a relative path on the filesystem, or relative to the template

    -- repository. To avoid path separator conversion on Windows, the raw

    -- command-line parameter passed is also given as the first field (possibly

    -- with @.hsfiles@ appended).

  | UrlPath String
    -- ^ a full URL

  | RepoPath RepoTemplatePath
  deriving (TemplatePath -> TemplatePath -> Bool
(TemplatePath -> TemplatePath -> Bool)
-> (TemplatePath -> TemplatePath -> Bool) -> Eq TemplatePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplatePath -> TemplatePath -> Bool
== :: TemplatePath -> TemplatePath -> Bool
$c/= :: TemplatePath -> TemplatePath -> Bool
/= :: TemplatePath -> TemplatePath -> Bool
Eq, Eq TemplatePath
Eq TemplatePath
-> (TemplatePath -> TemplatePath -> Ordering)
-> (TemplatePath -> TemplatePath -> Bool)
-> (TemplatePath -> TemplatePath -> Bool)
-> (TemplatePath -> TemplatePath -> Bool)
-> (TemplatePath -> TemplatePath -> Bool)
-> (TemplatePath -> TemplatePath -> TemplatePath)
-> (TemplatePath -> TemplatePath -> TemplatePath)
-> Ord TemplatePath
TemplatePath -> TemplatePath -> Bool
TemplatePath -> TemplatePath -> Ordering
TemplatePath -> TemplatePath -> TemplatePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TemplatePath -> TemplatePath -> Ordering
compare :: TemplatePath -> TemplatePath -> Ordering
$c< :: TemplatePath -> TemplatePath -> Bool
< :: TemplatePath -> TemplatePath -> Bool
$c<= :: TemplatePath -> TemplatePath -> Bool
<= :: TemplatePath -> TemplatePath -> Bool
$c> :: TemplatePath -> TemplatePath -> Bool
> :: TemplatePath -> TemplatePath -> Bool
$c>= :: TemplatePath -> TemplatePath -> Bool
>= :: TemplatePath -> TemplatePath -> Bool
$cmax :: TemplatePath -> TemplatePath -> TemplatePath
max :: TemplatePath -> TemplatePath -> TemplatePath
$cmin :: TemplatePath -> TemplatePath -> TemplatePath
min :: TemplatePath -> TemplatePath -> TemplatePath
Ord, Int -> TemplatePath -> ShowS
[TemplatePath] -> ShowS
TemplatePath -> String
(Int -> TemplatePath -> ShowS)
-> (TemplatePath -> String)
-> ([TemplatePath] -> ShowS)
-> Show TemplatePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplatePath -> ShowS
showsPrec :: Int -> TemplatePath -> ShowS
$cshow :: TemplatePath -> String
show :: TemplatePath -> String
$cshowList :: [TemplatePath] -> ShowS
showList :: [TemplatePath] -> ShowS
Show)

-- | Details for how to access a template from a remote repo.

data RepoTemplatePath = RepoTemplatePath
  { RepoTemplatePath -> RepoService
rtpService  :: RepoService
  , RepoTemplatePath -> Text
rtpUser     :: Text
  , RepoTemplatePath -> Text
rtpTemplate :: Text
  }
  deriving (RepoTemplatePath -> RepoTemplatePath -> Bool
(RepoTemplatePath -> RepoTemplatePath -> Bool)
-> (RepoTemplatePath -> RepoTemplatePath -> Bool)
-> Eq RepoTemplatePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoTemplatePath -> RepoTemplatePath -> Bool
== :: RepoTemplatePath -> RepoTemplatePath -> Bool
$c/= :: RepoTemplatePath -> RepoTemplatePath -> Bool
/= :: RepoTemplatePath -> RepoTemplatePath -> Bool
Eq, Eq RepoTemplatePath
Eq RepoTemplatePath
-> (RepoTemplatePath -> RepoTemplatePath -> Ordering)
-> (RepoTemplatePath -> RepoTemplatePath -> Bool)
-> (RepoTemplatePath -> RepoTemplatePath -> Bool)
-> (RepoTemplatePath -> RepoTemplatePath -> Bool)
-> (RepoTemplatePath -> RepoTemplatePath -> Bool)
-> (RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath)
-> (RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath)
-> Ord RepoTemplatePath
RepoTemplatePath -> RepoTemplatePath -> Bool
RepoTemplatePath -> RepoTemplatePath -> Ordering
RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RepoTemplatePath -> RepoTemplatePath -> Ordering
compare :: RepoTemplatePath -> RepoTemplatePath -> Ordering
$c< :: RepoTemplatePath -> RepoTemplatePath -> Bool
< :: RepoTemplatePath -> RepoTemplatePath -> Bool
$c<= :: RepoTemplatePath -> RepoTemplatePath -> Bool
<= :: RepoTemplatePath -> RepoTemplatePath -> Bool
$c> :: RepoTemplatePath -> RepoTemplatePath -> Bool
> :: RepoTemplatePath -> RepoTemplatePath -> Bool
$c>= :: RepoTemplatePath -> RepoTemplatePath -> Bool
>= :: RepoTemplatePath -> RepoTemplatePath -> Bool
$cmax :: RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath
max :: RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath
$cmin :: RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath
min :: RepoTemplatePath -> RepoTemplatePath -> RepoTemplatePath
Ord, Int -> RepoTemplatePath -> ShowS
[RepoTemplatePath] -> ShowS
RepoTemplatePath -> String
(Int -> RepoTemplatePath -> ShowS)
-> (RepoTemplatePath -> String)
-> ([RepoTemplatePath] -> ShowS)
-> Show RepoTemplatePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoTemplatePath -> ShowS
showsPrec :: Int -> RepoTemplatePath -> ShowS
$cshow :: RepoTemplatePath -> String
show :: RepoTemplatePath -> String
$cshowList :: [RepoTemplatePath] -> ShowS
showList :: [RepoTemplatePath] -> ShowS
Show)

-- | Services from which templates can be retrieved from a repository.

data RepoService
  = GitHub
  | GitLab
  | Bitbucket
  deriving (RepoService -> RepoService -> Bool
(RepoService -> RepoService -> Bool)
-> (RepoService -> RepoService -> Bool) -> Eq RepoService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoService -> RepoService -> Bool
== :: RepoService -> RepoService -> Bool
$c/= :: RepoService -> RepoService -> Bool
/= :: RepoService -> RepoService -> Bool
Eq, Eq RepoService
Eq RepoService
-> (RepoService -> RepoService -> Ordering)
-> (RepoService -> RepoService -> Bool)
-> (RepoService -> RepoService -> Bool)
-> (RepoService -> RepoService -> Bool)
-> (RepoService -> RepoService -> Bool)
-> (RepoService -> RepoService -> RepoService)
-> (RepoService -> RepoService -> RepoService)
-> Ord RepoService
RepoService -> RepoService -> Bool
RepoService -> RepoService -> Ordering
RepoService -> RepoService -> RepoService
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RepoService -> RepoService -> Ordering
compare :: RepoService -> RepoService -> Ordering
$c< :: RepoService -> RepoService -> Bool
< :: RepoService -> RepoService -> Bool
$c<= :: RepoService -> RepoService -> Bool
<= :: RepoService -> RepoService -> Bool
$c> :: RepoService -> RepoService -> Bool
> :: RepoService -> RepoService -> Bool
$c>= :: RepoService -> RepoService -> Bool
>= :: RepoService -> RepoService -> Bool
$cmax :: RepoService -> RepoService -> RepoService
max :: RepoService -> RepoService -> RepoService
$cmin :: RepoService -> RepoService -> RepoService
min :: RepoService -> RepoService -> RepoService
Ord, Int -> RepoService -> ShowS
[RepoService] -> ShowS
RepoService -> String
(Int -> RepoService -> ShowS)
-> (RepoService -> String)
-> ([RepoService] -> ShowS)
-> Show RepoService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoService -> ShowS
showsPrec :: Int -> RepoService -> ShowS
$cshow :: RepoService -> String
show :: RepoService -> String
$cshowList :: [RepoService] -> ShowS
showList :: [RepoService] -> ShowS
Show)

instance FromJSON TemplateName where
  parseJSON :: Value -> Parser TemplateName
parseJSON = String
-> (Text -> Parser TemplateName) -> Value -> Parser TemplateName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TemplateName" ((Text -> Parser TemplateName) -> Value -> Parser TemplateName)
-> (Text -> Parser TemplateName) -> Value -> Parser TemplateName
forall a b. (a -> b) -> a -> b
$
    (String -> Parser TemplateName)
-> (TemplateName -> Parser TemplateName)
-> Either String TemplateName
-> Parser TemplateName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser TemplateName
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail TemplateName -> Parser TemplateName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String TemplateName -> Parser TemplateName)
-> (Text -> Either String TemplateName)
-> Text
-> Parser TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String TemplateName
parseTemplateNameFromString (String -> Either String TemplateName)
-> (Text -> String) -> Text -> Either String TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | An argument which accepts a template name of the format @foo.hsfiles@ or

-- @foo@, ultimately normalized to @foo@.

templateNameArgument :: O.Mod O.ArgumentFields TemplateName
                     -> O.Parser TemplateName
templateNameArgument :: Mod ArgumentFields TemplateName -> Parser TemplateName
templateNameArgument =
  ReadM TemplateName
-> Mod ArgumentFields TemplateName -> Parser TemplateName
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
O.argument
    (do String
s <- ReadM String
forall s. IsString s => ReadM s
O.str
        (String -> ReadM TemplateName)
-> (TemplateName -> ReadM TemplateName)
-> Either String TemplateName
-> ReadM TemplateName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReadM TemplateName
forall a. String -> ReadM a
O.readerError TemplateName -> ReadM TemplateName
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String TemplateName
parseTemplateNameFromString String
s))

-- | An argument which accepts a @key:value@ pair for specifying parameters.

templateParamArgument :: O.Mod O.OptionFields (Text,Text)
                      -> O.Parser (Text,Text)
templateParamArgument :: Mod OptionFields (Text, Text) -> Parser (Text, Text)
templateParamArgument =
  ReadM (Text, Text)
-> Mod OptionFields (Text, Text) -> Parser (Text, Text)
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    (do String
s <- ReadM String
forall s. IsString s => ReadM s
O.str
        (String -> ReadM (Text, Text))
-> ((Text, Text) -> ReadM (Text, Text))
-> Either String (Text, Text)
-> ReadM (Text, Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReadM (Text, Text)
forall a. String -> ReadM a
O.readerError (Text, Text) -> ReadM (Text, Text)
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Text, Text)
parsePair String
s))
 where
  parsePair :: String -> Either String (Text, Text)
  parsePair :: String -> Either String (Text, Text)
parsePair String
s =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
s of
      (String
key,Char
':':value :: String
value@(Char
_:String
_)) -> (Text, Text) -> Either String (Text, Text)
forall a b. b -> Either a b
Right (String -> Text
T.pack String
key, String -> Text
T.pack String
value)
      (String, String)
_ -> String -> Either String (Text, Text)
forall a b. a -> Either a b
Left (String
"Expected key:value format for argument: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s)

-- | Parse a template name from a string.

parseTemplateNameFromString :: String -> Either String TemplateName
parseTemplateNameFromString :: String -> Either String TemplateName
parseTemplateNameFromString String
fname =
  case Text -> Text -> Maybe Text
T.stripSuffix Text
".hsfiles" (String -> Text
T.pack String
fname) of
    Maybe Text
Nothing -> Text -> String -> String -> Either String TemplateName
parseValidFile (String -> Text
T.pack String
fname) (String
fname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".hsfiles") String
fname
    Just Text
prefix -> Text -> String -> String -> Either String TemplateName
parseValidFile Text
prefix String
fname String
fname
 where
  parseValidFile :: Text -> String -> String -> Either String TemplateName
parseValidFile Text
prefix String
hsf String
orig =
    Either String TemplateName
-> (TemplateName -> Either String TemplateName)
-> Maybe TemplateName
-> Either String TemplateName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String TemplateName
forall a b. a -> Either a b
Left String
expected) TemplateName -> Either String TemplateName
forall a b. b -> Either a b
Right (Maybe TemplateName -> Either String TemplateName)
-> Maybe TemplateName -> Either String TemplateName
forall a b. (a -> b) -> a -> b
$ [Maybe TemplateName] -> Maybe TemplateName
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (Text -> String -> String -> [Maybe TemplateName]
validParses Text
prefix String
hsf String
orig)
  validParses :: Text -> String -> String -> [Maybe TemplateName]
validParses Text
prefix String
hsf String
orig =
    -- NOTE: order is important

    [ Text -> TemplatePath -> TemplateName
TemplateName Text
prefix        (TemplatePath -> TemplateName)
-> (RepoTemplatePath -> TemplatePath)
-> RepoTemplatePath
-> TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoTemplatePath -> TemplatePath
RepoPath (RepoTemplatePath -> TemplateName)
-> Maybe RepoTemplatePath -> Maybe TemplateName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe RepoTemplatePath
parseRepoPath String
hsf
    , Text -> TemplatePath -> TemplateName
TemplateName (String -> Text
T.pack String
orig) (TemplatePath -> TemplateName)
-> (String -> TemplatePath) -> String -> TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TemplatePath
UrlPath (String -> TemplateName) -> Maybe String -> Maybe TemplateName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
orig Maybe Request -> Maybe String -> Maybe String
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Maybe String
forall a. a -> Maybe a
Just String
orig)
    , Text -> TemplatePath -> TemplateName
TemplateName Text
prefix        (TemplatePath -> TemplateName)
-> (Path Abs File -> TemplatePath) -> Path Abs File -> TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> TemplatePath
AbsPath (Path Abs File -> TemplateName)
-> Maybe (Path Abs File) -> Maybe TemplateName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
hsf
    , Text -> TemplatePath -> TemplateName
TemplateName Text
prefix        (TemplatePath -> TemplateName)
-> (Path Rel File -> TemplatePath) -> Path Rel File -> TemplateName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Rel File -> TemplatePath
RelPath String
hsf (Path Rel File -> TemplateName)
-> Maybe (Path Rel File) -> Maybe TemplateName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
hsf
    ]
  expected :: String
expected = String
"Expected a template like: foo or foo.hsfiles or \
             \https://example.com/foo.hsfiles or github:user/foo"

-- | The default template name you can use if you don't have one.

defaultTemplateName :: TemplateName
defaultTemplateName :: TemplateName
defaultTemplateName =
  case String -> Either String TemplateName
parseTemplateNameFromString String
"new-template" of
    Left String
s -> TypeTemplateNameException -> TemplateName
forall e a. Exception e => e -> a
impureThrow (TypeTemplateNameException -> TemplateName)
-> TypeTemplateNameException -> TemplateName
forall a b. (a -> b) -> a -> b
$ String -> TypeTemplateNameException
DefaultTemplateNameNotParsedBug String
s
    Right TemplateName
x -> TemplateName
x

-- | Get a text representation of the template name.

templateName :: TemplateName -> Text
templateName :: TemplateName -> Text
templateName (TemplateName Text
prefix TemplatePath
_) = Text
prefix

-- | Get the path of the template.

templatePath :: TemplateName -> TemplatePath
templatePath :: TemplateName -> TemplatePath
templatePath (TemplateName Text
_ TemplatePath
fp) = TemplatePath
fp

defaultRepoUserForService :: RepoService -> Maybe Text
defaultRepoUserForService :: RepoService -> Maybe Text
defaultRepoUserForService RepoService
GitHub = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"commercialhaskell"
defaultRepoUserForService RepoService
_      = Maybe Text
forall a. Maybe a
Nothing

-- | Parses a template path of the form @github:user/template@.

parseRepoPath :: String -> Maybe RepoTemplatePath
parseRepoPath :: String -> Maybe RepoTemplatePath
parseRepoPath String
s =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" (String -> Text
T.pack String
s) of
    [Text
"github"    , Text
rest] -> RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService RepoService
GitHub Text
rest
    [Text
"gitlab"    , Text
rest] -> RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService RepoService
GitLab Text
rest
    [Text
"bitbucket" , Text
rest] -> RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService RepoService
Bitbucket Text
rest
    [Text]
_                    -> Maybe RepoTemplatePath
forall a. Maybe a
Nothing

-- | Parses a template path of the form @user/template@, given a service

parseRepoPathWithService :: RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService :: RepoService -> Text -> Maybe RepoTemplatePath
parseRepoPathWithService RepoService
service Text
path =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
path of
    [Text
user, Text
name] -> RepoTemplatePath -> Maybe RepoTemplatePath
forall a. a -> Maybe a
Just (RepoTemplatePath -> Maybe RepoTemplatePath)
-> RepoTemplatePath -> Maybe RepoTemplatePath
forall a b. (a -> b) -> a -> b
$ RepoService -> Text -> Text -> RepoTemplatePath
RepoTemplatePath RepoService
service Text
user Text
name
    [Text
name] -> do
      Text
repoUser <- RepoService -> Maybe Text
defaultRepoUserForService RepoService
service
      RepoTemplatePath -> Maybe RepoTemplatePath
forall a. a -> Maybe a
Just (RepoTemplatePath -> Maybe RepoTemplatePath)
-> RepoTemplatePath -> Maybe RepoTemplatePath
forall a b. (a -> b) -> a -> b
$ RepoService -> Text -> Text -> RepoTemplatePath
RepoTemplatePath RepoService
service Text
repoUser Text
name
    [Text]
_ -> Maybe RepoTemplatePath
forall a. Maybe a
Nothing