Skip to content

Commit 75cc631

Browse files
ruudaruuda
committed
Make list-dependencies accept the same args as dot
Under the hood they use the same mechanism, it makes sense to give them the same arguments too. Purging the graph is useful when listing dependencies too.
1 parent ec6f58b commit 75cc631

5 files changed

Lines changed: 100 additions & 57 deletions

File tree

‎src/Stack/Dot.hs‎

Lines changed: 38 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
module Stack.Dot (dot
55
,listDependencies
66
,DotOpts(..)
7+
,ListDepsOpts(..)
78
,resolveDependencies
89
,printGraph
910
,pruneGraph
@@ -56,6 +57,13 @@ data DotOpts = DotOpts
5657
-- ^ Package names to prune from the graph
5758
}
5859

60+
data ListDepsOpts = ListDepsOpts
61+
{ listDepsDotOpts :: DotOpts
62+
-- ^ The normal dot options.
63+
, listDepsSep :: Text
64+
-- ^ Separator between the package name and details.
65+
}
66+
5967
-- | Visualize the project's dependencies as a graphviz graph
6068
dot :: (HasEnvConfig env
6169
,HasHttpManager env
@@ -70,13 +78,31 @@ dot :: (HasEnvConfig env
7078
=> DotOpts
7179
-> m ()
7280
dot dotOpts = do
73-
localNames <- liftM Map.keysSet getLocalPackageViews
74-
resultGraph <- createDependencyGraph dotOpts
75-
let pkgsToPrune = if dotIncludeBase dotOpts
76-
then dotPrune dotOpts
77-
else Set.insert "base" (dotPrune dotOpts)
78-
prunedGraph = pruneGraph localNames pkgsToPrune resultGraph
79-
printGraph dotOpts localNames prunedGraph
81+
(localNames, prunedGraph) <- createPrunedDependencyGraph dotOpts
82+
printGraph dotOpts localNames prunedGraph
83+
84+
-- | Create the dependency graph and also prune it as specified in the dot
85+
-- options. Returns a set of local names and and a map from package names to
86+
-- dependencies.
87+
createPrunedDependencyGraph :: (HasEnvConfig env
88+
,HasHttpManager env
89+
,HasLogLevel env
90+
,MonadLogger m
91+
,MonadBaseUnlift IO m
92+
,MonadIO m
93+
,MonadMask m
94+
,MonadReader env m)
95+
=> DotOpts
96+
-> m (Set PackageName,
97+
Map PackageName (Set PackageName, Maybe Version))
98+
createPrunedDependencyGraph dotOpts = do
99+
localNames <- liftM Map.keysSet getLocalPackageViews
100+
resultGraph <- createDependencyGraph dotOpts
101+
let pkgsToPrune = if dotIncludeBase dotOpts
102+
then dotPrune dotOpts
103+
else Set.insert "base" (dotPrune dotOpts)
104+
prunedGraph = pruneGraph localNames pkgsToPrune resultGraph
105+
return (localNames, prunedGraph)
80106

81107
-- | Create the dependency graph, the result is a map from a package
82108
-- name to a tuple of dependencies and a version if available. This
@@ -121,15 +147,15 @@ listDependencies :: (HasEnvConfig env
121147
,MonadIO m
122148
,MonadReader env m
123149
)
124-
=> Text
150+
=> ListDepsOpts
125151
-> m ()
126-
listDependencies sep = do
127-
let dotOpts = DotOpts True True Nothing Set.empty
128-
resultGraph <- createDependencyGraph dotOpts
152+
listDependencies opts = do
153+
let dotOpts = listDepsDotOpts opts
154+
(_, resultGraph) <- createPrunedDependencyGraph dotOpts
129155
void (Map.traverseWithKey go (snd <$> resultGraph))
130156
where go name v = liftIO (Text.putStrLn $
131157
packageNameText name <>
132-
sep <>
158+
(listDepsSep opts) <>
133159
maybe "<unknown>" (Text.pack . show) v)
134160

135161
-- | @pruneGraph dontPrune toPrune graph@ prunes all packages in

‎src/Stack/Options/DockerParser.hs‎

Lines changed: 0 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,7 @@ module Stack.Options.DockerParser where
22

33
import Data.Char
44
import Data.List (intercalate)
5-
import Data.List.Split (splitOn)
65
import Data.Monoid.Extra
7-
import qualified Data.Set as Set
86
import qualified Data.Text as T
97
import Distribution.Version (anyVersion)
108
import Options.Applicative
@@ -13,7 +11,6 @@ import Options.Applicative.Builder.Extra
1311
import Stack.Constants
1412
import Stack.Docker
1513
import qualified Stack.Docker as Docker
16-
import Stack.Dot
1714
import Stack.Options.Utils
1815
import Stack.Types.Version
1916
import Stack.Types.Docker
@@ -144,35 +141,3 @@ dockerCleanupOptsParser =
144141
Nothing -> " (default)")) <|>
145142
pure def'
146143
toDescr = map (\c -> if c == '-' then ' ' else c)
147-
148-
-- | Parser for arguments to `stack dot`
149-
dotOptsParser :: Parser DotOpts
150-
dotOptsParser = DotOpts
151-
<$> includeExternal
152-
<*> includeBase
153-
<*> depthLimit
154-
<*> fmap (maybe Set.empty Set.fromList . fmap splitNames) prunedPkgs
155-
where includeExternal = boolFlags False
156-
"external"
157-
"inclusion of external dependencies"
158-
idm
159-
includeBase = boolFlags True
160-
"include-base"
161-
"inclusion of dependencies on base"
162-
idm
163-
depthLimit =
164-
optional (option auto
165-
(long "depth" <>
166-
metavar "DEPTH" <>
167-
help ("Limit the depth of dependency resolution " <>
168-
"(Default: No limit)")))
169-
prunedPkgs = optional (strOption
170-
(long "prune" <>
171-
metavar "PACKAGES" <>
172-
help ("Prune each package name " <>
173-
"from the comma separated list " <>
174-
"of package names PACKAGES")))
175-
176-
splitNames :: String -> [String]
177-
splitNames = map (takeWhile (not . isSpace) . dropWhile isSpace) . splitOn ","
178-

‎src/Stack/Options/DotParser.hs‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Stack.Options.DotParser where
4+
5+
import Data.Char (isSpace)
6+
import Data.List.Split (splitOn)
7+
import Data.Monoid.Extra
8+
import qualified Data.Set as Set
9+
import qualified Data.Text as T
10+
import Options.Applicative
11+
import Options.Applicative.Builder.Extra
12+
import Stack.Dot
13+
14+
-- | Parser for arguments to `stack dot`
15+
dotOptsParser :: Bool -> Parser DotOpts
16+
dotOptsParser externalDefault =
17+
DotOpts <$> includeExternal
18+
<*> includeBase
19+
<*> depthLimit
20+
<*> fmap (maybe Set.empty Set.fromList . fmap splitNames) prunedPkgs
21+
where includeExternal = boolFlags externalDefault
22+
"external"
23+
"inclusion of external dependencies"
24+
idm
25+
includeBase = boolFlags True
26+
"include-base"
27+
"inclusion of dependencies on base"
28+
idm
29+
depthLimit =
30+
optional (option auto
31+
(long "depth" <>
32+
metavar "DEPTH" <>
33+
help ("Limit the depth of dependency resolution " <>
34+
"(Default: No limit)")))
35+
prunedPkgs = optional (strOption
36+
(long "prune" <>
37+
metavar "PACKAGES" <>
38+
help ("Prune each package name " <>
39+
"from the comma separated list " <>
40+
"of package names PACKAGES")))
41+
42+
splitNames :: String -> [String]
43+
splitNames = map (takeWhile (not . isSpace) . dropWhile isSpace) . splitOn ","
44+
45+
-- | Parser for arguments to `stack list-dependencies`.
46+
listDepsOptsParser :: Parser ListDepsOpts
47+
listDepsOptsParser = ListDepsOpts
48+
<$> (dotOptsParser True) -- Default for --external is True.
49+
<*> fmap escapeSep
50+
(textOption (long "separator" <>
51+
metavar "SEP" <>
52+
help ("Separator between package name " <>
53+
"and package version.") <>
54+
value " " <>
55+
showDefault))
56+
where escapeSep sep = T.replace "\\t" "\t" (T.replace "\\n" "\n" sep)

‎src/main/Main.hs‎

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,7 @@ import Stack.New
7575
import Stack.Options.BuildParser
7676
import Stack.Options.CleanParser
7777
import Stack.Options.DockerParser
78+
import Stack.Options.DotParser
7879
import Stack.Options.ExecParser
7980
import Stack.Options.GhciParser
8081
import Stack.Options.GlobalParser
@@ -321,7 +322,7 @@ commandLineHandler progName isInterpreter = complicatedOptions
321322
addCommand' "dot"
322323
"Visualize your project's dependency graph using Graphviz dot"
323324
dotCmd
324-
dotOptsParser
325+
(dotOptsParser False) -- Default for --external is False.
325326
addCommand' "ghc"
326327
"Run ghc"
327328
execCmd
@@ -374,12 +375,7 @@ commandLineHandler progName isInterpreter = complicatedOptions
374375
addCommand' "list-dependencies"
375376
"List the dependencies"
376377
listDependenciesCmd
377-
(textOption (long "separator" <>
378-
metavar "SEP" <>
379-
help ("Separator between package name " <>
380-
"and package version.") <>
381-
value " " <>
382-
showDefault))
378+
listDepsOptsParser
383379
addCommand' "query"
384380
"Query general build information (experimental)"
385381
queryCmd
@@ -901,9 +897,8 @@ dotCmd :: DotOpts -> GlobalOpts -> IO ()
901897
dotCmd dotOpts go = withBuildConfigAndLock go (\_ -> dot dotOpts)
902898

903899
-- | List the dependencies
904-
listDependenciesCmd :: Text -> GlobalOpts -> IO ()
905-
listDependenciesCmd sep go = withBuildConfig go (listDependencies sep')
906-
where sep' = T.replace "\\t" "\t" (T.replace "\\n" "\n" sep)
900+
listDependenciesCmd :: ListDepsOpts -> GlobalOpts -> IO ()
901+
listDependenciesCmd opts go = withBuildConfig go $ listDependencies opts
907902

908903
-- | Query build information
909904
queryCmd :: [String] -> GlobalOpts -> IO ()

‎stack.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -115,6 +115,7 @@ library
115115
Stack.Options.CleanParser
116116
Stack.Options.ConfigParser
117117
Stack.Options.DockerParser
118+
Stack.Options.DotParser
118119
Stack.Options.ExecParser
119120
Stack.Options.GhcBuildParser
120121
Stack.Options.GhciParser

0 commit comments

Comments
 (0)