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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE OverloadedStrings #-}
import System.Directory
import System.FilePath
import Text.XML.Light
import Text.Show.Pretty (ppShow)
import Text.TeXMath
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Char8 as B
import Test.Tasty
import Test.Tasty.Golden (goldenVsStringDiff)
import Test.Tasty.Options
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Text.Encoding as TE (decodeUtf8)
import Data.List (sort)
import Data.Typeable (Typeable)
import Data.Proxy
newtype RoundTrip = RoundTrip Bool
deriving (Eq, Ord, Typeable)
instance IsOption RoundTrip where
defaultValue = RoundTrip False
parseValue = fmap RoundTrip . safeRead
optionName = return "roundtrip"
optionHelp = return "Do round-trip tests instead of regular"
optionCLParser = flagCLParser Nothing (RoundTrip True)
main :: IO ()
main = do
let getFiles dir = map (dir </>) . sort <$> listDirectory dir
texReaderTests <- getFiles "test/reader/tex"
mmlReaderTests <- getFiles "test/reader/mml"
ommlReaderTests <- getFiles "test/reader/omml"
texWriterTests <- getFiles "test/writer/tex"
mmlWriterTests <- getFiles "test/writer/mml"
ommlWriterTests <- getFiles "test/writer/omml"
eqnWriterTests <- getFiles "test/writer/eqn"
typstWriterTests <- getFiles "test/writer/typst"
regressionTests <- getFiles "test/regression"
roundtripTests <- getFiles "test/roundtrip"
let ings = includingOptions [Option (Proxy :: Proxy RoundTrip)] :
defaultIngredients
defaultMainWithIngredients ings $ askOption $ \(RoundTrip roundTrip) ->
testGroup "Tests" $
if roundTrip
then
[ testGroup "roundtrip"
[ testGroup "tex" $ map (toRoundtripTest "tex") roundtripTests
, testGroup "mml" $ map (toRoundtripTest "mml") roundtripTests
, testGroup "mml" $ map (toRoundtripTest "omml") roundtripTests
]
]
else
[ testGroup "reader"
[ testGroup "tex" $ map toGoldenTest texReaderTests
, testGroup "mml" $ map toGoldenTest mmlReaderTests
, testGroup "omml" $ map toGoldenTest ommlReaderTests
],
testGroup "writer"
[ testGroup "tex" $ map toGoldenTest texWriterTests
, testGroup "mml" $ map toGoldenTest mmlWriterTests
, testGroup "omml" $ map toGoldenTest ommlWriterTests
, testGroup "eqn" $ map toGoldenTest eqnWriterTests
, testGroup "typst" $ map toGoldenTest typstWriterTests
],
testGroup "regression" $ map toGoldenTest regressionTests
]
toRoundtripTest :: T.Text -> FilePath -> TestTree
toRoundtripTest format fp =
goldenVsStringDiff (takeBaseName fp) diff fp getTested
where
diff ref new = ["diff", "-u", ref, new]
getTested = do
golden <- read <$> readFile fp
reader <- maybe (error $ "Unknown input format " <> T.unpack format)
return $ lookup format readers
writer <- maybe (error $ "Unknown output format " <> T.unpack format)
return $ lookup format writers
case reader (writer golden) of
Left err -> return $ encodeUtf8 $ TL.fromStrict err
Right result -> return $ encodeUtf8 $ TL.fromStrict
$ ensureFinalNewline $ T.pack $ ppShow result
toGoldenTest :: FilePath -> TestTree
toGoldenTest fp =
goldenVsStringDiff (takeBaseName fp) diff fp getTested
where
diff ref new = ["diff", "-u", ref, new]
constructGoldenTest ((inFormat, inText), (outFormat, outText)) =
return $ encodeUtf8 $ TL.fromStrict $
"<<< " <> inFormat <> "\n" <> inText <> ">>> " <> outFormat <>
"\n" <> ensureFinalNewline outText
getTested = do
((inFormat, inText), (outFormat, _)) <- readGoldenTest fp
result <- convert inFormat outFormat inText
constructGoldenTest ((inFormat, inText), (outFormat, result))
convert inFormat outFormat inText = do
reader <- maybe (error $ "Unknown input format " <> T.unpack inFormat)
return $ lookup inFormat readers
writer <- maybe (error $ "Unknown output format " <> T.unpack outFormat)
return $ lookup outFormat writers
case writer <$> reader inText of
Left err -> return err
Right result -> return result
readGoldenTest fp' = do
lns <- B.lines <$> B.readFile fp'
case break ("<<<" `B.isPrefixOf`) lns of
(_, inputSpec:rest) ->
case break (">>>" `B.isPrefixOf`) rest of
(inlines, outputSpec:outlines) -> return
((T.strip $ T.drop 3 $ T.pack $ B.unpack inputSpec,
TE.decodeUtf8 $ B.unlines inlines),
(T.strip $ T.drop 3 $ T.pack $ B.unpack outputSpec,
TE.decodeUtf8 $ B.unlines outlines))
_ -> error $ fp' <> " contains no >>> output spec"
_ -> error $ fp' <> " contains no <<< input spec"
ensureFinalNewline :: T.Text -> T.Text
ensureFinalNewline xs = case T.unsnoc xs of
Nothing -> xs
Just (_, '\n') -> xs
_ -> xs <> "\n"
readers :: [(T.Text, T.Text -> Either T.Text [Exp])]
readers = [ ("tex", readTeX)
, ("mml", readMathML)
, ("omml", readOMML)
, ("native", readEither)
]
readEither :: T.Text -> Either T.Text [Exp]
readEither t = case reads (T.unpack t) of
[] -> error "Could not read native value"
((x,_):_) -> return x
writers :: [(T.Text, [Exp] -> T.Text)]
writers = [ ("mml", T.pack . ppTopElement . writeMathML DisplayBlock)
, ("tex", writeTeX)
, ("omml", T.pack . ppTopElement . writeOMML DisplayBlock)
, ("eqn", writeEqn DisplayBlock)
, ("typst", writeTypst DisplayBlock)
, ("native", T.pack . ppShow)
, ("pandoc", maybe "" (T.pack . ppShow) . writePandoc DisplayBlock)
]
|
