staversion-0.2.1.0: test/Staversion/Internal/AggregateSpec.hs
module Staversion.Internal.AggregateSpec (main,spec) where
import Data.Char (toLower)
import Data.List (isInfixOf)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NL
import Data.Monoid (All(..))
import qualified Distribution.Version as V
import Test.Hspec
import Staversion.Internal.Aggregate
( Aggregator,
showVersionRange,
aggOr,
aggPvpMajor,
aggPvpMinor,
aggregateResults,
aggregatePackageVersions
)
import Staversion.Internal.Log (LogEntry(..), LogLevel(..))
import Staversion.Internal.Query (Resolver, PackageSource(..), Query(..), PackageName)
import Staversion.Internal.Cabal (Target(..))
import Staversion.Internal.Result
( Result(..), ResultSource(..), AggregatedResult(..),
ResultBody'(..),
singletonResult
)
import Staversion.Internal.TestUtil
( ver, simpleResultBody, verPairs,
vor,
vthis,
vors, vors',
vint
)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
spec_aggregatePackageVersions
spec_aggregateResults
describe "Aggregators" $ do
spec_or
spec_pvpMajor
spec_pvpMinor
spec_or :: Spec
spec_or = describe "aggOr" $ do
specify "single version" $ do
let input = ver [1,2,3] :| []
expected = V.thisVersion $ ver [1,2,3]
aggOr input `shouldBe` expected
(showVersionRange $ aggOr input) `shouldBe` "==1.2.3"
specify "three versions" $ do
let input = ver [1,2] :| [ver [3,4], ver [5,6], ver [7,8]]
expected = vor (vthis [1,2])
$ vor (vthis [3,4])
$ vor (vthis [5,6])
$ (vthis [7,8])
aggOr input `shouldBe` expected
(showVersionRange $ aggOr input) `shouldBe` "==1.2 || ==3.4 || ==5.6 || ==7.8"
it "should sort versions" $ do
let input = ver [5,5,0] :| [ver [0,2], ver [5,5], ver [3,3,2,1], ver [0,3]]
expected = vor (vthis [0,2])
$ vor (vthis [0,3])
$ vor (vthis [3,3,2,1])
$ vor (vthis [5,5])
$ (vthis [5,5,0])
aggOr input `shouldBe` expected
(showVersionRange $ aggOr input) `shouldBe` "==0.2 || ==0.3 || ==3.3.2.1 || ==5.5 || ==5.5.0"
it "should eliminate duplicates" $ do
let input = ver [1,0] :| [ver [0,4], ver [1,2], ver [0,4], ver [1,0]]
expected = vor (vthis [0,4])
$ vor (vthis [1,0])
$ (vthis [1,2])
aggOr input `shouldBe` expected
spec_pvpMajor :: Spec
spec_pvpMajor = describe "aggPvpMajor" $ before (return aggPvpMajor) $ do
testAgg [[1,2,0,7]] $ vint [1,2,0,7] [1,3]
testAgg [[1,2,3,0]] $ vint [1,2,3] [1,3] -- trailing-zero
testAgg [[1,2,0,0]] $ vint [1,2] [1,3] -- trailing-zeroes
testAgg [[1,2,10]] $ vint [1,2,10] [1,3]
testAgg [[1,2,0]] $ vint [1,2] [1,3] -- trailing-zero
testAgg [[1,2]] $ vint [1,2] [1,3]
testAgg [[1,0]] $ vint [1] [1,1] -- trailing-zero
testAgg [[1,0,0,0]] $ vint [1] [1,1] -- traling-zeroes
testAgg [[1]] $ vint [1] [1,1] -- because 1 and 1.0 are considered equivalent.
testAgg [[0]] $ vint [0] [0,1]
testAgg [[0,0]] $ vint [0] [0,1]
testAgg [[0,0,0]] $ vint [0] [0,1]
testAgg [[0,0,1]] $ vint [0,0,1] [0,1]
testAgg [[1,2,0,7], [1,2,3,0]] $ vint [1,2,0,7] [1,3]
testAgg [[1,2,0,7], [1,2,0,7]] $ vint [1,2,0,7] [1,3]
testAgg [[1,2,0,7], [1,3]] $ vint [1,2,0,7] [1,4]
testAgg [[1,2,0,7], [1,3,4]] $ vors' [ vint [1,2,0,7] [1,3],
vint [1,3,4] [1,4]
]
testAgg [[1,2,0,7], [1,3,0]] $ vint [1,2,0,7] [1,4] -- trailing-zero
testAgg [[1,3,4], [1,2,0,7]] $ vors' [ vint [1,2,0,7] [1,3],
vint [1,3,4] [1,4]
]
testAgg [[1,3,0], [1,2,0,7]] $ vint [1,2,0,7] [1,4]
testAgg [[1,2,0,7], [1,3,0,8]] $ vors' [ vint [1,2,0,7] [1,3],
vint [1,3,0,8] [1,4]
]
testAgg [[1,2,0,0], [1,3,0,0]] $ vint [1,2] [1,4] -- trailing-zeroes
testAgg [[1,3,0,8], [1,2,0,7]] $ vors' [ vint [1,2,0,7] [1,3],
vint [1,3,0,8] [1,4]
]
testAgg [[1,2,0,7], [2]] $ vors' [ vint [1,2,0,7] [1,3],
vint [2] [2,1]
]
testAgg [[2,2,0], [2,0], [3,5,0,1], [2,2,0,5]] $ vors' [ vint [2] [2,1],
vint [2,2] [2,3],
vint [3,5,0,1] [3,6]
]
spec_pvpMinor :: Spec
spec_pvpMinor = describe "aggPvpMinor" $ before (return aggPvpMinor) $ do
testAgg [[1,2,0,7]] $ vint [1,2,0,7] [1,2,1]
testAgg [[1,2,3,0]] $ vint [1,2,3] [1,2,4] -- trailing-zero
testAgg [[1,2,0,0]] $ vint [1,2] [1,2,1] -- trailing-zeroes
testAgg [[1,2,10]] $ vint [1,2,10] [1,2,11]
testAgg [[1,2,0]] $ vint [1,2] [1,2,1] -- trailing-zero
testAgg [[1,2]] $ vint [1,2] [1,2,1]
testAgg [[1,0]] $ vint [1] [1,0,1] -- trailing-zero
testAgg [[1,0,0,0]] $ vint [1] [1,0,1] -- traling-zeroes
testAgg [[1]] $ vint [1] [1,0,1] -- because 1 and 1.0 are considered equivalent.
testAgg [[0]] $ vint [0] [0,0,1]
testAgg [[0,0]] $ vint [0] [0,0,1]
testAgg [[0,0,0]] $ vint [0] [0,0,1]
testAgg [[0,0,1]] $ vint [0,0,1] [0,0,2]
testAgg [[1,2,0,7], [1,2,3,0]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,2,3] [1,2,4]
]
testAgg [[1,2,0,7], [1,2,0,7]] $ vint [1,2,0,7] [1,2,1]
testAgg [[1,2,0,7], [1,3]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3] [1,3,1]
]
testAgg [[1,2,0,7], [1,3,4]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3,4] [1,3,5]
]
testAgg [[1,2,0,7], [1,3,0]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3] [1,3,1]
]
testAgg [[1,3,4], [1,2,0,7]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3,4] [1,3,5]
]
testAgg [[1,3,0], [1,2,0,7]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3] [1,3,1]
]
testAgg [[1,2,0,7], [1,3,0,8]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3,0,8] [1,3,1]
]
testAgg [[1,2,0,0], [1,3,0,0]] $ vors' [ vint [1,2] [1,2,1],
vint [1,3] [1,3,1]
]
testAgg [[1,3,0,8], [1,2,0,7]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [1,3,0,8] [1,3,1]
]
testAgg [[1,2,0,7], [2]] $ vors' [ vint [1,2,0,7] [1,2,1],
vint [2] [2,0,1]
]
testAgg [[2,2,0], [2,0], [3,5,0,1], [2,2,0,5]] $ vors' [ vint [2] [2,0,1],
vint [2,2] [2,2,1],
vint [3,5,0,1] [3,5,1]
]
testAgg [[1,2,2,4], [1,2,1,0], [1,2,0,4]] $ vors' [ vint [1,2,0,4] [1,2,2],
vint [1,2,2,4] [1,2,3]
]
testAgg :: [[Int]] -> V.VersionRange -> SpecWith Aggregator
testAgg input expected = specify desc $ \agg -> agg input' `shouldBe` expected where
input' = case input of
[] -> error "input to Aggregator must be non-empty."
(h : rest) -> fmap ver $ (h :| rest)
desc = show input ++ " -> " ++ showVersionRange expected
spec_aggregateResults :: Spec
spec_aggregateResults = describe "aggregateResults" $ do
it "should return empty for empty input" $ do
let (agg_ret, _) = aggregateResults aggOr []
agg_ret `shouldBe` []
it "should aggregate SimpleResultBody" $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0],
simpleResult "lts-6.0" "hoge" [2,0],
simpleResult "lts-7.0" "hoge" [3,0]
]
expected = AggregatedResult { aggResultIn = rsource "lts-5.0"
:| [ rsource "lts-6.0",
rsource "lts-7.0"
],
aggResultFor = QueryName "hoge",
aggResultBody = Right $ SimpleResultBody "hoge"
$ Just $ vors [[1,0], [2,0], [3,0]]
}
aggregateResults aggOr input `shouldBe` ([expected], [])
it "should group Results based on their resultFor field" $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0],
simpleResult "lts-6.0" "foo" [2,0],
simpleResult "lts-7.0" "bar" [3,0]
]
expected = map singletonResult input
aggregateResults aggOr input `shouldBe` (expected, [])
it "should warn about Left resultBody" $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0],
(simpleResult "lts-6.0" "hoge" []) { resultBody = Left "SOME ERROR"
},
simpleResult "lts-7.0" "hoge" [3,0]
]
expected = AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-7.0"],
aggResultFor = QueryName "hoge",
aggResultBody = Right $ SimpleResultBody "hoge"
$ Just $ vors [[1,0], [3,0]]
}
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` [expected]
(matchLogCount LogWarn "SOME ERROR" got_logs) `shouldBe` 1
it "should produce AggregatedResult with Left body for groups in which all Results are Left" $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0],
(simpleResult "lts-5.0" "foo" []) { resultBody = Left "SOME ERROR"
},
simpleResult "lts-6.0" "hoge" [2,0],
(simpleResult "lts-6.0" "foo" []) { resultBody = Left "SOME ANOTHER ERROR"
}
]
expected = [ AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-6.0"],
aggResultFor = QueryName "hoge",
aggResultBody = Right $ SimpleResultBody "hoge"
$ Just $ vors [[1,0], [2,0]]
},
AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-6.0"],
aggResultFor = QueryName "foo",
aggResultBody = Left "SOME ERROR"
}
]
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` expected
length got_logs `shouldBe` 2
(matchLogCount LogWarn "SOME ERROR" got_logs) `shouldBe` 1
(matchLogCount LogWarn "SOME ANOTHER ERROR" got_logs) `shouldBe` 1
it "should return error if SimpleResultBody and CabalResultBody are mixed in the same resultFor." $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0],
(cabalResult "lts-5.0" "foo.cabal" TargetLibrary [("foo", [1,0])])
{ resultFor = QueryName "hoge"
}
]
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` []
(matchesLogCount LogError ["different", "results", "mixed"] got_logs) `shouldBe` 1
it "should group CabalResultBody based on Target" $ do
let input = [ cabalResult "lts-5.0" "foo.cabal" TargetLibrary [("a", [1,0]), ("b", [0,0,1])],
cabalResult "lts-5.0" "foo.cabal" (TargetExecutable "exe") [("c", [10,5,6]), ("d", [3,4])],
cabalResult "lts-6.0" "foo.cabal" TargetLibrary [("a", [2,0]), ("b", [0,0,1])],
cabalResult "lts-6.0" "foo.cabal" (TargetExecutable "exe") [("c", [8,0]), ("d", [3,3,9])]
]
expected = [ AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-6.0"],
aggResultFor = QueryCabalFile "foo.cabal",
aggResultBody = Right $ CabalResultBody "foo.cabal" TargetLibrary
$ [("a", Just $ vors [[1,0], [2,0]]), ("b", Just $ vors [[0,0,1]])]
},
AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-6.0"],
aggResultFor = QueryCabalFile "foo.cabal",
aggResultBody = Right $ CabalResultBody "foo.cabal" (TargetExecutable "exe")
$ [("c", Just $ vors [[8,0], [10,5,6]]), ("d", Just $ vors [[3,3,9], [3,4]])]
}
]
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` expected
got_logs `shouldBe` []
it "should be ok if source set are inconsistent between different Target for CabalResultBody" $ do
let input = [ cabalResult "lts-5.0" "foo.cabal" TargetLibrary [("a", [1,0]), ("b", [1,1,0])],
cabalResult "lts-6.0" "foo.cabal" (TargetTestSuite "tst") [("a", [2,2,0]), ("c", [10,4,0,1])]
]
expected = [ AggregatedResult { aggResultIn = rsource "lts-5.0" :| [],
aggResultFor = QueryCabalFile "foo.cabal",
aggResultBody = Right $ CabalResultBody "foo.cabal" TargetLibrary
$ [("a", Just $ vors [[1,0]]), ("b", Just $ vors [[1,1,0]])]
},
AggregatedResult { aggResultIn = rsource "lts-6.0" :| [],
aggResultFor = QueryCabalFile "foo.cabal",
aggResultBody = Right $ CabalResultBody "foo.cabal" (TargetTestSuite "tst")
$ [("a", Just $ vors [[2,2,0]]), ("c", Just $ vors [[10,4,0,1]])]
}
]
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` expected
got_logs `shouldBe` []
it "should nub aggregated ResultSources" $ do
let input = [ simpleResult "lts-5.0" "hoge" [1,0,0],
simpleResult "lts-5.0" "hoge" [1,0,0],
simpleResult "lts-5.0" "hoge" [1,0,0]
]
expected = [ AggregatedResult { aggResultIn = rsource "lts-5.0" :| [],
aggResultFor = QueryName "hoge",
aggResultBody = Right $ SimpleResultBody "hoge" $ Just $ vthis [1,0,0]
}
]
aggregateResults aggOr input `shouldBe` (expected, [])
it "should warn about Nothing version in CabalResultBody with Target" $ do
let input = [ cabalResult "lts-5.0" "foo.cabal" TargetLibrary [("hoge-pack", [1,0]), ("b", [1,1,0])],
cabalResult "lts-4.0" "foo.cabal" TargetLibrary [("hoge-pack", []), ("b", [1,0,9])]
]
expected = [ AggregatedResult { aggResultIn = rsource "lts-5.0" :| [rsource "lts-4.0"],
aggResultFor = QueryCabalFile "foo.cabal",
aggResultBody = Right $ CabalResultBody "foo.cabal" TargetLibrary
$ [("hoge-pack", Just $ vthis [1,0]), ("b", Just $ vors [[1,0,9], [1,1,0]])]
}
]
(got, got_logs) = aggregateResults aggOr input
got `shouldBe` expected
length got_logs `shouldBe` 1
(matchesLogCount LogWarn ["hoge-pack", "foo.cabal", "lts-4.0", "TargetLibrary"] got_logs) `shouldBe` 1
rsource :: Resolver -> ResultSource
rsource res = ResultSource { resultSourceQueried = psource,
resultSourceReal = Just psource
}
where
psource = SourceStackage res
simpleResult :: Resolver -> PackageName -> [Int] -> Result
simpleResult resolver pname version =
Result { resultIn = rsource resolver,
resultFor = QueryName pname,
resultBody = Right $ simpleResultBody pname version
}
cabalResult :: Resolver -> FilePath -> Target -> [(PackageName, [Int])] -> Result
cabalResult resolver cabal_file target pmap =
Result { resultIn = rsource resolver,
resultFor = QueryCabalFile cabal_file,
resultBody = Right $ CabalResultBody cabal_file target $ verPairs pmap
}
matchLog :: LogLevel -> String -> LogEntry -> Bool
matchLog exp_level exp_msg_part entry = (logLevel entry == exp_level)
&& (lc exp_msg_part `isInfixOf` (lc $ logMessage entry))
where
lc = map toLower
matchLogCount :: LogLevel -> String -> [LogEntry] -> Int
matchLogCount exp_level exp_msg_part = matchesLogCount exp_level [exp_msg_part]
matchesLogCount :: LogLevel -> [String] -> [LogEntry] -> Int
matchesLogCount exp_level exp_msg_parts = length . filter predicate where
predicate entry = getAll $ mconcat $ map (\exp_msg_part -> All $ matchLog exp_level exp_msg_part entry) exp_msg_parts
seqLabels :: NonEmpty a -> NonEmpty (String, a)
seqLabels = NL.zip labels where
labels = NL.fromList $ map (\n -> "ENTRY" ++ show n) ([0..] :: [Int])
spec_aggregatePackageVersions :: Spec
spec_aggregatePackageVersions = describe "aggregatePackageVersions" $ do
it "should accept an empty map" $ do
let got = aggregatePackageVersions aggOr $ seqLabels ([] :| [[], []])
got `shouldBe` (Just [], [])
it "should aggregate package version maps" $ do
let input = [("foo", Just $ ver [1,0]),
("bar", Just $ ver [1,2,3]),
("buzz", Just $ ver [2,0,5])
]
:| [ [ ("foo", Just $ ver [2,0]),
("bar", Just $ ver [1,0,0,2]),
("buzz", Just $ ver [2,1])
],
[ ("foo", Just $ ver [3,0]),
("bar", Just $ ver [0,0,4]),
("buzz", Just $ ver [2,2,0,10])
]
]
expected = [ ("foo", Just $ vors [[1,0], [2,0], [3,0]]),
("bar", Just $ vors [[0,0,4], [1,0,0,2], [1,2,3]]),
("buzz", Just $ vors [[2,0,5], [2,1], [2,2,0,10]])
]
aggregatePackageVersions aggOr (seqLabels input) `shouldBe` (Just expected, [])
it "should warn about Nothing version" $ do
let input = [("foo", Nothing)]
:| [ [("foo", Just $ ver [1,0])],
[("foo", Just $ ver [2,0])]
]
(got, got_logs) = aggregatePackageVersions aggOr $ seqLabels input
got `shouldBe` Just ([("foo", Just $ vors [[1,0], [2,0]])])
length got_logs `shouldBe` 1
matchesLogCount LogWarn ["foo", "ENTRY0", "missing"] got_logs `shouldBe` 1
it "should return Nothing VersionRange if all versions are Nothing" $ do
let input = [("foo", Nothing)]
:| [ [("foo", Nothing)],
[("foo", Nothing)]
]
(got, got_logs) = aggregatePackageVersions aggOr $ seqLabels input
got `shouldBe` Just ([("foo", Nothing)])
matchesLogCount LogWarn ["foo", "missing"] got_logs `shouldBe` 3
it "should be an error if package lists are inconsistent" $ do
let input = [("foo", Just $ ver [1,0])]
:| [ [("foo", Just $ ver [2,0])],
[("bar", Just $ ver [3,0])]
]
(got, got_logs) = aggregatePackageVersions aggOr $ seqLabels input
got `shouldBe` Nothing
length got_logs `shouldBe` 1
matchesLogCount LogError ["inconsistent", "package list"] got_logs `shouldBe` 1