{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.NewParser
  ( newOptsParser
  ) where

import qualified Data.Map.Strict as M
import           Options.Applicative
                   ( Parser, help, long, metavar, short, switch )
import           Stack.Init ( InitOpts )
import           Stack.New ( NewOpts (..) )
import           Stack.Options.InitParser ( initOptsParser )
import           Stack.Prelude
import           Stack.Types.PackageName ( packageNameArgument )
import           Stack.Types.TemplateName
                   ( templateNameArgument, templateParamArgument )

-- | Parser for @stack new@.

newOptsParser :: Parser (NewOpts, InitOpts)
newOptsParser :: Parser (NewOpts, InitOpts)
newOptsParser = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NewOpts
newOpts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InitOpts
initOptsParser
 where
  newOpts :: Parser NewOpts
newOpts = PackageName
-> Bool -> Maybe TemplateName -> Map Text Text -> NewOpts
NewOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields PackageName -> Parser PackageName
packageNameArgument
          (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE_NAME"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"A valid package name."
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bare"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Do not create a subdirectory for the project."
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod ArgumentFields TemplateName -> Parser TemplateName
templateNameArgument
          (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TEMPLATE_NAME"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Name of a template - can take the form\
                  \ [[service:]username/]template with optional service name\
                  \ (github, gitlab, or bitbucket) and username for the \
                  \service; or, a local filename such as foo.hsfiles or ~/foo; \
                  \or, a full URL such as https://example.com/foo.hsfiles."
          ))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields (Text, Text) -> Parser (Text, Text)
templateParamArgument
          (  forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"param"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"KEY:VALUE"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Parameter for the template in the format key:value."
          )))