content: {-# LANGUAGE OverloadedStrings #-}
  {- |
     Module      : Tests.Writers.AnnotatedTable
     Copyright   : 2020 Christian Despres
     License     : GNU GPL, version 2 or above
  
     Maintainer  : Christian Despres <christian.j.j.despres@gmail.com>
     Stability   : alpha
     Portability : portable
  
  Tests for the table helper functions.
  -}
  module Tests.Writers.AnnotatedTable
    ( tests
    )
  where
  
  import           Prelude
  import qualified Data.Foldable                 as F
  import qualified Data.List.NonEmpty            as NonEmpty
  import           Test.Tasty
  import           Test.Tasty.HUnit               ( testCase
                                                  , (@?=)
                                                  )
  import           Test.Tasty.QuickCheck          ( QuickCheckTests(..)
                                                  , Property
                                                  , Testable
                                                  , conjoin
                                                  , forAll
                                                  , testProperty
                                                  , (===)
                                                  , vectorOf
                                                  , choose
                                                  , arbitrary
                                                  , elements
                                                  )
  import           Text.Pandoc.Arbitrary          ( )
  import           Text.Pandoc.Builder
  import qualified Text.Pandoc.Writers.AnnotatedTable
                                                 as Ann
  
  tests :: [TestTree]
  tests = [testGroup "toTable" $ testAnnTable <> annTableProps]
  
  getSpec :: Ann.Cell -> [ColSpec]
  getSpec (Ann.Cell colspec _ _) = F.toList colspec
  
  catHeaderSpec :: Ann.HeaderRow -> [ColSpec]
  catHeaderSpec (Ann.HeaderRow _ _ x) = concatMap getSpec x
  
  catBodySpec :: Ann.BodyRow -> [ColSpec]
  catBodySpec (Ann.BodyRow _ _ x y) = concatMap getSpec x <> concatMap getSpec y
  
  -- Test if the first list can be obtained from the second by deleting
  -- elements from it.
  isSubsetOf :: Eq a => [a] -> [a] -> Bool
  isSubsetOf (x : xs) (y : ys) | x == y    = isSubsetOf xs ys
                               | otherwise = isSubsetOf (x : xs) ys
  isSubsetOf [] _  = True
  isSubsetOf _  [] = False
  
  testAnnTable :: [TestTree]
  testAnnTable =
    [testCase "annotates a sample table properly" $ generated @?= expected]
   where
    spec1 = (AlignRight, ColWidthDefault)
    spec2 = (AlignLeft, ColWidthDefault)
    spec3 = (AlignCenter, ColWidthDefault)
    spec  = [spec1, spec2, spec3]
  
    cl a h w = Cell (a, [], []) AlignDefault h w []
    rws = map $ Row nullAttr
    th  = TableHead nullAttr . rws
    tb n x y = TableBody nullAttr n (rws x) (rws y)
    tf           = TableFoot nullAttr . rws
    initialHeads = [[cl "a" 1 1, cl "b" 3 2], [cl "c" 2 2, cl "d" 1 1]]
    initialTB1   = tb 1
                      [[], [cl "e" 5 1, cl "f" (-7) 0]]
                      [[cl "g" 4 3, cl "h" 4 3], [], [emptyCell]]
    initialTB2 = tb 2 [] [[cl "i" 4 3, cl "j" 4 3]]
    generated  = Ann.toTable nullAttr
                             emptyCaption
                             spec
                             (th initialHeads)
                             [initialTB1, initialTB2]
                             (tf initialHeads)
  
    acl al n a h w =
      Ann.Cell (NonEmpty.fromList al) n $ Cell (a, [], []) AlignDefault h w []
    emptyAnnCell al n = acl al n "" 1 1
    ahrw    = Ann.HeaderRow nullAttr
    abrw    = Ann.BodyRow nullAttr
    ath     = Ann.TableHead nullAttr
    atb     = Ann.TableBody nullAttr
    atf     = Ann.TableFoot nullAttr
  
    finalTH = ath
      [ ahrw 0 [acl [spec1] 0 "a" 1 1, acl [spec2, spec3] 1 "b" 2 2]
      , ahrw 1 [acl [spec1] 0 "c" 1 1]
      ]
    finalTB1 = atb
      1
      [ ahrw
        2
        [emptyAnnCell [spec1] 0, emptyAnnCell [spec2] 1, emptyAnnCell [spec3] 2]
      , ahrw
        3
        [acl [spec1] 0 "e" 1 1, acl [spec2] 1 "f" 1 1, emptyAnnCell [spec3] 2]
      ]
      [ abrw 4 [acl [spec1] 0 "g" 3 1] [acl [spec2, spec3] 1 "h" 3 2]
      , abrw 5 []                      []
      , abrw 6 []                      []
      ]
    finalTB2 =
      atb 2 [] [abrw 7 [acl [spec1, spec2] 0 "i" 1 2] [acl [spec3] 2 "j" 1 1]]
    finalTF = atf
      [ ahrw 8 [acl [spec1] 0 "a" 1 1, acl [spec2, spec3] 1 "b" 2 2]
      , ahrw 9 [acl [spec1] 0 "c" 1 1]
      ]
    expected =
      Ann.Table nullAttr emptyCaption spec finalTH [finalTB1, finalTB2] finalTF
  
  withColSpec :: Testable prop => ([ColSpec] -> prop) -> Property
  withColSpec = forAll arbColSpec
   where
    arbColSpec = do
      cs <- choose (1 :: Int, 6)
      vectorOf
        cs
        ((,) <$> arbitrary <*> elements
          [ColWidthDefault, ColWidth (1 / 3), ColWidth 0.25]
        )
  
  annTableProps :: [TestTree]
  annTableProps =
    localOption (QuickCheckTests 50)
      <$> [ testProperty "normalizes like the table builder"  propBuilderAnnTable
          , testProperty "has valid final cell columns"       propColNumber
          , testProperty "has valid first row column data"    propFirstRowCols
          , testProperty "has valid all row column data"      propColSubsets
          , testProperty "has valid cell column data lengths" propCellColLengths
          ]
  
  -- The property that Ann.toTable will normalize a table identically to
  -- the table builder. This should mean that Ann.toTable is at least as
  -- rigorous as Builder.table in that respect without repeating those
  -- tests here (see the pandoc-types Table tests for examples).
  propBuilderAnnTable :: TableHead -> [TableBody] -> TableFoot -> Property
  propBuilderAnnTable th tbs tf = withColSpec $ \cs ->
    convertTable (table emptyCaption cs th tbs tf)
      === convertAnnTable (Ann.toTable nullAttr emptyCaption cs th tbs tf)
   where
    convertTable blks = case toList blks of
      [Table _ _ colspec a b c] -> Right (colspec, a, b, c)
      x                         -> Left x
    convertAnnTable x = case Ann.fromTable x of
      (_, _, colspec, a, b, c) -> Right (colspec, a, b, c)
  
  -- The property of Ann.toTable that if the last cell in the first row
  -- of a table section has ColSpan w and ColNumber n, then w + n is the
  -- width of the table.
  propColNumber :: TableHead -> [TableBody] -> TableFoot -> Property
  propColNumber th tbs tf = withColSpec $ \cs ->
    let twidth = length cs
        Ann.Table _ _ _ ath atbs atf =
            Ann.toTable nullAttr emptyCaption cs th tbs tf
    in  conjoin
          $  [colNumTH twidth ath]
          <> (colNumTB twidth <$> atbs)
          <> [colNumTF twidth atf]
   where
    colNumTH n (Ann.TableHead _ rs) = firstly (isHeaderValid n) rs
    colNumTB n (Ann.TableBody _ _ rs ts) =
      firstly (isHeaderValid n) rs && firstly (isBodyValid n) ts
    colNumTF n (Ann.TableFoot _ rs) = firstly (isHeaderValid n) rs
  
    isHeaderValid n (Ann.HeaderRow _ _ x) = isSegmentValid n x
    isBodyValid n (Ann.BodyRow _ _ _ x) = isSegmentValid n x
  
    firstly f (x : _) = f x
    firstly _ []      = True
    lastly f [x     ] = f x
    lastly f (_ : xs) = lastly f xs
    lastly _ []       = True
  
    isSegmentValid twidth cs =
      flip lastly cs
        $ \(Ann.Cell _ (Ann.ColNumber n) (Cell _ _ _ (ColSpan w) _)) ->
            n + w == twidth
  
  -- The property of an Ann.Table from Ann.toTable that if the NonEmpty
  -- ColSpec data of the cells in the first row of a table section are
  -- concatenated, the result should equal the [ColSpec] of the entire
  -- table.
  propFirstRowCols :: TableHead -> [TableBody] -> TableFoot -> Property
  propFirstRowCols th tbs tf = withColSpec $ \cs ->
    let Ann.Table _ _ _ ath atbs atf =
            Ann.toTable nullAttr emptyCaption cs th tbs tf
    in  conjoin
          $  [firstRowTH cs ath]
          <> (firstRowTB cs <$> atbs)
          <> [firstRowTF cs atf]
   where
    firstly f (x : _) = f x
    firstly _ []      = True
  
    firstHeaderValid cs = firstly $ \r -> cs == catHeaderSpec r
    firstBodyValid cs = firstly $ \r -> cs == catBodySpec r
  
    firstRowTH cs (Ann.TableHead _ rs) = firstHeaderValid cs rs
    firstRowTB cs (Ann.TableBody _ _ rs ts) =
      firstHeaderValid cs rs && firstBodyValid cs ts
    firstRowTF cs (Ann.TableFoot _ rs) = firstHeaderValid cs rs
  
  -- The property that in any row in an Ann.Table from Ann.toTable, the
  -- NonEmpty ColSpec annotations on cells, when concatenated, form a
  -- subset (really sublist) of the [ColSpec] of the entire table.
  propColSubsets :: TableHead -> [TableBody] -> TableFoot -> Property
  propColSubsets th tbs tf = withColSpec $ \cs ->
    let Ann.Table _ _ _ ath atbs atf =
            Ann.toTable nullAttr emptyCaption cs th tbs tf
    in  conjoin
          $  subsetTH cs ath
          <> concatMap (subsetTB cs) atbs
          <> subsetTF cs atf
   where
    subsetTH cs (Ann.TableHead _ rs) = map (subsetHeader cs) rs
    subsetTB cs (Ann.TableBody _ _ rs ts) =
      map (subsetHeader cs) rs <> map (subsetBody cs) ts
    subsetTF cs (Ann.TableFoot _ rs) = map (subsetHeader cs) rs
  
    subsetHeader cs r = catHeaderSpec r `isSubsetOf` cs
    subsetBody cs r = catBodySpec r `isSubsetOf` cs
  
  -- The property that in any cell in an Ann.Table from Ann.toTable, the
  -- NonEmpty ColSpec annotation on a cell is equal in length to its
  -- ColSpan.
  propCellColLengths :: TableHead -> [TableBody] -> TableFoot -> Property
  propCellColLengths th tbs tf = withColSpec $ \cs ->
    let Ann.Table _ _ _ ath atbs atf =
            Ann.toTable nullAttr emptyCaption cs th tbs tf
    in  conjoin $ cellColTH ath <> concatMap cellColTB atbs <> cellColTF atf
   where
    cellColTH (Ann.TableHead _ rs) = concatMap cellColHeader rs
    cellColTB (Ann.TableBody _ _ rs ts) =
      concatMap cellColHeader rs <> concatMap cellColBody ts
    cellColTF (Ann.TableFoot _ rs) = concatMap cellColHeader rs
  
    cellColHeader (Ann.HeaderRow _ _ x) = fmap validLength x
    cellColBody (Ann.BodyRow _ _ x y) = fmap validLength x <> fmap validLength y
  
    validLength (Ann.Cell colspec _ (Cell _ _ _ (ColSpan w) _)) =
      length colspec == w
  