aboutsummaryrefslogtreecommitdiff
path: root/test/Tests/Readers/Pptx.hs
blob: 613d5b50fd17b26bf1d93c30cd594f37bbae5e6d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Tests.Readers.Pptx
   Copyright   : © 2025 Anton Antic
   License     : GNU GPL, version 2 or above

   Maintainer  : Anton Antic <[email protected]>
   Stability   : alpha
   Portability : portable

Tests for the PPTX reader.
-}
module Tests.Readers.Pptx (tests) where

import Data.Algorithm.Diff (getDiff)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
import Test.Tasty
import Test.Tasty.Golden.Advanced
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.UTF8 as UTF8

defopts :: ReaderOptions
defopts = def{ readerExtensions = getDefaultExtensions "pptx" }

testCompare :: String -> FilePath -> FilePath -> TestTree
testCompare = testCompareWithOpts defopts

nativeDiff :: FilePath -> Pandoc -> Pandoc -> IO (Maybe String)
nativeDiff normPath expectedNative actualNative
  | expectedNative == actualNative = return Nothing
  | otherwise = Just <$> do
      expected <- T.unpack <$> runIOorExplode (writeNative def expectedNative)
      actual <- T.unpack <$> runIOorExplode (writeNative def actualNative)
      let dash = replicate 72 '-'
      let diff = getDiff (lines actual) (lines expected)
      return $ '\n' : dash ++
               "\n--- " ++ normPath ++
               "\n+++ " ++ "test" ++ "\n" ++
               showDiff (1,1) diff ++ dash

testCompareWithOpts :: ReaderOptions -> String -> FilePath -> FilePath -> TestTree
testCompareWithOpts opts testName pptxFP nativeFP =
  goldenTest
  testName
  (do nf <- UTF8.toText <$> BS.readFile nativeFP
      runIOorExplode (readNative def nf))
  (do df <- B.readFile pptxFP
      runIOorExplode (readPptx opts df))
  (nativeDiff nativeFP)
  (\a -> runIOorExplode (writeNative def{ writerTemplate = Just mempty} a)
            >>= BS.writeFile nativeFP . UTF8.fromText)

tests :: [TestTree]
tests = [ testGroup "basic"
          [ testCompare
            "text extraction"
            "pptx-reader/basic.pptx"
            "pptx-reader/basic.native"
          ]
        ]