fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(tests): pandoc tests simplified

Browse Source
This commit is contained in:
Steffen Jost 2022-07-20 17:31:05 +02:00
parent d5214e49ab
commit 085b7ba3e8
3 changed files with 6 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Model/Types/Lms.hs
View File

@ -36,7 +36,7 @@ isLmsSuccess :: LmsStatus -> Bool
isLmsSuccess LmsSuccess{} = True isLmsSuccess LmsSuccess{} = True
isLmsSuccess _other = False 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 instance Semigroup LmsStatus where
a <> b | a >= b = a a <> b | a >= b = a
| otherwise = b | otherwise = b

3
src/Utils/Print.hs
View File

@ -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 (P.Pandoc m bs) = P.Pandoc (f m) bs
-- appMeta f = _Meta %~ f -- lens version. Not sure this is better -- 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 :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
-- | Add meta to pandoc. Existing variables will be overwritten. -- | Add meta to pandoc. Existing variables will be overwritten.
-- For specification, see module PandocSpec
addMeta :: P.Meta -> P.Pandoc -> P.Pandoc 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 = appMeta (<> m) -- Data.Map says: (<>) == union and union should prefer the left operand, but somehow it does not!
--addMeta m p = meta <> p --addMeta m p = meta <> p

10
test/PandocSpec.hs
View File

@ -62,8 +62,7 @@ spec = do
metaOriginal = unArbitraryMeta abMetaOriginal metaOriginal = unArbitraryMeta abMetaOriginal
pd = Pandoc metaOriginal blocks pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd (Pandoc newMeta _) = addMeta metaOverwrite pd
keysToPreserve = Map.keysSet $ unMeta metaOverwrite (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
mlist metaOverwrite `shouldMatchList` Map.toList (unMeta newMeta `Map.restrictKeys` keysToPreserve)
it "should preserve untouched settings" $ do it "should preserve untouched settings" $ do
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary (abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
@ -72,16 +71,13 @@ spec = do
metaOriginal = unArbitraryMeta abMetaOriginal metaOriginal = unArbitraryMeta abMetaOriginal
pd = Pandoc metaOriginal blocks pd = Pandoc metaOriginal blocks
(Pandoc newMeta _) = addMeta metaOverwrite pd (Pandoc newMeta _) = addMeta metaOverwrite pd
keysToPreserve = Map.keysSet (unMeta metaOriginal) `Set.difference` Map.keysSet (unMeta metaOverwrite) ((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
Map.toList (Map.restrictKeys (unMeta newMeta) keysToPreserve)
`shouldMatchList`
Map.toList (Map.restrictKeys (unMeta metaOriginal) keysToPreserve)
it "should preserve document blocks" $ do it "should preserve document blocks" $ do
(metaOverwrite, pd) <- generate arbitrary (metaOverwrite, pd) <- generate arbitrary
let let
(Pandoc _ oldBlocks) = pd (Pandoc _ oldBlocks) = pd
(Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd (Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd
oldBlocks `shouldBe` newBlocks newBlocks `shouldBe` oldBlocks
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta -- describe "_Meta" . it "is a lens" . property $ isLens _Meta