{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Options.DotParser where
import Data.Char (isSpace)
import Data.List.Split (splitOn)
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.Types.PackageName(mkPackageName)
import Options.Applicative
import Options.Applicative.Builder.Extra
import Stack.Dot
import Stack.Options.BuildParser
import Stack.Prelude
dotOptsParser :: Bool -> Parser DotOpts
dotOptsParser :: Bool -> Parser DotOpts
dotOptsParser Bool
externalDefault =
Bool
-> Bool
-> Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts
DotOpts (Bool
-> Bool
-> Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
-> Parser Bool
-> Parser
(Bool
-> Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
includeExternal
Parser
(Bool
-> Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
-> Parser Bool
-> Parser
(Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
includeBase
Parser
(Maybe Int
-> Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
-> Parser (Maybe Int)
-> Parser
(Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
depthLimit
Parser
(Set PackageName
-> [Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
-> Parser (Set PackageName)
-> Parser
([Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe String -> Set PackageName)
-> Parser (Maybe String) -> Parser (Set PackageName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PackageName
-> (String -> Set PackageName) -> Maybe String -> Set PackageName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PackageName
forall a. Set a
Set.empty ((String -> Set PackageName) -> Maybe String -> Set PackageName)
-> (String -> Set PackageName) -> Maybe String -> Set PackageName
forall a b. (a -> b) -> a -> b
$ [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList ([PackageName] -> Set PackageName)
-> (String -> [PackageName]) -> String -> Set PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [PackageName]
splitNames) Parser (Maybe String)
prunedPkgs
Parser
([Text]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Bool
-> Bool
-> Bool
-> DotOpts)
-> Parser [Text]
-> Parser
(Map ApplyCLIFlag (Map FlagName Bool)
-> Bool -> Bool -> Bool -> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
targetsParser
Parser
(Map ApplyCLIFlag (Map FlagName Bool)
-> Bool -> Bool -> Bool -> DotOpts)
-> Parser (Map ApplyCLIFlag (Map FlagName Bool))
-> Parser (Bool -> Bool -> Bool -> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map ApplyCLIFlag (Map FlagName Bool))
flagsParser
Parser (Bool -> Bool -> Bool -> DotOpts)
-> Parser Bool -> Parser (Bool -> Bool -> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
testTargets
Parser (Bool -> Bool -> DotOpts)
-> Parser Bool -> Parser (Bool -> DotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
benchTargets
Parser (Bool -> DotOpts) -> Parser Bool -> Parser DotOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
globalHints
where includeExternal :: Parser Bool
includeExternal = Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
externalDefault
String
"external"
String
"inclusion of external dependencies"
Mod FlagFields Bool
forall m. Monoid m => m
idm
includeBase :: Parser Bool
includeBase = Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
String
"include-base"
String
"inclusion of dependencies on base"
Mod FlagFields Bool
forall m. Monoid m => m
idm
depthLimit :: Parser (Maybe Int)
depthLimit =
Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
(String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"depth" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DEPTH" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help (String
"Limit the depth of dependency resolution " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"(Default: No limit)")))
prunedPkgs :: Parser (Maybe String)
prunedPkgs = Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"prune" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGES" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help (String
"Prune each package name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"from the comma separated list " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"of package names PACKAGES")))
testTargets :: Parser Bool
testTargets = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Consider dependencies of test components")
benchTargets :: Parser Bool
benchTargets = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bench" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Consider dependencies of benchmark components")
splitNames :: String -> [PackageName]
splitNames :: String -> [PackageName]
splitNames = (String -> PackageName) -> [String] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PackageName
mkPackageName (String -> PackageName)
-> (String -> String) -> String -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) ([String] -> [PackageName])
-> (String -> [String]) -> String -> [PackageName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","
globalHints :: Parser Bool
globalHints = Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"global-hints" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not require an install GHC; instead, use a hints file for global packages")
separatorParser :: Parser Text
separatorParser :: Parser Text
separatorParser =
(Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeSep
(Mod OptionFields Text -> Parser Text
textOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"separator" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEP" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help (String
"Separator between package name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"and package version.") Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
" " Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<>
Mod OptionFields Text
forall a (f :: * -> *). Show a => Mod f a
showDefault))
where escapeSep :: Text -> Text
escapeSep Text
sep = Text -> Text -> Text -> Text
T.replace Text
"\\t" Text
"\t" (Text -> Text -> Text -> Text
T.replace Text
"\\n" Text
"\n" Text
sep)
licenseParser :: Parser Bool
licenseParser :: Parser Bool
licenseParser = Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
String
"license"
String
"printing of dependency licenses instead of versions"
Mod FlagFields Bool
forall m. Monoid m => m
idm
listDepsFormatOptsParser :: Parser ListDepsFormatOpts
listDepsFormatOptsParser :: Parser ListDepsFormatOpts
listDepsFormatOptsParser = Text -> Bool -> ListDepsFormatOpts
ListDepsFormatOpts (Text -> Bool -> ListDepsFormatOpts)
-> Parser Text -> Parser (Bool -> ListDepsFormatOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
separatorParser Parser (Bool -> ListDepsFormatOpts)
-> Parser Bool -> Parser ListDepsFormatOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
licenseParser
listDepsTreeParser :: Parser ListDepsFormat
listDepsTreeParser :: Parser ListDepsFormat
listDepsTreeParser = ListDepsFormatOpts -> ListDepsFormat
ListDepsTree (ListDepsFormatOpts -> ListDepsFormat)
-> Parser ListDepsFormatOpts -> Parser ListDepsFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsFormatOpts
listDepsFormatOptsParser
listDepsTextParser :: Parser ListDepsFormat
listDepsTextParser :: Parser ListDepsFormat
listDepsTextParser = ListDepsFormatOpts -> ListDepsFormat
ListDepsText (ListDepsFormatOpts -> ListDepsFormat)
-> Parser ListDepsFormatOpts -> Parser ListDepsFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsFormatOpts
listDepsFormatOptsParser
listDepsJsonParser :: Parser ListDepsFormat
listDepsJsonParser :: Parser ListDepsFormat
listDepsJsonParser = ListDepsFormat -> Parser ListDepsFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListDepsFormat
ListDepsJSON
toListDepsOptsParser :: Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser :: Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
formatParser = ListDepsFormat -> DotOpts -> ListDepsOpts
ListDepsOpts
(ListDepsFormat -> DotOpts -> ListDepsOpts)
-> Parser ListDepsFormat -> Parser (DotOpts -> ListDepsOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsFormat
formatParser
Parser (DotOpts -> ListDepsOpts)
-> Parser DotOpts -> Parser ListDepsOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser DotOpts
dotOptsParser Bool
True
formatSubCommand :: String -> String -> Parser ListDepsFormat -> Mod CommandFields ListDepsOpts
formatSubCommand :: String
-> String
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand String
cmd String
desc Parser ListDepsFormat
formatParser =
String -> ParserInfo ListDepsOpts -> Mod CommandFields ListDepsOpts
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
cmd (Parser ListDepsOpts
-> InfoMod ListDepsOpts -> ParserInfo ListDepsOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
formatParser)
(String -> InfoMod ListDepsOpts
forall a. String -> InfoMod a
progDesc String
desc))
listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser = Mod CommandFields ListDepsOpts -> Parser ListDepsOpts
forall a. Mod CommandFields a -> Parser a
subparser
( String
-> String
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand String
"text" String
"Print dependencies as text (default)" Parser ListDepsFormat
listDepsTextParser
Mod CommandFields ListDepsOpts
-> Mod CommandFields ListDepsOpts -> Mod CommandFields ListDepsOpts
forall a. Semigroup a => a -> a -> a
<> String
-> String
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand String
"tree" String
"Print dependencies as tree" Parser ListDepsFormat
listDepsTreeParser
Mod CommandFields ListDepsOpts
-> Mod CommandFields ListDepsOpts -> Mod CommandFields ListDepsOpts
forall a. Semigroup a => a -> a -> a
<> String
-> String
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand String
"json" String
"Print dependencies as JSON" Parser ListDepsFormat
listDepsJsonParser
) Parser ListDepsOpts -> Parser ListDepsOpts -> Parser ListDepsOpts
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
listDepsTextParser