87 lines
3.2 KiB
Haskell
87 lines
3.2 KiB
Haskell
module PandocSpec where
|
|
|
|
import TestImport
|
|
|
|
import Utils.Print
|
|
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map.Lazy as Map
|
|
import qualified Data.Foldable as Fold
|
|
import qualified Data.Text as T
|
|
|
|
import Text.Pandoc
|
|
import Text.Pandoc.Builder
|
|
import Text.Pandoc.Arbitrary ()
|
|
|
|
-- Instance Arbitrary Meta is somewhat useless, as it always generates the same 3 keys.
|
|
newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta }
|
|
deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Read)
|
|
|
|
instance Arbitrary ArbitraryMeta where
|
|
arbitrary
|
|
= do (x1 :: Inlines) <- arbitrary
|
|
(x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary
|
|
(x3 :: Inlines) <- arbitrary
|
|
(x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary
|
|
(x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> arbitrary
|
|
return $ ArbitraryMeta
|
|
$ setMeta "title" x1
|
|
$ setMeta "author" x2
|
|
$ setMeta "date" x3
|
|
$ applyMetas x4
|
|
$ applyMetas x5
|
|
nullMeta
|
|
|
|
|
|
-- For Lens Check _Meta required:
|
|
--instance CoArbitrary Inline
|
|
--instance CoArbitrary MetaValue
|
|
--instance CoArbitrary Meta
|
|
--instance Function Inline
|
|
--instance Function MetaValue
|
|
--instance Function Meta
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
let mlist = Map.toList . unMeta
|
|
|
|
describe "applyMetas" $ do
|
|
it "should actually set values" $ do
|
|
(ml, pd) <- generate arbitrary
|
|
let
|
|
mlKeys = Set.fromList $ fst <$> ml
|
|
(Pandoc newMeta _) = applyMetas (fmap MetaString <$> ml) pd
|
|
ml' = [(k,t) | (k, MetaString t) <- mlist newMeta, Set.member k mlKeys]
|
|
ml `shouldMatchList` ml'
|
|
|
|
describe "addMeta" $ do
|
|
it "should possibly overwrite existing settings" $ do
|
|
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
|
|
let
|
|
metaOverwrite = unArbitraryMeta abMetaOverwrite
|
|
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)
|
|
|
|
it "should preserve untouched settings" $ do
|
|
(abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
|
|
let
|
|
metaOverwrite = unArbitraryMeta abMetaOverwrite
|
|
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)
|
|
|
|
it "should preserve document blocks" $ do
|
|
(metaOverwrite, pd) <- generate arbitrary
|
|
let
|
|
(Pandoc _ oldBlocks) = pd
|
|
(Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd
|
|
oldBlocks `shouldBe` newBlocks
|
|
|
|
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta |