95 lines
3.7 KiB
Haskell
95 lines
3.7 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 (fmap (second Just) x4)
|
|
$ applyMetas (fmap (second Just) 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.toAscList . unMeta
|
|
{- TODO
|
|
describe "applyMetas" $ do
|
|
it "should actually set values" $ do
|
|
(ml, abMetaOriginal, blocks) <- generate arbitrary
|
|
let
|
|
metaOriginal = unArbitraryMeta abMetaOriginal
|
|
pd = Pandoc metaOriginal blocks
|
|
mlKeys = Set.fromList $ fst <$> ml
|
|
(Pandoc newMeta _) = applyMetas (fmap (Just . MetaString) <$> ml) pd
|
|
ml' = [(k,t) | (k, MetaString t) <- mlist newMeta, Set.member k mlKeys]
|
|
ml `shouldMatchList` ml'
|
|
it "should preserve untouched settings" $ do
|
|
(ml, abMetaOriginal, blocks) <- generate arbitrary
|
|
let
|
|
metaOriginal = unArbitraryMeta abMetaOriginal
|
|
pd = Pandoc metaOriginal blocks
|
|
nullKeys = Set.fromList [k | (k, Nothing) <- ml]
|
|
(Pandoc newMeta _) = applyMetas (fmap (fmap MetaString) <$> ml) pd
|
|
oldm = [(k,t) | (k, t) <- mlist metaOriginal , Set.member k nullKeys]
|
|
newm = [(k,t) | (k, t) <- mlist newMeta , Set.member k nullKeys]
|
|
oldm `shouldMatchList` newm
|
|
-}
|
|
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
|
|
(unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
|
|
|
|
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
|
|
((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
|
|
newBlocks `shouldBe` oldBlocks
|
|
|
|
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta |