staversion 0.2.0.0 → 0.2.1.0
raw patch · 12 files changed
+249/−107 lines, 12 filesdep ~Cabaldep ~QuickCheckdep ~optparse-applicative
Dependency ranges changed: Cabal, QuickCheck, optparse-applicative
Files
- ChangeLog.md +6/−0
- README.md +11/−10
- src/Staversion/Internal/Aggregate.hs +2/−1
- src/Staversion/Internal/Command.hs +63/−22
- src/Staversion/Internal/Exec.hs +17/−10
- src/Staversion/Internal/Format.hs +58/−26
- staversion.cabal +4/−4
- test/NetworkTest.hs +5/−3
- test/Staversion/Internal/AggregateSpec.hs +7/−21
- test/Staversion/Internal/ExecSpec.hs +3/−2
- test/Staversion/Internal/FormatSpec.hs +46/−7
- test/Staversion/Internal/TestUtil.hs +27/−1
ChangeLog.md view
@@ -1,5 +1,11 @@ # Revision history for staversion +## 0.2.1.0 -- 2017-06-18++* Add `--format-version` option.+* `--format-version cabal-caret` option uses the caret operator (`^>=`) if possible. (#2)++ ## 0.2.0.0 -- 2017-05-14 * [breaking change] `pvp` aggregator now does "trailing-zero
README.md view
@@ -80,24 +80,25 @@ `pvp` rule aggregates versions into a range that should be compatible with the obtained versions in terms of PVP (Package Versioning Policy.) $ staversion --aggregate pvp -r lts-5 -r lts-6 -r lts-7 -H aeson- ------ lts-5 (lts-5.18), lts-6 (lts-6.31), lts-7 (lts-7.20), latest in hackage- aeson >=0.9.0.1 && <0.10 || >=0.11.3.0 && <0.12 || >=1.1.1.0 && <1.2+ ------ lts-5 (lts-5.18), lts-6 (lts-6.31), lts-7 (lts-7.22), latest in hackage+ aeson >=0.9.0.1 && <0.10 || >=0.11.3 && <0.12 || ==1.2.* You can use `--aggregate` option with querying .cabal files. $ staversion --aggregate pvp -r lts-6 -r lts-7 -r lts-8 staversion.cabal - ------ lts-6 (lts-6.31), lts-7 (lts-7.20), lts-8 (lts-8.8)+ ------ lts-6 (lts-6.31), lts-7 (lts-7.22), lts-8 (lts-8.13) -- staversion.cabal - library- base >=4.8.2.0 && <4.9 || >=4.9.0.0 && <4.10,- unordered-containers >=0.2.7.2 && <0.3,- aeson >=0.11.3.0 && <0.12 || >=1.0.2.1 && <1.1,+ base >=4.8.2 && <4.10,+ unordered-containers >=0.2.8 && <0.3,+ aeson >=0.11.3 && <0.12 || >=1.0.2.1 && <1.1, text >=1.2.2.1 && <1.3,- bytestring >=0.10.6.0 && <0.11,+ bytestring >=0.10.6 && <0.11, yaml >=0.8.22 && <0.9,- filepath >=1.4.0.0 && <1.5,- directory >=1.2.2.0 && <1.3 || >=1.3.0.0 && <1.4,- optparse-applicative >=0.12.1.0 && <0.13 || >=0.13.2.0 && <0.14,+ filepath ==1.4.*,+ directory >=1.2.2 && <1.4,+ optparse-applicative >=0.12.1 && <0.13 || >=0.13.2 && <0.14, containers >=0.5.6.2 && <0.6,+ http-client >=0.4.31.2 && <0.5 || >=0.5.6.1 && <0.6, (snip)
src/Staversion/Internal/Aggregate.hs view
@@ -37,8 +37,8 @@ import Data.Traversable (traverse) import Data.Version (Version, makeVersion) import Distribution.Version (VersionRange)-import qualified Distribution.Version as V import qualified Distribution.Text as DT+import qualified Distribution.Version as V import qualified Text.PrettyPrint as Pretty import Staversion.Internal.Cabal (Target(..))@@ -49,6 +49,7 @@ -- | Aggregate some 'Version's into a 'VersionRange'. type Aggregator = NonEmpty Version -> VersionRange +-- | Let Cabal convert 'VersionRange' to 'String' showVersionRange :: VersionRange -> String showVersionRange = Pretty.render . DT.disp
src/Staversion/Internal/Command.hs view
@@ -6,7 +6,8 @@ -- __This is an internal module. End-users should not use it.__ module Staversion.Internal.Command ( Command(..),- parseCommandArgs+ parseCommandArgs,+ defFormatConfig ) where import Control.Applicative ((<$>), (<*>), optional, some, (<|>))@@ -22,6 +23,8 @@ import Staversion.Internal.Aggregate (Aggregator) import qualified Staversion.Internal.Aggregate as Agg+import Staversion.Internal.Format (FormatConfig(..), FormatVersion)+import qualified Staversion.Internal.Format as Format import Staversion.Internal.Log ( LogLevel(..), Logger(loggerThreshold), defaultLogger )@@ -45,8 +48,10 @@ -- ^ package queries commAllowNetwork :: Bool, -- ^ if 'True', it accesses the Internet to query build plans etc.- commAggregator :: Maybe Aggregator+ commAggregator :: Maybe Aggregator, -- ^ if 'Just', do aggregation over the results.+ commFormatConfig :: FormatConfig+ -- ^ config for the formatter } -- | Default values for 'Command'.@@ -59,9 +64,9 @@ home <- getHomeDirectory return $ home </> ".stack" </> "build-plan" - commandParser :: DefCommand -> Opt.Parser Command-commandParser def_comm = Command <$> build_plan_dir <*> logger <*> sources <*> queries <*> network <*> aggregate where+commandParser def_comm = Command <$> build_plan_dir <*> logger <*> sources+ <*> queries <*> network <*> aggregate <*> format_config where logger = makeLogger <$> is_verbose makeLogger True = defaultLogger { loggerThreshold = Just LogDebug } makeLogger False = defaultLogger@@ -107,6 +112,13 @@ Opt.metavar "AGGREGATOR", Opt.helpDoc $ Just $ docAggregators "AGGREGATOR" ]+ format_config = FormatConfig <$> format_version+ format_version = Opt.option (maybeReader "FORMAT" $ parseSelect formatVersions)+ $ mconcat [ Opt.long "format-version",+ Opt.metavar "FORMAT",+ Opt.helpDoc $ Just $ docFormatVersions "FORMAT",+ Opt.value $ fconfFormatVersion defFormatConfig+ ] maybeReader :: String -> (String -> Maybe a) -> Opt.ReadM a maybeReader metavar mfunc = do@@ -115,22 +127,24 @@ Nothing -> Opt.readerError ("Unknown " ++ metavar ++ ": " ++ got) Just v -> return v -data AggregatorSpec =- AggregatorSpec { aggSpecFunc :: Aggregator,- aggSpecSymbol :: String,- aggSpecDesc :: String- } +data SelectSpec a = SelectSpec { selectResult :: a,+ selectSymbol :: String,+ selectDesc :: String+ }++type AggregatorSpec = SelectSpec Aggregator+ aggregators :: [AggregatorSpec]-aggregators = [ AggregatorSpec Agg.aggOr "or" "concatenate versions with (||).",- AggregatorSpec Agg.aggPvpMajor "pvp-major"+aggregators = [ SelectSpec Agg.aggOr "or" "concatenate versions with (||).",+ SelectSpec Agg.aggPvpMajor "pvp-major" ( "aggregate versions to a range that is supposed to be " ++ "compatible with the given versions " ++ "in terms of PVP (Package Versioning Policy.) " ++ "Major versions are used for upper bounds." ),- AggregatorSpec Agg.aggPvpMajor "pvp" "alias for 'pvp-major'",- AggregatorSpec Agg.aggPvpMinor "pvp-minor"+ SelectSpec Agg.aggPvpMajor "pvp" "alias for 'pvp-major'",+ SelectSpec Agg.aggPvpMinor "pvp-minor" ( "aggregate versions to a range that is supposed to be " ++ "compatible with the given versions " ++ "in terms of PVP. "@@ -138,22 +152,49 @@ ) ] -parseAggregator :: String -> Maybe Aggregator-parseAggregator symbol = toMaybe $ filter (\spec -> aggSpecSymbol spec == symbol) aggregators where+parseSelect :: [SelectSpec a] -> String -> Maybe a+parseSelect specs symbol = toMaybe $ filter (\spec -> selectSymbol spec == symbol) specs where toMaybe [] = Nothing- toMaybe (a : _) = Just $ aggSpecFunc a+ toMaybe (spec : _) = Just $ selectResult spec +parseAggregator :: String -> Maybe Aggregator+parseAggregator = parseSelect aggregators+ wrapped :: String -> Pretty.Doc wrapped = Pretty.fillSep . map Pretty.text . words +docSelect :: [SelectSpec a] -> String -> String -> Pretty.Doc+docSelect specs foreword_str metavar = Pretty.vsep $ (foreword :) $ map docSpec specs where+ foreword = wrapped ( foreword_str ++ " Possible " ++ metavar ++ " is:" )+ docSpec SelectSpec {selectSymbol = symbol, selectDesc = desc} =+ Pretty.hang 2 $ wrapped (symbol <> ": " <> desc)++docSelectWithDefault :: [SelectSpec a] -> String -> String -> Pretty.Doc+docSelectWithDefault [] foreword metavar = docSelect [] foreword metavar where+docSelectWithDefault (def_spec : rest) foreword metavar = docSelect (def_spec' : rest) foreword metavar where+ def_spec' = def_spec { selectSymbol = selectSymbol def_spec <> " [DEFAULT]" }+ + docAggregators :: String -> Pretty.Doc-docAggregators metaver = Pretty.vsep $ (foreword :) $ map docForAgg aggregators where- foreword = wrapped ( "Aggregate version results over different resolvers."- ++ " Possible " ++ metaver ++ " is:"- )- docForAgg AggregatorSpec {aggSpecSymbol = symbol, aggSpecDesc = desc} =- Pretty.hang 2 $ wrapped ("\"" <> symbol <> "\": " <> desc)+docAggregators = docSelect aggregators "Aggregate version results over different resolvers." ++defFormatConfig :: FormatConfig+defFormatConfig = FormatConfig { fconfFormatVersion = selectResult $ head formatVersions+ }++formatVersions :: [SelectSpec FormatVersion]+formatVersions = [ SelectSpec Format.formatVersionCabal "cabal"+ ( "Let Cabal format VersionRanges"+ ),+ SelectSpec Format.formatVersionCabalCaret "cabal-caret"+ ( "Similar to 'cabal', but it uses the caret operator (^>=) if possible"+ )+ ]+++docFormatVersions :: String -> Pretty.Doc+docFormatVersions = docSelectWithDefault formatVersions "Format for package version ranges." programDescription :: Opt.Parser a -> Opt.ParserInfo a programDescription parser =
src/Staversion/Internal/Exec.hs view
@@ -12,13 +12,15 @@ ) where import Control.Applicative ((<$>))-import Control.Monad (mapM_)+import Control.Monad (mapM_, when) import Data.Either (rights) import Data.Function (on) import Data.List (groupBy, nub)-import Data.Text (unpack)+import Data.Maybe (isJust)+import Data.Text (unpack, pack) import qualified Data.Text.Lazy.IO as TLIO +import Staversion.Internal.Aggregate (aggregateResults) import Staversion.Internal.BuildPlan ( BuildPlan, packageVersion, buildPlanSource, newBuildPlanManager, loadBuildPlan,@@ -28,27 +30,32 @@ ( parseCommandArgs, Command(..) )+import Staversion.Internal.Format (formatAggregatedResults) import qualified Staversion.Internal.Format as Format import Staversion.Internal.Log (logDebug, logError, Logger, putLogEntry) import Staversion.Internal.Query ( Query(..), PackageSource(..), PackageName, ErrorMsg )-import Staversion.Internal.Result (Result(..), ResultBody, ResultBody'(..), ResultSource(..))+import Staversion.Internal.Result+ ( Result(..), ResultBody, ResultBody'(..), ResultSource(..),+ singletonResult+ ) import Staversion.Internal.Cabal (BuildDepends(..), loadCabalFile) main :: IO () main = do comm <- parseCommandArgs- showFormatResult comm =<< formatResults comm =<< (processCommand comm)+ formatAndShow comm =<< aggregate comm =<< (processCommand comm) where- formatResults comm results = case commAggregator comm of- Nothing -> return (Format.formatResultsCabal results, [])+ aggregate comm results = case commAggregator comm of+ Nothing -> return $ map singletonResult results Just agg -> do logDebug (commLogger comm) ("Results before aggregation: " ++ show results)- return $ Format.formatResultsCabalAggregated agg results- showFormatResult comm (formatted, logs) = do- mapM_ (putLogEntry $ commLogger comm) logs- TLIO.putStr formatted+ let (aresults, logs) = aggregateResults agg results+ mapM_ (putLogEntry $ commLogger comm) logs+ return aresults+ formatAndShow comm aresults = do+ TLIO.putStr $ formatAggregatedResults (commFormatConfig comm) aresults data ResolvedQuery = RQueryOne PackageName | RQueryCabal FilePath BuildDepends
src/Staversion/Internal/Format.hs view
@@ -5,8 +5,11 @@ -- -- __This is an internal module. End-users should not use it.__ module Staversion.Internal.Format- ( formatResultsCabal,- formatResultsCabalAggregated+ ( formatAggregatedResults,+ FormatConfig(..),+ FormatVersion,+ formatVersionCabal,+ formatVersionCabalCaret ) where import Data.Foldable (fold)@@ -14,14 +17,18 @@ import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NL+import Data.Maybe (fromJust) import Data.Monoid (mempty, mconcat, (<>))+import Data.Text (Text, pack)+import qualified Data.Text as Text import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder, toLazyText, fromText, fromString) import Distribution.Version (VersionRange)+import qualified Distribution.Version as V import Staversion.Internal.Aggregate- ( Aggregator, showVersionRange, groupAllPreservingOrderBy,- aggregateResults+ ( groupAllPreservingOrderBy,+ showVersionRange ) import Staversion.Internal.Query ( Query(..),@@ -35,16 +42,40 @@ import Staversion.Internal.Cabal (Target(..)) import Staversion.Internal.Log (LogEntry) --- | format 'Result's like it's in build-depends in .cabal files.-formatResultsCabal :: [Result] -> TL.Text-formatResultsCabal = formatAggregatedResults . map singletonResult+-- | Format for 'VersionRange'.+type FormatVersion = VersionRange -> Text --- | aggregate 'Result's and format them like it's in build-depends in--- .cabal files.-formatResultsCabalAggregated :: Aggregator -> [Result] -> (TL.Text, [LogEntry])-formatResultsCabalAggregated aggregator = (\(aggs, logs) -> (formatAggregatedResults aggs, logs))- . aggregateResults aggregator+-- | Let Cabal format 'VersionRange'.+formatVersionCabal :: FormatVersion+formatVersionCabal = pack . showVersionRange +-- | Similar to 'formatVersionCabal', but it uses the \"caret\"+-- operator (@^>=@) where possible.+formatVersionCabalCaret :: FormatVersion+formatVersionCabalCaret = Text.intercalate " || " . map formatVersionIntervalCaret . V.asVersionIntervals++formatVersionIntervalCaret :: V.VersionInterval -> Text+formatVersionIntervalCaret vi = case vi of+ (V.LowerBound lv V.InclusiveBound, V.UpperBound uv V.ExclusiveBound) ->+ if isCaretOK lv uv+ then "^>=" <> formatV lv+ else fallback+ _ -> fallback+ where+ formatV v = pack $ concat $ intersperse "." $ map show $ V.versionBranch v+ fallback = formatVersionCabal $ V.fromVersionIntervals $ fromJust $ V.mkVersionIntervals [vi]++isCaretOK :: V.Version -> V.Version -> Bool+isCaretOK inc_lv exc_uv = isCaretOK' (V.versionBranch inc_lv) (V.versionBranch exc_uv) where+ isCaretOK' [] uv' = uv' == [0,1]+ isCaretOK' [x] uv' = uv' == [x,1]+ isCaretOK' (x : y : _) uv' = uv' == [x,y+1]++++data FormatConfig = FormatConfig { fconfFormatVersion :: FormatVersion+ }+ -- | 'Left' lines and 'Right' lines are handled differently by -- 'formatResultBlock'. It puts commas at the right places assuming -- 'Left' lines are commented out.@@ -53,30 +84,31 @@ data ResultBlock = RBHead Builder [ResultBlock] -- ^ header and child blocks | RBLines [ResultLine] -- ^ a block, which consists of some lines. -formatAggregatedResults :: [AggregatedResult] -> TL.Text-formatAggregatedResults = toLazyText . mconcat . map formatResultBlock . makeSourceBlocks -makeSourceBlocks :: [AggregatedResult] -> [ResultBlock]-makeSourceBlocks = map sourceBlock . groupAllPreservingOrderBy ((==) `on` aggResultIn) where- sourceBlock results@(head_ret :| _) = RBHead header $ makeQueryBlocks $ NL.toList results where+formatAggregatedResults :: FormatConfig -> [AggregatedResult] -> TL.Text+formatAggregatedResults fconf = toLazyText . mconcat . map formatResultBlock . makeSourceBlocks fconf++makeSourceBlocks :: FormatConfig -> [AggregatedResult] -> [ResultBlock]+makeSourceBlocks fconf = map sourceBlock . groupAllPreservingOrderBy ((==) `on` aggResultIn) where+ sourceBlock results@(head_ret :| _) = RBHead header $ makeQueryBlocks fconf $ NL.toList results where header = "------ " <> (fold $ NL.intersperse ", " $ fmap sourceHeader $ aggResultIn head_ret) sourceHeader :: ResultSource -> Builder sourceHeader = fromText . resultSourceDesc -makeQueryBlocks :: [AggregatedResult] -> [ResultBlock]-makeQueryBlocks = uncurry prependLines . foldr f ([], []) where+makeQueryBlocks :: FormatConfig -> [AggregatedResult] -> [ResultBlock]+makeQueryBlocks fconf = uncurry prependLines . foldr f ([], []) where prependLines blocks [] = blocks prependLines blocks rlines = (RBLines rlines) : blocks f ret (blocks, rlines) = case (aggResultFor ret, aggResultBody ret) of- (_, Right (SimpleResultBody name mver)) -> (blocks, (versionLine name mver) : rlines)- (_, Right (CabalResultBody file target pairs)) -> (cabalFileSuccessBlock file target pairs : prependLines blocks rlines, [])+ (_, Right (SimpleResultBody name mver)) -> (blocks, (versionLine (fconfFormatVersion fconf) name mver) : rlines)+ (_, Right (CabalResultBody file target pairs)) -> (cabalFileSuccessBlock fconf file target pairs : prependLines blocks rlines, []) ((QueryName name), Left _) -> (blocks, (packageErrorLine name) : rlines) ((QueryCabalFile file), Left _) -> (cabalFileErrorBlock file : prependLines blocks rlines, []) -versionLine :: PackageName -> Maybe VersionRange -> ResultLine-versionLine name Nothing = Left $ "-- " <> fromText name <> " N/A"-versionLine name (Just ver_range) = Right $ fromText name <> " " <> (fromString $ showVersionRange ver_range)+versionLine :: FormatVersion -> PackageName -> Maybe VersionRange -> ResultLine+versionLine _ name Nothing = Left $ "-- " <> fromText name <> " N/A"+versionLine format_version name (Just ver_range) = Right $ fromText name <> " " <> (fromText $ format_version ver_range) packageErrorLine :: PackageName -> ResultLine packageErrorLine name = Left $ "-- " <> fromText name <> " ERROR"@@ -85,8 +117,8 @@ cabalFileErrorBlock file = RBLines [Left line] where line = "-- " <> fromString file <> " ERROR" -cabalFileSuccessBlock :: FilePath -> Target -> [(PackageName, Maybe VersionRange)] -> ResultBlock-cabalFileSuccessBlock file target pairs = RBHead header [RBLines $ map (uncurry versionLine) pairs] where+cabalFileSuccessBlock :: FormatConfig -> FilePath -> Target -> [(PackageName, Maybe VersionRange)] -> ResultBlock+cabalFileSuccessBlock fconf file target pairs = RBHead header [RBLines $ map (uncurry $ versionLine $ fconfFormatVersion fconf) pairs] where header = "-- " <> fromString file <> " - " <> target_text target_text = case target of TargetLibrary -> "library"
staversion.cabal view
@@ -1,5 +1,5 @@ name: staversion-version: 0.2.0.0+version: 0.2.1.0 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -53,7 +53,7 @@ yaml >=0.8.3 && <0.9, filepath >=1.3.0 && <1.5, directory >=1.2.0 && <1.4,- optparse-applicative >=0.11.0 && <0.14,+ optparse-applicative >=0.11.0 && <0.15, containers >=0.5.5 && <0.6, http-client >=0.4.18 && <0.6, http-client-tls >=0.2.2 && <0.4,@@ -96,7 +96,7 @@ build-depends: base, staversion, text, filepath, bytestring, Cabal, semigroups, hspec >=2.1.7,- QuickCheck >=2.8.1 && <2.10+ QuickCheck >=2.8.1 && <2.11 flag network-test description: Enable network tests.@@ -113,7 +113,7 @@ buildable: False -- other-extensions: other-modules: Staversion.Internal.TestUtil- build-depends: base, staversion, http-client, http-client-tls, bytestring,+ build-depends: base, staversion, http-client, http-client-tls, bytestring, Cabal, hspec
test/NetworkTest.hs view
@@ -24,7 +24,7 @@ PartialResolver(..), ExactResolver(..), parseResolverString )-import Staversion.Internal.Command (Command(..))+import Staversion.Internal.Command (Command(..), defFormatConfig) import Staversion.Internal.Exec (processCommand) import Staversion.Internal.Log (defaultLogger, Logger(loggerThreshold)) import Staversion.Internal.Query@@ -123,7 +123,8 @@ commSources = [SourceStackage "lts-3"], commQueries = [QueryName "base"], commAllowNetwork = True,- commAggregator = Nothing+ commAggregator = Nothing,+ commFormatConfig = defFormatConfig } [ret] <- processCommand comm (resultSourceQueried . resultIn) ret `shouldBe` SourceStackage "lts-3"@@ -143,7 +144,8 @@ commSources = [SourceHackage], commQueries = [QueryName "base"], commAllowNetwork = True,- commAggregator = Nothing+ commAggregator = Nothing,+ commFormatConfig = defFormatConfig } [ret] <- processCommand comm (resultSourceQueried . resultIn) ret `shouldBe` SourceHackage
test/Staversion/Internal/AggregateSpec.hs view
@@ -4,7 +4,6 @@ import Data.List (isInfixOf) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NL-import Data.Maybe (fromJust) import Data.Monoid (All(..)) import qualified Distribution.Version as V import Test.Hspec@@ -26,7 +25,13 @@ ResultBody'(..), singletonResult )-import Staversion.Internal.TestUtil (ver, simpleResultBody, verPairs)+import Staversion.Internal.TestUtil+ ( ver, simpleResultBody, verPairs,+ vor,+ vthis,+ vors, vors',+ vint+ ) main :: IO () main = hspec spec@@ -40,12 +45,6 @@ spec_pvpMajor spec_pvpMinor -vor :: V.VersionRange -> V.VersionRange -> V.VersionRange-vor = V.unionVersionRanges--vthis :: [Int] -> V.VersionRange-vthis = V.thisVersion . ver- spec_or :: Spec spec_or = describe "aggOr" $ do specify "single version" $ do@@ -76,19 +75,6 @@ $ vor (vthis [1,0]) $ (vthis [1,2]) aggOr input `shouldBe` expected--vors :: [[Int]] -> V.VersionRange-vors = vors' . map vthis--vors' :: [V.VersionRange] -> V.VersionRange-vors' [] = error "this should not happen"-vors' [v] = v-vors' (v:rest) = vor v $ vors' rest---- | Version interval. vint x y = [x, y)-vint :: [Int] -> [Int] ->V.VersionRange-vint vl vu = fromJust $ fmap V.fromVersionIntervals $ V.mkVersionIntervals [interval] where- interval = (V.LowerBound (ver vl) V.InclusiveBound, V.UpperBound (ver vu) V.ExclusiveBound) spec_pvpMajor :: Spec spec_pvpMajor = describe "aggPvpMajor" $ before (return aggPvpMajor) $ do
test/Staversion/Internal/ExecSpec.hs view
@@ -8,7 +8,7 @@ import Test.Hspec import Staversion.Internal.BuildPlan (_setLTSDisambiguator)-import Staversion.Internal.Command (Command(..))+import Staversion.Internal.Command (Command(..), defFormatConfig) import Staversion.Internal.Exec ( processCommand, _processCommandWithCustomBuildPlanManager@@ -134,7 +134,8 @@ commSources = [], commQueries = [], commAllowNetwork = False,- commAggregator = Nothing+ commAggregator = Nothing,+ commFormatConfig = defFormatConfig } spec_processCommand_disambiguates :: Spec
test/Staversion/Internal/FormatSpec.hs view
@@ -1,21 +1,32 @@ module Staversion.Internal.FormatSpec (main,spec) where import Data.Monoid ((<>))+import Data.Text (pack)+import qualified Data.Text.Lazy as TL import Test.Hspec -import Staversion.Internal.Aggregate (aggOr)+import Staversion.Internal.Aggregate (aggOr, Aggregator, aggregateResults) import Staversion.Internal.Format- ( formatResultsCabal,- formatResultsCabalAggregated+ ( formatAggregatedResults,+ FormatConfig(..),+ formatVersionCabal,+ formatVersionCabalCaret, )+import Staversion.Internal.Log (LogEntry) import Staversion.Internal.Query ( PackageSource(..), Query(..), Resolver, PackageName )-import Staversion.Internal.Result (Result(..), ResultBody, ResultBody'(..), ResultSource(..))+import Staversion.Internal.Result+ ( Result(..), ResultBody, ResultBody'(..), ResultSource(..),+ singletonResult+ ) import Staversion.Internal.Cabal (Target(..)) -import Staversion.Internal.TestUtil (ver, simpleResultBody, verPairs)+import Staversion.Internal.TestUtil+ ( ver, simpleResultBody, verPairs,+ vthis, vors', vint+ ) @@ -26,9 +37,23 @@ spec = do spec_simple spec_aggregate+ spec_formatVersionCabalCaret +-- | for backward-compatibility.+formatResultsCabal :: [Result] -> TL.Text+formatResultsCabal = formatAggregatedResults fconf . map singletonResult where+ fconf = FormatConfig { fconfFormatVersion = formatVersionCabal+ }++-- | for backward-compatibility.+formatResultsCabalAggregated :: Aggregator -> [Result] -> (TL.Text, [LogEntry])+formatResultsCabalAggregated agg = mapFirst (formatAggregatedResults fconf) . aggregateResults agg where+ fconf = FormatConfig { fconfFormatVersion = formatVersionCabal+ }+ mapFirst f (a, b) = (f a, b)+ spec_simple :: Spec-spec_simple = describe "formatResultsCabal" $ do+spec_simple = describe "formatAggregatedResults" $ do it "should return empty text for empty list" $ do formatResultsCabal [] `shouldBe` "" it "should format a Result in a Cabal way" $ do@@ -221,7 +246,7 @@ formatResultsCabal input `shouldBe` expected spec_aggregate :: Spec-spec_aggregate = describe "formatResultsCabalAggregated" $ do+spec_aggregate = describe "formatAggregatedResults" $ do it "should aggregate Results over multiple package sources" $ do let input = [ simpleResult "lts-4.2" "hoge" [1,2,3], simpleResult "lts-5.0" "hoge" [1,5]@@ -264,3 +289,17 @@ setRealSource :: Resolver -> Result -> Result setRealSource resolver ret = ret { resultIn = rin { resultSourceReal = Just $ SourceStackage resolver } } where rin = resultIn ret++spec_formatVersionCabalCaret :: Spec+spec_formatVersionCabalCaret = describe "formatVersionCabalCaret" $ do+ specify "single" $ do+ formatVersionCabalCaret (vthis [1,0,0]) `shouldBe` "==1.0.0"+ specify "or equals" $ do+ formatVersionCabalCaret (vors' [vthis [1,0,0], vthis [1,0,5,6]]) `shouldBe` "==1.0.0 || ==1.0.5.6"+ specify "caret" $ do+ formatVersionCabalCaret (vint [1,2,3,4] [1,3]) `shouldBe` "^>=1.2.3.4"+ specify "caret or" $ do+ formatVersionCabalCaret (vors' [vint [1] [1,1], vint [2,0,3] [2,1]]) `shouldBe` "^>=1 || ^>=2.0.3"+ specify "mixed" $ do+ formatVersionCabalCaret (vors' [vint [1,2,0,4] [1,2,3], vint [2,0] [2,1], vint [3,0,4,5] [3,1]])+ `shouldBe` ">=1.2.0.4 && <1.2.3 || ^>=2.0 || ^>=3.0.4.5"
test/Staversion/Internal/TestUtil.hs view
@@ -1,9 +1,15 @@ module Staversion.Internal.TestUtil ( ver, simpleResultBody,- verPairs+ verPairs,+ vor,+ vthis,+ vors, vors',+ vint ) where +import Data.Maybe (fromJust) import Data.Version (Version(..))+import qualified Distribution.Version as V import Staversion.Internal.Query ( PackageName ) import Staversion.Internal.Result (ResultBody, ResultBody'(..))@@ -21,3 +27,23 @@ simpleResultBody :: PackageName -> [Int] -> ResultBody simpleResultBody name vs = SimpleResultBody name $ verMaybe vs++vor :: V.VersionRange -> V.VersionRange -> V.VersionRange+vor = V.unionVersionRanges++vthis :: [Int] -> V.VersionRange+vthis = V.thisVersion . ver++vors :: [[Int]] -> V.VersionRange+vors = vors' . map vthis++vors' :: [V.VersionRange] -> V.VersionRange+vors' [] = error "this should not happen"+vors' [v] = v+vors' (v:rest) = vor v $ vors' rest++-- | Version interval. vint x y = [x, y)+vint :: [Int] -> [Int] ->V.VersionRange+vint vl vu = fromJust $ fmap V.fromVersionIntervals $ V.mkVersionIntervals [interval] where+ interval = (V.LowerBound (ver vl) V.InclusiveBound, V.UpperBound (ver vu) V.ExclusiveBound)+