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

module Stack.Options.DotParser
  ( dotOptsParser
  , formatSubCommand
  , licenseParser
  , listDepsConstraintsParser
  , listDepsFormatOptsParser
  , listDepsJsonParser
  , listDepsOptsParser
  , listDepsTextParser
  , listDepsTreeParser
  , separatorParser
  , toListDepsOptsParser
  ) 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
                   ( CommandFields, Mod, Parser, auto, command, help, idm, info
                   , long, metavar, option, progDesc, showDefault, strOption
                   , subparser, switch, value
                   )
import           Options.Applicative.Builder.Extra ( boolFlags, textOption )
import           Stack.Dot
                   ( DotOpts (..), ListDepsFormat (..), ListDepsFormatOpts (..)
                   , ListDepsOpts (..)
                   )
import           Stack.Options.BuildParser ( flagsParser, targetsParser )
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
. [Char] -> [PackageName]
splitNames) Parser (Maybe [Char])
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 -> [Char] -> [Char] -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
externalDefault
    [Char]
"external"
    [Char]
"inclusion of external dependencies."
    forall m. Monoid m => m
idm
  includeBase :: Parser Bool
includeBase = Bool -> [Char] -> [Char] -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
    [Char]
"include-base"
    [Char]
"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 => [Char] -> Mod f a
long [Char]
"depth"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DEPTH"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Limit the depth of dependency resolution. (default: no limit)"
    ))
  prunedPkgs :: Parser (Maybe [Char])
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 => [Char] -> Mod f a
long [Char]
"prune"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PACKAGES"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Prune specified package(s). PACKAGES is a comma-separated list of \
            \package names."
    ))
  testTargets :: Parser Bool
testTargets = Mod FlagFields Bool -> Parser Bool
switch
    (  forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"test"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Consider dependencies of test components."
    )
  benchTargets :: Parser Bool
benchTargets = Mod FlagFields Bool -> Parser Bool
switch
    (  forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"bench"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Consider dependencies of benchmark components."
    )

  splitNames :: String -> [PackageName]
  splitNames :: [Char] -> [PackageName]
splitNames = forall a b. (a -> b) -> [a] -> [b]
map
      ( [Char] -> 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 [Char]
","

  globalHints :: Parser Bool
globalHints = Mod FlagFields Bool -> Parser Bool
switch
    (  forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"global-hints"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"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 => [Char] -> Mod f a
long [Char]
"separator"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"SEP"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Separator between package name 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
s = Text -> Text -> Text -> Text
T.replace Text
"\\t" Text
"\t" (Text -> Text -> Text -> Text
T.replace Text
"\\n" Text
"\n" Text
s)

licenseParser :: Parser Bool
licenseParser :: Parser Bool
licenseParser = Bool -> [Char] -> [Char] -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
  [Char]
"license"
  [Char]
"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

listDepsConstraintsParser :: Parser ListDepsFormat
listDepsConstraintsParser :: Parser ListDepsFormat
listDepsConstraintsParser = forall (f :: * -> *) a. Applicative f => a -> f a
pure ListDepsFormat
ListDepsConstraints

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 :: [Char]
-> [Char]
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand [Char]
cmd [Char]
desc Parser ListDepsFormat
formatParser =
  forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
cmd (forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ListDepsFormat -> Parser ListDepsOpts
toListDepsOptsParser Parser ListDepsFormat
formatParser) (forall a. [Char] -> InfoMod a
progDesc [Char]
desc))

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

listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser :: Parser ListDepsOpts
listDepsOptsParser = forall a. Mod CommandFields a -> Parser a
subparser
      (  [Char]
-> [Char]
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand
           [Char]
"text"
           [Char]
"Print dependencies as text (default)."
           Parser ListDepsFormat
listDepsTextParser
      forall a. Semigroup a => a -> a -> a
<> [Char]
-> [Char]
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand
           [Char]
"cabal"
           [Char]
"Print dependencies as exact Cabal constraints."
           Parser ListDepsFormat
listDepsConstraintsParser
      forall a. Semigroup a => a -> a -> a
<> [Char]
-> [Char]
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand
           [Char]
"tree"
           [Char]
"Print dependencies as tree."
           Parser ListDepsFormat
listDepsTreeParser
      forall a. Semigroup a => a -> a -> a
<> [Char]
-> [Char]
-> Parser ListDepsFormat
-> Mod CommandFields ListDepsOpts
formatSubCommand
           [Char]
"json"
           [Char]
"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