{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Odt Copyright : © 2015-2021 John MacFarlane 2015 Martin Linnemann License : GNU GPL, version 2 or above Maintainer : John MacFarlane 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" -- , "table" , "textMixedStyles" , "tableWithContents" , "unicode" , "unorderedList" ]