stack-2.1.1: src/test/Stack/PackageDumpSpec.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Stack.PackageDumpSpec where
import Conduit
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 Stack.PackageDump
import Stack.Prelude
import Stack.Types.Config
import Stack.Types.GhcPkgId
import RIO.Process
import Test.Hspec
import Test.Hspec.QuickCheck
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") return $
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") return $
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") return $
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") return $
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 _ -> return ()
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 LoggedProcessContext 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"
runRIO (LoggedProcessContext menv mempty) (inner pkg)