diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs index 08a7c687d8..d6177624f4 100644 --- a/src/Stack/Dot.hs +++ b/src/Stack/Dot.hs @@ -140,11 +140,17 @@ listDependencies opts = do if listDepsTree opts then do liftIO $ Text.putStrLn "Packages" - liftIO $ printTree opts 0 [] pkgs resultGraph + liftIO $ printTree opts 0 [] (treeRoots opts pkgs) resultGraph else void (Map.traverseWithKey go (snd <$> resultGraph)) where go name payload = liftIO $ Text.putStrLn $ listDepsLine opts name payload +treeRoots :: ListDepsOpts -> Set PackageName -> Set PackageName +treeRoots opts projectPackages = let targets = dotTargets $ listDepsDotOpts opts + in if null targets + then projectPackages + else Set.fromList $ map (mkPackageName . Text.unpack) targets + printTree :: ListDepsOpts -> Int -> [Int] @@ -156,12 +162,15 @@ printTree opts depth remainingDepsCounts packages dependencyMap = where toSeq = Seq.fromList . Set.toList go index name = let newDepsCounts = remainingDepsCounts ++ [Set.size packages - index - 1] - (deps, payload) = (Map.!) dependencyMap name - in do + in + case Map.lookup name dependencyMap of + Just (deps, payload) -> do printTreeNode opts depth newDepsCounts deps payload name if Just depth == dotDependencyDepth (listDepsDotOpts opts) then return () else printTree opts (depth + 1) newDepsCounts deps dependencyMap + -- TODO: Define this behaviour, maybe return an error? + Nothing -> return () printTreeNode :: ListDepsOpts -> Int diff --git a/test/integration/tests/4101-dependency-tree/Main.hs b/test/integration/tests/4101-dependency-tree/Main.hs index bfc179e39e..672332fcb4 100644 --- a/test/integration/tests/4101-dependency-tree/Main.hs +++ b/test/integration/tests/4101-dependency-tree/Main.hs @@ -5,32 +5,65 @@ main :: IO () main = do stackCheckStdout ["ls", "dependencies", "--tree"] $ \stdOut -> do let expected = unlines [ "Packages" - , "└─┬ files 0.1.0.0" - , " ├─┬ base 4.10.1.0" - , " │ ├─┬ ghc-prim 0.5.1.1" - , " │ │ └── rts 1.0" - , " │ ├─┬ integer-gmp 1.0.1.0" - , " │ │ └─┬ ghc-prim 0.5.1.1" - , " │ │ └── rts 1.0" - , " │ └── rts 1.0" - , " └─┬ mtl 2.2.2" - , " ├─┬ base 4.10.1.0" - , " │ ├─┬ ghc-prim 0.5.1.1" - , " │ │ └── rts 1.0" - , " │ ├─┬ integer-gmp 1.0.1.0" - , " │ │ └─┬ ghc-prim 0.5.1.1" - , " │ │ └── rts 1.0" + , "├─┬ files 0.1.0.0" + , "│ ├─┬ base 4.10.1.0" + , "│ │ ├─┬ ghc-prim 0.5.1.1" + , "│ │ │ └── rts 1.0" + , "│ │ ├─┬ integer-gmp 1.0.1.0" + , "│ │ │ └─┬ ghc-prim 0.5.1.1" + , "│ │ │ └── rts 1.0" + , "│ │ └── rts 1.0" + , "│ ├─┬ mtl 2.2.2" + , "│ │ ├─┬ base 4.10.1.0" + , "│ │ │ ├─┬ ghc-prim 0.5.1.1" + , "│ │ │ │ └── rts 1.0" + , "│ │ │ ├─┬ integer-gmp 1.0.1.0" + , "│ │ │ │ └─┬ ghc-prim 0.5.1.1" + , "│ │ │ │ └── rts 1.0" + , "│ │ │ └── rts 1.0" + , "│ │ └── transformers 0.5.2.0" + , "│ └─┬ subproject 0.1.0.0" + , "│ └─┬ base 4.10.1.0" + , "│ ├─┬ ghc-prim 0.5.1.1" + , "│ │ └── rts 1.0" + , "│ ├─┬ integer-gmp 1.0.1.0" + , "│ │ └─┬ ghc-prim 0.5.1.1" + , "│ │ └── rts 1.0" + , "│ └── rts 1.0" + , "└─┬ subproject 0.1.0.0" + , " └─┬ base 4.10.1.0" + , " ├─┬ ghc-prim 0.5.1.1" , " │ └── rts 1.0" - , " └── transformers 0.5.2.0" + , " ├─┬ integer-gmp 1.0.1.0" + , " │ └─┬ ghc-prim 0.5.1.1" + , " │ └── rts 1.0" + , " └── rts 1.0" ] when (stdOut /= expected) $ error $ unlines [ "Expected:", expected, "Actual:", stdOut ] stackCheckStdout ["ls", "dependencies", "--tree", "--depth=1"] $ \stdOut -> do let expected = unlines [ "Packages" - , "└─┬ files 0.1.0.0" - , " ├── base 4.10.1.0" - , " └── mtl 2.2.2" + , "├─┬ files 0.1.0.0" + , "│ ├── base 4.10.1.0" + , "│ ├── mtl 2.2.2" + , "│ └── subproject 0.1.0.0" + , "└─┬ subproject 0.1.0.0" + , " └── base 4.10.1.0" + ] + when (stdOut /= expected) $ + error $ unlines [ "Expected:", expected, "Actual:", stdOut ] + + stackCheckStdout ["ls", "dependencies", "--tree", "subproject"] $ \stdOut -> do + let expected = unlines [ "Packages" + , "└─┬ subproject 0.1.0.0" + , " └─┬ base 4.10.1.0" + , " ├─┬ ghc-prim 0.5.1.1" + , " │ └── rts 1.0" + , " ├─┬ integer-gmp 1.0.1.0" + , " │ └─┬ ghc-prim 0.5.1.1" + , " │ └── rts 1.0" + , " └── rts 1.0" ] when (stdOut /= expected) $ error $ unlines [ "Expected:", expected, "Actual:", stdOut ] diff --git a/test/integration/tests/4101-dependency-tree/files/files.cabal b/test/integration/tests/4101-dependency-tree/files/files.cabal index 66525ce056..1ee9717152 100644 --- a/test/integration/tests/4101-dependency-tree/files/files.cabal +++ b/test/integration/tests/4101-dependency-tree/files/files.cabal @@ -6,5 +6,5 @@ cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Lib - build-depends: base >= 4.7 && < 5, mtl + build-depends: base >= 4.7 && < 5, mtl, subproject default-language: Haskell2010 diff --git a/test/integration/tests/4101-dependency-tree/files/stack.yaml b/test/integration/tests/4101-dependency-tree/files/stack.yaml index c45908a037..3235f73005 100644 --- a/test/integration/tests/4101-dependency-tree/files/stack.yaml +++ b/test/integration/tests/4101-dependency-tree/files/stack.yaml @@ -1,3 +1,4 @@ resolver: lts-11.22 packages: - . +- subproject diff --git a/test/integration/tests/4101-dependency-tree/files/subproject/src/Main.hs b/test/integration/tests/4101-dependency-tree/files/subproject/src/Main.hs new file mode 100644 index 0000000000..9cd992d9e5 --- /dev/null +++ b/test/integration/tests/4101-dependency-tree/files/subproject/src/Main.hs @@ -0,0 +1,5 @@ +module Main where + +main :: IO () +main = do + putStrLn "hello world" diff --git a/test/integration/tests/4101-dependency-tree/files/subproject/stack.yaml b/test/integration/tests/4101-dependency-tree/files/subproject/stack.yaml new file mode 100644 index 0000000000..c45908a037 --- /dev/null +++ b/test/integration/tests/4101-dependency-tree/files/subproject/stack.yaml @@ -0,0 +1,3 @@ +resolver: lts-11.22 +packages: +- . diff --git a/test/integration/tests/4101-dependency-tree/files/subproject/subproject.cabal b/test/integration/tests/4101-dependency-tree/files/subproject/subproject.cabal new file mode 100644 index 0000000000..6c3a2f939d --- /dev/null +++ b/test/integration/tests/4101-dependency-tree/files/subproject/subproject.cabal @@ -0,0 +1,10 @@ +name: subproject +version: 0.1.0.0 +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Lib + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010