pubgrub-0.1.0.0: test/CookbookSpec.hs

{-# LANGUAGE OverloadedStrings #-}

-- | "PubGrub.Cookbook" against what it shows: its code is "Cookbook", and
-- every result its sessions print is asserted here.
module CookbookSpec (tests) where

import qualified Data.Map.Strict  as Map
import qualified Data.Text        as T
import           DocCode          (codeMatches)
import           PubGrub          (MergeRule, Pretty (..), fullVersionSet,
                                   mkVersion, noMerging, singletonVersionSet)
import           PubGrub.Store    (emptyStoreWith, insertClause, storeClauses)
import           Test.Tasty       (TestTree, testGroup)
import           Test.Tasty.HUnit (testCase, (@?=))

import           Cookbook

tests :: TestTree
tests =
    testGroup
        "the cookbook"
        [ testCase "its code is Cookbook.hs" $
            codeMatches "src/PubGrub/Cookbook.hs" "test/Cookbook.hs"
        , testCase "a plan" $
            plan example [request app fullVersionSet]
                @?= Just (Map.fromList [(app, mkVersion [1]), (lib, mkVersion [2]), (util, mkVersion [2])])
        , testCase "a constraint on a requested package" $
            plan example [request app fullVersionSet, constrain util (range [1] [2])]
                @?= Just (Map.fromList [(app, mkVersion [1]), (lib, mkVersion [2]), (util, mkVersion [1])])
        , testCase "a constraint on a package nothing requests" $
            plan example [request app fullVersionSet, constrain extra (range [2] [3])]
                @?= Just (Map.fromList [(app, mkVersion [1]), (lib, mkVersion [2]), (util, mkVersion [2])])
        , testCase "an explanation in the domain's words" $
            T.lines (why example [request app fullVersionSet, constrain util (range [3] [4])])
                @?= [ "Because app >=0 depends on lib >=1 && <2.1 which depends on util >=1 && <3, app >=0 requires util >=1 && <3."
                    , "So, because app >=0 is requested and util >=3 && <4 is required by a constraint, version solving failed."
                    ]
        , testCase "two dependencies over touching slots merge into one" $
            let slotOf = slot (map fst (example Map.! lib))
             in pretty (slotOf (mkVersion [1]) <> slotOf (mkVersion [2]))
                    @?= "<2.1"
        , testCase "a fact stated twice is one clause under sameTerms, and two with no rule" $
            let clausesUnder :: MergeRule Name -> Int
                clausesUnder rule =
                    length (storeClauses (snd (insertClause dep (snd (insertClause dep (emptyStoreWith rule))))))
                dep = dependsOn lib (slot (map fst (example Map.! lib)) (mkVersion [1])) util (range [1] [3])
             in (clausesUnder sameTerms, clausesUnder noMerging) @?= (1, 2)
        , testCase "a release passed over, with its reason" $
            why example [request lib (singletonVersionSet (mkVersion [2, 1]))]
                @?= "So, because lib >=2.1 cannot be used: it does not build here and lib ==2.1 is requested, version solving failed."
        , testCase "the search, step by step" $
            searchLog example [request app fullVersionSet, constrain util (range [3] [4])]
                @?= [ "app 1"
                    , "lib 2"
                    , "learned: lib >=2 && <2.1 requires util >=1 && <3"
                    , "back to level 1"
                    , "lib 1"
                    ]
        , testCase "a lock released where it took part in a failure" $
            either (const Nothing) Just
                ( solveWithLock
                    example
                    (Map.fromList [(util, mkVersion [1]), (extra, mkVersion [1])])
                    [request app fullVersionSet, request util (range [2] [3]), request extra fullVersionSet]
                )
                @?= Just (Map.fromList [(app, mkVersion [1]), (extra, mkVersion [1]), (lib, mkVersion [2]), (util, mkVersion [2])])
        ]