101 lines
3.7 KiB
Haskell
101 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, Typeable)
|
|
|
|
newtype ArbitraryPandoc = ArbitraryPandoc { unArbitraryPandoc :: Pandoc }
|
|
deriving newtype (Eq, Ord, Show, Read, Typeable)
|
|
|
|
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
|
|
|
|
instance Arbitrary ArbitraryPandoc where
|
|
arbitrary = do
|
|
meta <- arbitrary
|
|
ArbitraryPandoc . Pandoc (unArbitraryMeta meta) <$> arbitrary
|
|
|
|
|
|
-- 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
|
|
|
|
describe "applyMetas" $ do
|
|
it "should actually set values" $ do
|
|
(metaList, apd) <- generate arbitrary
|
|
let
|
|
pd = unArbitraryPandoc apd
|
|
(Pandoc metaNew _) = applyMetas (second (Just . MetaString) <$> metaList) pd
|
|
mlKeys = Set.fromList $ fst <$> metaList
|
|
metaList' = [(k,t) | (k, MetaString t) <- mlist metaNew, Set.member k mlKeys]
|
|
metaList' `shouldMatchList` metaList
|
|
|
|
it "should preserve untouched settings" $ do
|
|
(metaList, apd) <- generate arbitrary
|
|
let
|
|
pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
|
|
changedKeys = Set.fromList [k | (k, Just _) <- metaList]
|
|
(Pandoc metaNew _) = applyMetas (second (fmap MetaString) <$> metaList) pd
|
|
oldm = [(k,t) | (k,t) <- mlist metaOriginal , Set.notMember k changedKeys]
|
|
newm = [(k,t) | (k,t) <- mlist metaNew , Set.notMember k changedKeys]
|
|
oldm `shouldMatchList` newm
|
|
|
|
describe "addMeta" $ do
|
|
it "should possibly overwrite existing settings" $ do
|
|
(abMetaOverwrite, apd) <- generate arbitrary
|
|
let
|
|
metaOverwrite = unArbitraryMeta abMetaOverwrite
|
|
pd = unArbitraryPandoc apd
|
|
(Pandoc newMeta _) = addMeta metaOverwrite pd
|
|
(unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
|
|
|
|
it "should preserve untouched settings" $ do
|
|
(abMetaOverwrite, apd) <- generate arbitrary
|
|
let
|
|
metaOverwrite = unArbitraryMeta abMetaOverwrite
|
|
pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd
|
|
(Pandoc newMeta _) = addMeta metaOverwrite pd
|
|
((unMeta metaOriginal `Map.difference` unMeta metaOverwrite) `Map.isSubmapOf` unMeta newMeta) `shouldBe` True
|
|
|
|
it "should preserve document blocks" $ do
|
|
(abMetaOverwrite, apd) <- generate arbitrary
|
|
let
|
|
metaOverwrite = unArbitraryMeta abMetaOverwrite
|
|
pd@(Pandoc _ oldBlocks) = unArbitraryPandoc apd
|
|
(Pandoc _ newBlocks) = addMeta metaOverwrite pd
|
|
newBlocks `shouldBe` oldBlocks
|
|
|
|
-- describe "_Meta" . it "is a lens" . property $ isLens _Meta |