]> Git — Sourcephile - doclang.git/blob - test/Golden.hs
Remove old file.
[doclang.git] / test / Golden.hs
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE TypeApplications #-}
3 module Golden where
4
5 import Control.Arrow (left)
6 import Control.Monad (Monad(..))
7 import Data.Either (Either(..))
8 import Data.Function (($), (.))
9 import Data.Functor ((<$>))
10 import Data.Locale
11 import Data.Semigroup (Semigroup(..))
12 import Data.String (String)
13 import System.FilePath (FilePath)
14 import System.IO (IO)
15 import Text.Show (Show(..))
16 import qualified Data.ByteString.Lazy as BSL
17 import qualified Data.List as List
18 import qualified Data.Map.Strict as Map
19 import qualified Data.Text as Text
20 import qualified Data.Text.Lazy as TL
21 import qualified Data.Text.Lazy.Encoding as TL
22 import qualified Data.TreeSeq.Strict as TreeSeq
23 import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
24 import qualified Text.Megaparsec as P
25
26 import Test.Tasty
27 import Test.Tasty.Golden
28
29 -- TCT imports
30 import qualified Language.TCT as TCT
31 import qualified Language.TCT.Debug as TCT
32 import qualified Language.TCT.Write.HTML5 as TCT.Write.HTML5
33 import qualified Language.TCT.Write.Plain as TCT.Write.Plain
34 import qualified Language.TCT.Write.XML as TCT.Write.XML
35
36 -- DTC imports
37 import qualified Language.DTC.Document as DTC
38 import qualified Language.DTC.Write.HTML5 as DTC.Write.HTML5
39 import qualified Language.DTC.Write.XML as DTC.Write.XML
40 import qualified Language.DTC.Read.TCT as DTC
41 import qualified Language.DTC.Sym as DTC
42 import qualified Language.RNC.Write as RNC
43 import qualified Text.Blaze.DTC as Blaze.DTC
44 import qualified Text.Blaze.Utils as Blaze
45
46 -- * Golden testing utilities
47 testGolden :: TestName -> TestName -> IO (Either String BSL.ByteString) -> TestTree
48 testGolden inputFile expectedExt =
49 goldenVsStringDiff inputFile diffGolden (inputFile <> expectedExt)
50 . (>>= unLeft)
51
52 diffGolden :: FilePath -> FilePath -> [String]
53 diffGolden ref new = ["diff", "-u", ref, new]
54
55 unLeft :: Either String BSL.ByteString -> IO BSL.ByteString
56 unLeft = \case
57 Left err -> return $ TL.encodeUtf8 $ TL.pack err
58 Right a -> return a
59
60 -- * All golden tests
61 goldensIO :: IO TestTree
62 goldensIO = do
63 inputFiles <- List.sort <$> findByExtension [".tct"] "test/Golden"
64 return $
65 testGroup "Hdoc"
66 [ goldensTCT inputFiles
67 , goldensDTC inputFiles
68 ]
69
70 -- * 'TCT' tests
71 readTCT :: FilePath -> IO (Either String TCT.Roots)
72 readTCT inputFile = do
73 txt <- BSL.readFile inputFile
74 return $
75 left show $
76 TCT.readTCT inputFile $
77 TL.decodeUtf8 txt
78
79 goldensTCT :: [FilePath] -> TestTree
80 goldensTCT inputFiles =
81 testGroup "TCT"
82 [ testGroup "AST"
83 [ testGolden inputFile ".ast" $
84 readTCT inputFile >>= \ast ->
85 return $
86 TL.encodeUtf8
87 . TL.pack
88 . TCT.runPretty 0
89 <$> ast
90 | inputFile <- inputFiles
91 ]
92 , testGroup "Plain"
93 [ testGolden inputFile "" $
94 readTCT inputFile >>= \ast ->
95 return $
96 TL.encodeUtf8
97 . (<> TL.singleton '\n')
98 . TCT.Write.Plain.document
99 <$> ast
100 | inputFile <- inputFiles
101 ]
102 , testGroup "HTML5"
103 [ testGolden inputFile ".html5" $
104 readTCT inputFile >>= \ast ->
105 return $
106 Blaze.renderHtml
107 . TCT.Write.HTML5.document
108 <$> ast
109 | inputFile <- inputFiles
110 ]
111 , testGroup "XML"
112 [ testGolden inputFile ".xml" $
113 readTCT inputFile >>= \ast ->
114 return $
115 TL.encodeUtf8
116 . TL.pack
117 . show
118 . TreeSeq.Pretty
119 . TCT.Write.XML.document
120 <$> ast
121 | inputFile <- inputFiles
122 ]
123 ]
124
125 -- * 'DTC' tests
126 type Langs = '[FR, EN]
127 readDTC :: FilePath -> IO (Either String DTC.Document)
128 readDTC inputFile = do
129 readTCT inputFile >>= \case
130 Left err -> return $ Left err
131 Right tct ->
132 let xml = TCT.Write.XML.document tct in
133 case DTC.readDTC xml of
134 Left err -> return $ Left $ P.parseErrorPretty err
135 Right dtc -> return $ Right dtc
136
137 goldensDTC :: [FilePath] -> TestTree
138 goldensDTC inputFiles =
139 let locale = LocaleIn @Langs en_US in
140 let lang = Text.unpack $ textLocales Map.! locale in
141 testGroup "DTC"
142 [ testGroup "RNC"
143 [ testGolden "schema/dtc.rnc" "" $ do
144 return $
145 Right $
146 TL.encodeUtf8 $
147 TL.unlines $
148 TL.fromStrict
149 . RNC.renderWriter
150 <$> DTC.schema
151 ]
152 , testGroup "XML"
153 [ testGolden inputFile (".dtc"<>"."<>lang<>".xml") $
154 readDTC inputFile >>= \dtc ->
155 return $
156 Blaze.prettyMarkup Blaze.DTC.indentTag
157 . DTC.Write.XML.document locale
158 <$> dtc
159 | inputFile <- inputFiles
160 ]
161 , testGroup "HTML5"
162 [ testGolden inputFile (".dtc"<>"."<>lang<>".html5") $
163 readDTC inputFile >>= \dtc ->
164 return $
165 Blaze.prettyMarkup Blaze.DTC.indentTag
166 . DTC.Write.HTML5.document locale
167 <$> dtc
168 | inputFile <- inputFiles
169 ]
170 ]