185 lines
7 KiB
Haskell
185 lines
7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{- |
|
|
Module : Tests.Readers.Odt
|
|
Copyright : © 2015-2022 John MacFarlane
|
|
2015 Martin Linnemann
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
Tests for the ODT reader.
|
|
-}
|
|
module Tests.Readers.Odt (tests) where
|
|
|
|
import Control.Monad (liftM)
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Lazy as B
|
|
import qualified Data.Map as M
|
|
import Data.Text (unpack)
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
import Test.Tasty
|
|
import Tests.Helpers
|
|
import Text.Pandoc
|
|
import qualified Text.Pandoc.UTF8 as UTF8
|
|
|
|
defopts :: ReaderOptions
|
|
defopts = def{ readerExtensions = getDefaultExtensions "odt" }
|
|
|
|
tests :: [TestTree]
|
|
tests = testsComparingToMarkdown ++ testsComparingToNative
|
|
|
|
testsComparingToMarkdown :: [TestTree]
|
|
testsComparingToMarkdown = map nameToTest namesOfTestsComparingToMarkdown
|
|
where nameToTest name = createTest
|
|
compareOdtToMarkdown
|
|
name
|
|
(toOdtPath name)
|
|
(toMarkdownPath name)
|
|
toOdtPath name = "odt/odt/" ++ name ++ ".odt"
|
|
toMarkdownPath name = "odt/markdown/" ++ name ++ ".md"
|
|
|
|
testsComparingToNative :: [TestTree]
|
|
testsComparingToNative = map nameToTest namesOfTestsComparingToNative
|
|
where nameToTest name = createTest
|
|
compareOdtToNative
|
|
name
|
|
(toOdtPath name)
|
|
(toNativePath name)
|
|
toOdtPath name = "odt/odt/" ++ name ++ ".odt"
|
|
toNativePath name = "odt/native/" ++ name ++ ".native"
|
|
|
|
|
|
newtype NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc}
|
|
deriving ( Show )
|
|
|
|
instance ToString NoNormPandoc where
|
|
toString d = unpack $
|
|
purely (writeNative def{ writerTemplate = s }) $ toPandoc d
|
|
where s = case d of
|
|
NoNormPandoc (Pandoc (Meta m) _)
|
|
| M.null m -> Nothing
|
|
| otherwise -> Just mempty -- need this for Meta output
|
|
|
|
instance ToPandoc NoNormPandoc where
|
|
toPandoc = unNoNorm
|
|
|
|
getNoNormVia :: (a -> Pandoc) -> String -> Either PandocError a -> NoNormPandoc
|
|
getNoNormVia _ readerName (Left _) = error (readerName ++ " reader failed")
|
|
getNoNormVia f _ (Right a) = NoNormPandoc (f a)
|
|
|
|
type TestCreator = ReaderOptions
|
|
-> FilePath -> FilePath
|
|
-> IO (NoNormPandoc, NoNormPandoc)
|
|
|
|
compareOdtToNative :: TestCreator
|
|
compareOdtToNative opts odtPath nativePath = do
|
|
nativeFile <- UTF8.toText <$> BS.readFile nativePath
|
|
odtFile <- B.readFile odtPath
|
|
native <- getNoNormVia id "native" <$> runIO (readNative def nativeFile)
|
|
odt <- getNoNormVia id "odt" <$> runIO (readOdt opts odtFile)
|
|
return (odt,native)
|
|
|
|
compareOdtToMarkdown :: TestCreator
|
|
compareOdtToMarkdown opts odtPath markdownPath = do
|
|
markdownFile <- UTF8.toText <$> BS.readFile markdownPath
|
|
odtFile <- B.readFile odtPath
|
|
markdown <- getNoNormVia id "markdown" <$>
|
|
runIO (readMarkdown def{ readerExtensions = pandocExtensions }
|
|
markdownFile)
|
|
odt <- getNoNormVia id "odt" <$> runIO (readOdt opts odtFile)
|
|
return (odt,markdown)
|
|
|
|
|
|
createTest :: TestCreator
|
|
-> TestName
|
|
-> FilePath -> FilePath
|
|
-> TestTree
|
|
createTest creator name path1 path2 =
|
|
unsafePerformIO $ liftM (test id name) (creator defopts path1 path2)
|
|
|
|
{-
|
|
--
|
|
|
|
getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString)
|
|
getMedia archivePath mediaPath = do
|
|
zf <- B.readFile archivePath >>= return . toArchive
|
|
return $ findEntryByPath ("Pictures/" ++ mediaPath) zf >>= (Just . fromEntry)
|
|
|
|
compareMediaPathIO :: FilePath -> MediaBag -> FilePath -> IO Bool
|
|
compareMediaPathIO mediaPath mediaBag odtPath = do
|
|
odtMedia <- getMedia odtPath mediaPath
|
|
let mbBS = case lookupMedia mediaPath mediaBag of
|
|
Just (_, bs) -> bs
|
|
Nothing -> error ("couldn't find " ++
|
|
mediaPath ++
|
|
" in media bag")
|
|
odtBS = case odtMedia of
|
|
Just bs -> bs
|
|
Nothing -> error ("couldn't find " ++
|
|
mediaPath ++
|
|
" in media bag")
|
|
return $ mbBS == odtBS
|
|
|
|
compareMediaBagIO :: FilePath -> IO Bool
|
|
compareMediaBagIO odtFile = do
|
|
df <- B.readFile odtFile
|
|
let (_, mb) = readOdt def df
|
|
bools <- mapM
|
|
(\(fp, _, _) -> compareMediaPathIO fp mb odtFile)
|
|
(mediaDirectory mb)
|
|
return $ and bools
|
|
|
|
testMediaBagIO :: String -> FilePath -> IO TestTree
|
|
testMediaBagIO name odtFile = do
|
|
outcome <- compareMediaBagIO odtFile
|
|
return $ testCase name (assertBool
|
|
("Media didn't match media bag in file " ++ odtFile)
|
|
outcome)
|
|
|
|
testMediaBag :: String -> FilePath -> TestTree
|
|
testMediaBag name odtFile = buildTest $ testMediaBagIO name odtFile
|
|
-}
|
|
--
|
|
|
|
|
|
|
|
namesOfTestsComparingToMarkdown :: [ String ]
|
|
namesOfTestsComparingToMarkdown = [ "bold"
|
|
-- , "citation"
|
|
, "endnote"
|
|
, "externalLink"
|
|
, "footnote"
|
|
, "formula"
|
|
, "headers"
|
|
-- , "horizontalRule"
|
|
, "italic"
|
|
-- , "listBlocks"
|
|
, "paragraph"
|
|
, "strikeout"
|
|
-- , "trackedChanges"
|
|
, "underlined"
|
|
]
|
|
|
|
namesOfTestsComparingToNative :: [ String ]
|
|
namesOfTestsComparingToNative = [ "blockquote"
|
|
, "image"
|
|
, "imageIndex"
|
|
, "imageWithCaption"
|
|
, "inlinedCode"
|
|
, "orderedListMixed"
|
|
, "orderedListRoman"
|
|
, "orderedListSimple"
|
|
, "referenceToChapter"
|
|
, "referenceToListItem"
|
|
, "referenceToText"
|
|
, "simpleTable"
|
|
, "simpleTableWithCaption"
|
|
, "tab"
|
|
-- , "table"
|
|
, "textMixedStyles"
|
|
, "tableWithContents"
|
|
, "unicode"
|
|
, "unorderedList"
|
|
]
|