{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Shared Copyright : © 2006-2022 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Tests for functions used in many parts of the library. -} module Tests.Shared (tests) where import System.FilePath.Posix (joinPath) import Test.Tasty import Text.Pandoc.Arbitrary () import Test.Tasty.QuickCheck (testProperty) import Text.Pandoc.Builder import Text.Pandoc.Shared import Test.Tasty.HUnit import Tests.Helpers import Text.Pandoc import Text.Pandoc.Writers.Shared import qualified Data.Text as T tests :: [TestTree] tests = [ testGroup "compactifyDL" [ testCase "compactifyDL with empty def" $ assertBool "compactifyDL" (let x = [(str "word", [para (str "def"), mempty])] in compactifyDL x == x) ] , testGroup "collapseFilePath" testCollapse , testGroup "toLegacyTable" testLegacyTable , testGroup "table of contents" testTOC , testGroup "makeSections" [ testProperty "makeSections is idempotent" makeSectionsIsIdempotent , testCase "makeSections is idempotent for test case" $ let d = header 1 "H1" <> header 2 "H2" <> header 3 "H3" <> header 2 "H2a" <> header 4 "H4" <> header 1 "H1a" d' = makeSections False Nothing $ toList d in assertBool "makeSections is idempotent for test case" (makeSections False Nothing d' == d') ] ] makeSectionsIsIdempotent :: [Block] -> Bool makeSectionsIsIdempotent d = let d' = makeSections False Nothing d in d' == makeSections False Nothing d' givesTOC :: String -> (Blocks, Blocks) -> TestTree givesTOC desc (blocks, toc) = test (toTableOfContents def) desc (toList blocks, head . toList $ toc) linkId :: T.Text -> T.Text -> T.Text -> Inlines -> Inlines linkId lId = linkWith (lId,[],[]) headerId :: T.Text -> Int -> Inlines -> Blocks headerId hId = headerWith (hId,[],[]) testTOC :: [TestTree] testTOC = [ givesTOC "empty case" $ mempty =?> bulletList [] , givesTOC "no headers" $ horizontalRule =?> bulletList [] , givesTOC "unlinked header" $ header 1 "H1" =?> bulletList [plain "H1"] , givesTOC "linked header" $ headerId "h1" 1 "H1" =?> bulletList [plain $ linkId "toc-h1" "#h1" "" "H1"] , givesTOC "nested headlines" $ header 1 "H1a" <> header 2 "H2" =?> bulletList [plain "H1a" <> bulletList [plain "H2"]] , givesTOC "only referenced headers" $ header 1 "H1a" <> headerId "h2" 2 "H2" =?> bulletList [plain "H1a" <> bulletList [plain $ linkId "toc-h2" "#h2" "" "H2"]] , givesTOC "section id used as backup" $ divWith ("sec",["section"],[]) (header 1 "H1") =?> bulletList [plain $ linkId "toc-sec" "#sec" "" "H1"] ] testCollapse :: [TestTree] testCollapse = map (testCase "collapse") [ collapseFilePath (joinPath [ ""]) @?= joinPath [ ""] , collapseFilePath (joinPath [ ".","foo"]) @?= joinPath [ "foo"] , collapseFilePath (joinPath [ ".",".","..","foo"]) @?= joinPath [ joinPath ["..", "foo"]] , collapseFilePath (joinPath [ "..","foo"]) @?= joinPath [ "..","foo"] , collapseFilePath (joinPath [ "","bar","..","baz"]) @?= joinPath [ "","baz"] , collapseFilePath (joinPath [ "","..","baz"]) @?= joinPath [ "","..","baz"] , collapseFilePath (joinPath [ ".","foo","..",".","bar","..",".",".","baz"]) @?= joinPath [ "baz"] , collapseFilePath (joinPath [ ".",""]) @?= joinPath [ ""] , collapseFilePath (joinPath [ ".",".",""]) @?= joinPath [ ""] , collapseFilePath (joinPath [ "..",""]) @?= joinPath [ ".."] , collapseFilePath (joinPath [ "..",".",""]) @?= joinPath [ ".."] , collapseFilePath (joinPath [ ".","..",""]) @?= joinPath [ ".."] , collapseFilePath (joinPath [ "..","..",""]) @?= joinPath [ "..",".."] , collapseFilePath (joinPath [ "parent","foo","baz","..","bar"]) @?= joinPath [ "parent","foo","bar"] , collapseFilePath (joinPath [ "parent","foo","baz","..","..","bar"]) @?= joinPath [ "parent","bar"] , collapseFilePath (joinPath [ "parent","foo",".."]) @?= joinPath [ "parent"] , collapseFilePath (joinPath [ "","parent","foo","..","..","bar"]) @?= joinPath [ "","bar"] , collapseFilePath (joinPath [ "",".","parent","foo"]) @?= joinPath [ "","parent","foo"]] testLegacyTable :: [TestTree] testLegacyTable = [ testCase "decomposes a table with head" $ gen1 @?= expect1 , testCase "decomposes a table without head" $ gen2 @?= expect2 , testCase "decomposes the table from issue 7683" $ gen3 @?= expect3 ] where pln = toList . plain . str cl a h w = Cell ("", [], []) AlignDefault h w $ pln a rws = map $ Row nullAttr th = TableHead nullAttr . rws tb n x y = TableBody nullAttr n (rws x) (rws y) tf = TableFoot nullAttr . rws headRows1 = [[cl "a" 1 1, cl "b" 2 2] ,[cl "c" 1 1] ] body1 = tb 1 [[cl "e" 3 1,cl "f" 3 2] ,[] ,[] ] [[emptyCell,emptyCell,emptyCell] ,[cl "g" 1 1,emptyCell,emptyCell] ] footRows1 = [[cl "h" 1 2,cl "i" 2 1] ,[cl "j" 1 2]] caption1 = simpleCaption $ plain "caption" spec1 = replicate 2 (AlignDefault, ColWidth 0.5) ++ [(AlignRight, ColWidthDefault)] expect1 = ( [Str "caption"] , replicate 2 AlignDefault ++ [AlignRight] , replicate 2 0.5 ++ [0] , [pln "a", pln "b", mempty] , [[pln "c", mempty, mempty] ,[pln "e", pln "f", mempty] ,[mempty, mempty, mempty] ,[mempty, mempty, mempty] ,[mempty, mempty, mempty] ,[pln "g", mempty, mempty] ,[pln "h", mempty, pln "i"] ,[pln "j", mempty, mempty]] ) gen1 = toLegacyTable caption1 spec1 (th headRows1) [body1] (tf footRows1) expect2 = ( [] , replicate 2 AlignDefault ++ [AlignRight] , replicate 2 0.5 ++ [0] , [] , [[pln "e", pln "f", mempty] ,[mempty, mempty, mempty] ,[mempty, mempty, mempty] ,[mempty, mempty, mempty] ,[pln "g", mempty, mempty] ,[pln "h", mempty, pln "i"] ,[pln "j", mempty, mempty]] ) gen2 = toLegacyTable emptyCaption spec1 (th []) [body1] (tf footRows1) spec3 = replicate 4 (AlignDefault, ColWidthDefault) body3 = tb 0 [] [[cl "a" 2 1, cl "b" 1 2, cl "c" 2 1] ,[cl "d" 1 1, cl "e" 1 1] ] expect3 = ( [] , replicate 4 AlignDefault , replicate 4 0 , [] , [[pln "a", pln "b", mempty, pln "c"] ,[mempty, pln "d", pln "e", mempty]] ) gen3 = toLegacyTable emptyCaption spec3 (th []) [body3] (tf [])