refactor(tests): pandoc tests simplified
This commit is contained in:
parent
d5214e49ab
commit
085b7ba3e8
@ -36,7 +36,7 @@ isLmsSuccess :: LmsStatus -> Bool
|
||||
isLmsSuccess LmsSuccess{} = True
|
||||
isLmsSuccess _other = False
|
||||
|
||||
-- Entscheidung 08.04.22: LmsSuccess gewinnt immer über LmsBlocked oder umgekehrt
|
||||
-- Entscheidung 08.04.22: LmsSuccess gewinnt immer über LmsBlocked oder umgekehrt; siehe Model.TypesSpec
|
||||
instance Semigroup LmsStatus where
|
||||
a <> b | a >= b = a
|
||||
| otherwise = b
|
||||
|
||||
@ -70,11 +70,12 @@ appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc
|
||||
appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs
|
||||
-- appMeta f = _Meta %~ f -- lens version. Not sure this is better
|
||||
|
||||
-- Add tests for applyMetas, if ever needed
|
||||
-- For tests see module PandocSpec
|
||||
applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
|
||||
applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
|
||||
|
||||
-- | Add meta to pandoc. Existing variables will be overwritten.
|
||||
-- For specification, see module PandocSpec
|
||||
addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
|
||||
addMeta m = appMeta (<> m) -- Data.Map says: (<>) == union and union should prefer the left operand, but somehow it does not!
|
||||
--addMeta m p = meta <> p
|
||||
|
||||
@ -62,8 +62,7 @@ spec = do
|
||||
metaOriginal = unArbitraryMeta abMetaOriginal
|
||||
pd = Pandoc metaOriginal blocks
|
||||
(Pandoc newMeta _) = addMeta metaOverwrite pd
|
||||
keysToPreserve = Map.keysSet $ unMeta metaOverwrite
|
||||
mlist metaOverwrite `shouldMatchList` Map.toList (unMeta newMeta `Map.restrictKeys` keysToPreserve)
|
||||
(unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
|
||||
|
||||
it "should preserve untouched settings" $ do
|
||||
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
|
||||
@ -72,16 +71,13 @@ spec = do
|
||||
metaOriginal = unArbitraryMeta abMetaOriginal
|
||||
pd = Pandoc metaOriginal blocks
|
||||
(Pandoc newMeta _) = addMeta metaOverwrite pd
|
||||
keysToPreserve = Map.keysSet (unMeta metaOriginal) `Set.difference` Map.keysSet (unMeta metaOverwrite)
|
||||
Map.toList (Map.restrictKeys (unMeta newMeta) keysToPreserve)
|
||||
`shouldMatchList`
|
||||
Map.toList (Map.restrictKeys (unMeta metaOriginal) keysToPreserve)
|
||||
((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
|
||||
|
||||
it "should preserve document blocks" $ do
|
||||
(metaOverwrite, pd) <- generate arbitrary
|
||||
let
|
||||
(Pandoc _ oldBlocks) = pd
|
||||
(Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd
|
||||
oldBlocks `shouldBe` newBlocks
|
||||
newBlocks `shouldBe` oldBlocks
|
||||
|
||||
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta
|
||||
Loading…
Reference in New Issue
Block a user