stack-2.11.1: src/test/Stack/PackageDumpSpec.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.PackageDumpSpec
( main
, spec
, bestPrune
, checkDepsPresent
, runEnvNoLogging
) where
import Conduit ( withSourceFile, yield )
import qualified Data.Conduit.List as CL
import Data.Conduit.Text ( decodeUtf8 )
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.License ( License (..) )
import Distribution.Types.PackageName ( mkPackageName )
import Distribution.Version ( mkVersion )
import Path ( parseAbsFile )
import RIO.PrettyPrint.Simple ( SimplePrettyApp, mkSimplePrettyApp )
import RIO.Process
( envVarsL, findExecutable, mkDefaultProcessContext
, mkProcessContext
)
import Stack.PackageDump
( DumpPackage (..), conduitDumpPackage, eachPair
, eachSection, ghcPkgDump, pruneDeps, sinkMatching
)
import Stack.Prelude
import Stack.Types.CompilerPaths ( GhcPkgExe (..) )
import Stack.Types.GhcPkgId ( parseGhcPkgId )
import Test.Hspec
( Spec, describe, hspec, it, shouldBe )
import Test.Hspec.QuickCheck ( prop )
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "eachSection" $ do
let test name content expected = it name $ do
actual <- runConduit $ yield content .| eachSection CL.consume .| CL.consume
actual `shouldBe` expected
test
"unix line endings"
"foo\nbar\n---\nbaz---\nbin\n---\n"
[ ["foo", "bar"]
, ["baz---", "bin"]
]
test
"windows line endings"
"foo\r\nbar\r\n---\r\nbaz---\r\nbin\r\n---\r\n"
[ ["foo", "bar"]
, ["baz---", "bin"]
]
it "eachPair" $ do
let bss =
[ "key1: val1"
, "key2: val2a"
, " val2b"
, "key3:"
, "key4:"
, " val4a"
, " val4b"
]
sink k = fmap (k, ) CL.consume
actual <- runConduit $ mapM_ yield bss .| eachPair sink .| CL.consume
actual `shouldBe`
[ ("key1", ["val1"])
, ("key2", ["val2a", "val2b"])
, ("key3", [])
, ("key4", ["val4a", "val4b"])
]
describe "conduitDumpPackage" $ do
it "ghc 7.8" $ do
haskell2010:_ <-
withSourceFile "test/package-dump/ghc-7.8.txt" $ \src ->
runConduit
$ src
.| decodeUtf8
.| conduitDumpPackage
.| CL.consume
ghcPkgId <- parseGhcPkgId "haskell2010-1.1.2.0-05c8dd51009e08c6371c82972d40f55a"
packageIdent <- maybe (fail "Not parsable package id") pure $
parsePackageIdentifier "haskell2010-1.1.2.0"
depends <- mapM parseGhcPkgId
[ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b"
, "base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1"
, "ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37"
]
haskell2010 { dpExposedModules = mempty } `shouldBe` DumpPackage
{ dpGhcPkgId = ghcPkgId
, dpPackageIdent = packageIdent
, dpParentLibIdent = Nothing
, dpLicense = Just BSD3
, dpLibDirs = ["/opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0"]
, dpDepends = depends
, dpLibraries = ["HShaskell2010-1.1.2.0"]
, dpHasExposedModules = True
, dpHaddockInterfaces = ["/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0/haskell2010.haddock"]
, dpHaddockHtml = Just "/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0"
, dpIsExposed = False
, dpExposedModules = mempty
}
it "ghc 7.10" $ do
haskell2010:_ <-
withSourceFile "test/package-dump/ghc-7.10.txt" $ \src ->
runConduit
$ src
.| decodeUtf8
.| conduitDumpPackage
.| CL.consume
ghcPkgId <- parseGhcPkgId "ghc-7.10.1-325809317787a897b7a97d646ceaa3a3"
pkgIdent <- maybe (fail "Not parsable package id") pure $
parsePackageIdentifier "ghc-7.10.1"
depends <- mapM parseGhcPkgId
[ "array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9"
, "base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a"
, "bin-package-db-0.0.0.0-708fc7d634a370b311371a5bcde40b62"
, "bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db"
, "containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d"
, "directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0"
, "filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6"
, "hoopl-3.10.0.2-8c8dfc4c3140e5f7c982da224c3cb1f0"
, "hpc-0.6.0.2-ac9064885aa8cb08a93314222939ead4"
, "process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1"
, "template-haskell-2.10.0.0-e895139a0ffff267d412e3d0191ce93b"
, "time-1.5.0.1-e17a9220d438435579d2914e90774246"
, "transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f"
, "unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f"
]
haskell2010 { dpExposedModules = mempty } `shouldBe` DumpPackage
{ dpGhcPkgId = ghcPkgId
, dpPackageIdent = pkgIdent
, dpParentLibIdent = Nothing
, dpLicense = Just BSD3
, dpLibDirs = ["/opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY"]
, dpHaddockInterfaces = ["/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1/ghc.haddock"]
, dpHaddockHtml = Just "/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1"
, dpDepends = depends
, dpLibraries = ["HSghc-7.10.1-EMlWrQ42XY0BNVbSrKixqY"]
, dpHasExposedModules = True
, dpIsExposed = False
, dpExposedModules = mempty
}
it "ghc 7.8.4 (osx)" $ do
hmatrix:_ <-
withSourceFile "test/package-dump/ghc-7.8.4-osx.txt" $ \src ->
runConduit
$ src
.| decodeUtf8
.| conduitDumpPackage
.| CL.consume
ghcPkgId <- parseGhcPkgId "hmatrix-0.16.1.5-12d5d21f26aa98774cdd8edbc343fbfe"
pkgId <- maybe (fail "Not parsable package id") pure $
parsePackageIdentifier "hmatrix-0.16.1.5"
depends <- mapM parseGhcPkgId
[ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b"
, "base-4.7.0.2-918c7ac27f65a87103264a9f51652d63"
, "binary-0.7.1.0-108d06eea2ef05e517f9c1facf10f63c"
, "bytestring-0.10.4.0-78bc8f2c724c765c78c004a84acf6cc3"
, "deepseq-1.3.0.2-0ddc77716bd2515426e1ba39f6788a4f"
, "random-1.1-822c19b7507b6ac1aaa4c66731e775ae"
, "split-0.2.2-34cfb851cc3784e22bfae7a7bddda9c5"
, "storable-complex-0.2.2-e962c368d58acc1f5b41d41edc93da72"
, "vector-0.10.12.3-f4222db607fd5fdd7545d3e82419b307"]
hmatrix `shouldBe` DumpPackage
{ dpGhcPkgId = ghcPkgId
, dpPackageIdent = pkgId
, dpParentLibIdent = Nothing
, dpLicense = Just BSD3
, dpLibDirs =
[ "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5"
, "/opt/local/lib/"
, "/usr/local/lib/"
, "C:/Program Files/Example/"]
, dpHaddockInterfaces = ["/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html/hmatrix.haddock"]
, dpHaddockHtml = Just "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html"
, dpDepends = depends
, dpLibraries = ["HShmatrix-0.16.1.5"]
, dpHasExposedModules = True
, dpIsExposed = True
, dpExposedModules = Set.fromList ["Data.Packed","Data.Packed.Vector","Data.Packed.Matrix","Data.Packed.Foreign","Data.Packed.ST","Data.Packed.Development","Numeric.LinearAlgebra","Numeric.LinearAlgebra.LAPACK","Numeric.LinearAlgebra.Algorithms","Numeric.Container","Numeric.LinearAlgebra.Util","Numeric.LinearAlgebra.Devel","Numeric.LinearAlgebra.Data","Numeric.LinearAlgebra.HMatrix","Numeric.LinearAlgebra.Static"]
}
it "ghc HEAD" $ do
ghcBoot:_ <-
withSourceFile "test/package-dump/ghc-head.txt" $ \src ->
runConduit
$ src
.| decodeUtf8
.| conduitDumpPackage
.| CL.consume
ghcPkgId <- parseGhcPkgId "ghc-boot-0.0.0.0"
pkgId <- maybe (fail "Not parsable package id") pure $
parsePackageIdentifier "ghc-boot-0.0.0.0"
depends <- mapM parseGhcPkgId
[ "base-4.9.0.0"
, "binary-0.7.5.0"
, "bytestring-0.10.7.0"
, "directory-1.2.5.0"
, "filepath-1.4.1.0"
]
ghcBoot `shouldBe` DumpPackage
{ dpGhcPkgId = ghcPkgId
, dpPackageIdent = pkgId
, dpParentLibIdent = Nothing
, dpLicense = Just BSD3
, dpLibDirs =
["/opt/ghc/head/lib/ghc-7.11.20151213/ghc-boot-0.0.0.0"]
, dpHaddockInterfaces = ["/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0/ghc-boot.haddock"]
, dpHaddockHtml = Just "/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0"
, dpDepends = depends
, dpLibraries = ["HSghc-boot-0.0.0.0"]
, dpHasExposedModules = True
, dpIsExposed = True
, dpExposedModules = Set.fromList ["GHC.Lexeme", "GHC.PackageDb"]
}
it "sinkMatching" $ runEnvNoLogging $ \pkgexe -> do
m <- ghcPkgDump pkgexe []
$ conduitDumpPackage
.| sinkMatching (Map.singleton (mkPackageName "transformers") (mkVersion [0, 0, 0, 0, 0, 0, 1]))
case Map.lookup (mkPackageName "base") m of
Nothing -> error "base not present"
Just _ -> pure ()
liftIO $ do
Map.lookup (mkPackageName "transformers") m `shouldBe` Nothing
Map.lookup (mkPackageName "ghc") m `shouldBe` Nothing
describe "pruneDeps" $ do
it "sanity check" $ do
let prunes =
[ ((1, 'a'), [])
, ((1, 'b'), [])
, ((2, 'a'), [(1, 'b')])
, ((2, 'b'), [(1, 'a')])
, ((3, 'a'), [(1, 'c')])
, ((4, 'a'), [(2, 'a')])
]
actual = fst <$> pruneDeps fst fst snd bestPrune prunes
actual `shouldBe` Map.fromList
[ (1, (1, 'b'))
, (2, (2, 'a'))
, (4, (4, 'a'))
]
prop "invariant holds" $ \prunes' ->
-- Force uniqueness
let prunes = Map.toList $ Map.fromList prunes'
in checkDepsPresent prunes $ fst <$> pruneDeps fst fst snd bestPrune prunes
type PruneCheck = ((Int, Char), [(Int, Char)])
bestPrune :: PruneCheck -> PruneCheck -> PruneCheck
bestPrune x y
| fst x > fst y = x
| otherwise = y
checkDepsPresent :: [PruneCheck] -> Map Int (Int, Char) -> Bool
checkDepsPresent prunes selected =
all hasDeps $ Set.toList allIds
where
depMap = Map.fromList prunes
allIds = Set.fromList $ Map.elems selected
hasDeps ident =
case Map.lookup ident depMap of
Nothing -> error "checkDepsPresent: missing in depMap"
Just deps -> Set.null $ Set.difference (Set.fromList deps) allIds
runEnvNoLogging :: (GhcPkgExe -> RIO SimplePrettyApp a) -> IO a
runEnvNoLogging inner = do
envVars <- view envVarsL <$> mkDefaultProcessContext
menv <- mkProcessContext $ Map.delete "GHC_PACKAGE_PATH" envVars
let find name = runRIO menv (findExecutable name) >>= either throwIO parseAbsFile
pkg <- GhcPkgExe <$> find "ghc-pkg"
app <- mkSimplePrettyApp mempty (Just menv) True 80 mempty
runRIO app (inner pkg)