1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE OverloadedStrings #-} 3 4module Stack.Options.DotParser where 5 6import Data.Char (isSpace) 7import Data.List.Split (splitOn) 8import qualified Data.Set as Set 9import qualified Data.Text as T 10import Distribution.Types.PackageName(mkPackageName) 11import Options.Applicative 12import Options.Applicative.Builder.Extra 13import Stack.Dot 14import Stack.Options.BuildParser 15import Stack.Prelude 16 17-- | Parser for arguments to `stack dot` 18dotOptsParser :: Bool -> Parser DotOpts 19dotOptsParser externalDefault = 20 DotOpts <$> includeExternal 21 <*> includeBase 22 <*> depthLimit 23 <*> fmap (maybe Set.empty $ Set.fromList . splitNames) prunedPkgs 24 <*> targetsParser 25 <*> flagsParser 26 <*> testTargets 27 <*> benchTargets 28 <*> globalHints 29 where includeExternal = boolFlags externalDefault 30 "external" 31 "inclusion of external dependencies" 32 idm 33 includeBase = boolFlags True 34 "include-base" 35 "inclusion of dependencies on base" 36 idm 37 depthLimit = 38 optional (option auto 39 (long "depth" <> 40 metavar "DEPTH" <> 41 help ("Limit the depth of dependency resolution " <> 42 "(Default: No limit)"))) 43 prunedPkgs = optional (strOption 44 (long "prune" <> 45 metavar "PACKAGES" <> 46 help ("Prune each package name " <> 47 "from the comma separated list " <> 48 "of package names PACKAGES"))) 49 testTargets = switch (long "test" <> 50 help "Consider dependencies of test components") 51 benchTargets = switch (long "bench" <> 52 help "Consider dependencies of benchmark components") 53 54 splitNames :: String -> [PackageName] 55 splitNames = map (mkPackageName . takeWhile (not . isSpace) . dropWhile isSpace) . splitOn "," 56 57 globalHints = switch (long "global-hints" <> 58 help "Do not require an install GHC; instead, use a hints file for global packages") 59 60separatorParser :: Parser Text 61separatorParser = 62 fmap escapeSep 63 (textOption (long "separator" <> 64 metavar "SEP" <> 65 help ("Separator between package name " <> 66 "and package version.") <> 67 value " " <> 68 showDefault)) 69 where escapeSep sep = T.replace "\\t" "\t" (T.replace "\\n" "\n" sep) 70 71licenseParser :: Parser Bool 72licenseParser = boolFlags False 73 "license" 74 "printing of dependency licenses instead of versions" 75 idm 76 77listDepsFormatOptsParser :: Parser ListDepsFormatOpts 78listDepsFormatOptsParser = ListDepsFormatOpts <$> separatorParser <*> licenseParser 79 80listDepsTreeParser :: Parser ListDepsFormat 81listDepsTreeParser = ListDepsTree <$> listDepsFormatOptsParser 82 83listDepsTextParser :: Parser ListDepsFormat 84listDepsTextParser = ListDepsText <$> listDepsFormatOptsParser 85 86listDepsJsonParser :: Parser ListDepsFormat 87listDepsJsonParser = pure ListDepsJSON 88 89toListDepsOptsParser :: Parser ListDepsFormat -> Parser ListDepsOpts 90toListDepsOptsParser formatParser = ListDepsOpts 91 <$> formatParser 92 <*> dotOptsParser True 93 94formatSubCommand :: String -> String -> Parser ListDepsFormat -> Mod CommandFields ListDepsOpts 95formatSubCommand cmd desc formatParser = 96 command cmd (info (toListDepsOptsParser formatParser) 97 (progDesc desc)) 98 99-- | Parser for arguments to `stack ls dependencies`. 100listDepsOptsParser :: Parser ListDepsOpts 101listDepsOptsParser = subparser 102 ( formatSubCommand "text" "Print dependencies as text (default)" listDepsTextParser 103 <> formatSubCommand "tree" "Print dependencies as tree" listDepsTreeParser 104 <> formatSubCommand "json" "Print dependencies as JSON" listDepsJsonParser 105 ) <|> toListDepsOptsParser listDepsTextParser 106