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

-- | Function to parse command line arguments for Stack's @dot@ command and

-- certain command line arguments for Stack's @ls dependencies@ command.

module Stack.Options.DotParser
  ( dotOptsParser
  ) where

import           Data.Char ( isSpace )
import           Data.List.Split ( splitOn )
import qualified Data.Set as Set
import           Distribution.Types.PackageName ( mkPackageName )
import           Options.Applicative
                   ( Parser, auto, help, idm, long, metavar, option, strOption
                   , switch
                   )
import           Options.Applicative.Builder.Extra ( boolFlags )
import           Stack.Options.BuildParser ( flagsParser, targetsParser )
import           Stack.Prelude
import           Stack.Types.DotOpts ( DotOpts (..) )

-- | 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
  (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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe [Char] -> Set PackageName)
-> Parser (Maybe [Char]) -> Parser (Set PackageName)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PackageName
-> ([Char] -> Set PackageName) -> Maybe [Char] -> Set PackageName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PackageName
forall a. Set a
Set.empty (([Char] -> Set PackageName) -> Maybe [Char] -> Set PackageName)
-> ([Char] -> Set PackageName) -> Maybe [Char] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList ([PackageName] -> Set PackageName)
-> ([Char] -> [PackageName]) -> [Char] -> Set PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [PackageName]
splitNames) Parser (Maybe [Char])
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
benchTargets
  Parser (Bool -> DotOpts) -> Parser Bool -> Parser DotOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
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."
    Mod FlagFields Bool
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."
    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
    (  [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"depth"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DEPTH"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Limit the depth of dependency resolution. (default: no limit)"
    ))
  prunedPkgs :: Parser (Maybe [Char])
prunedPkgs = Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"prune"
    Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PACKAGES"
    Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
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
    (  [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"test"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Consider dependencies of test components."
    )
  benchTargets :: Parser Bool
benchTargets = Mod FlagFields Bool -> Parser Bool
switch
    (  [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"bench"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Consider dependencies of benchmark components."
    )

  splitNames :: String -> [PackageName]
  splitNames :: [Char] -> [PackageName]
splitNames = ([Char] -> PackageName) -> [[Char]] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map
      ( [Char] -> PackageName
mkPackageName
      ([Char] -> PackageName)
-> ([Char] -> [Char]) -> [Char] -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
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)
      ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
      )
    ([[Char]] -> [PackageName])
-> ([Char] -> [[Char]]) -> [Char] -> [PackageName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
","

  globalHints :: Parser Bool
globalHints = Mod FlagFields Bool -> Parser Bool
switch
    (  [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"global-hints"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Do not require an install GHC; instead, use a hints file for \
            \global packages."
    )