{-# 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

-- | Parser for arguments to `stack dot`

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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
includeExternal
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
includeBase
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
depthLimit
          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 b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [PackageName]
splitNames) Parser (Maybe String)
prunedPkgs
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
targetsParser
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map ApplyCLIFlag (Map FlagName Bool))
flagsParser
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
testTargets
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
benchTargets
          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"
                                    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"
                                forall m. Monoid m => m
idm
        depthLimit :: Parser (Maybe Int)
depthLimit =
            forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
                             (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"depth" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DEPTH" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. String -> Mod f a
help (String
"Limit the depth of dependency resolution " forall a. Semigroup a => a -> a -> a
<>
                                    String
"(Default: No limit)")))
        prunedPkgs :: Parser (Maybe String)
prunedPkgs = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                                   (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"prune" forall a. Semigroup a => a -> a -> a
<>
                                    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGES" forall a. Semigroup a => a -> a -> a
<>
                                    forall (f :: * -> *) a. String -> Mod f a
help (String
"Prune each package name " forall a. Semigroup a => a -> a -> a
<>
                                          String
"from the comma separated list " forall a. Semigroup a => a -> a -> a
<>
                                          String
"of package names PACKAGES")))
        testTargets :: Parser Bool
testTargets = Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. String -> Mod f a
help String
"Consider dependencies of test components")
        benchTargets :: Parser Bool
benchTargets = Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bench" forall a. Semigroup a => a -> a -> a
<>
                               forall (f :: * -> *) a. String -> Mod f a
help String
"Consider dependencies of benchmark components")

        splitNames :: String -> [PackageName]
        splitNames :: String -> [PackageName]
splitNames = forall a b. (a -> b) -> [a] -> [b]
map (String -> PackageName
mkPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","

        globalHints :: Parser Bool
globalHints = Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"global-hints" forall a. Semigroup a => a -> a -> a
<>
                              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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
escapeSep
  (Mod OptionFields Text -> Parser Text
textOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"separator" forall a. Semigroup a => a -> a -> a
<>
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEP" forall a. Semigroup a => a -> a -> a
<>
                forall (f :: * -> *) a. String -> Mod f a
help (String
"Separator between package name " forall a. Semigroup a => a -> a -> a
<>
                      String
"and package version.") forall a. Semigroup a => a -> a -> a
<>
                forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
" " forall a. Semigroup a => a -> a -> a
<>
                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"
                forall m. Monoid m => m
idm

listDepsFormatOptsParser :: Parser ListDepsFormatOpts
listDepsFormatOptsParser :: Parser ListDepsFormatOpts
listDepsFormatOptsParser = Text -> Bool -> ListDepsFormatOpts
ListDepsFormatOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
separatorParser 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsFormatOpts
listDepsFormatOptsParser

listDepsJsonParser :: Parser ListDepsFormat
listDepsJsonParser :: Parser ListDepsFormat
listDepsJsonParser = 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsFormat
formatParser
      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 =
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
cmd (forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
formatParser)
               (forall a. String -> InfoMod a
progDesc String
desc))

-- | Parser for arguments to `stack ls dependencies`.

listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser = 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
                     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
                     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
                     ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
listDepsTextParser