content: {-# LANGUAGE OverloadedStrings #-}
  {- |
     Module      : Tests.Shared
     Copyright   : © 2006-2024 John MacFarlane
     License     : GNU GPL, version 2 or above
  
     Maintainer  : John MacFarlane <jgm@berkeley@edu>
     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 (singleton . toTableOfContents def) desc (toList blocks, 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 [])
  