git.iko.soy/typeable/dom-parser
on deps help sign in
typeable/dom-parser/test/Main.hs
357 lines 11 kB history raw
1module Main where
3import Control.Exception
4import Control.Lens
5import Control.Monad
6import Data.Default
7import Data.List.NonEmpty (NonEmpty(..))
8import qualified Data.List.NonEmpty as NE
9import Data.Monoid
10import Data.Text (Text)
11import Test.Hspec
12import Text.Shakespeare.Text (lt)
13import Text.XML
14import Text.XML.DOM.Parser
17data TestStructure = TestStructure
18 { tsName :: Text
19 , tsInts :: [Int]
20 , tsBools :: NonEmpty Bool
21 } deriving (Eq, Show)
23testStructureFromDom :: (Monad m) => DomParserT Identity m TestStructure
24testStructureFromDom = do
25 tsName <- inElem "name" fromDom
26 tsInts <- inElemAll "int" intFromDom
27 tsBools <- inElemNe "bool" boolFromDom
28 return TestStructure{..}
30testStructureAttributes :: (Monad m) => DomParserT Identity m TestStructure
31testStructureAttributes = do
32 name <- getCurrentName
33 int <- parseAttribute "int" readContent
34 bool <- parseAttribute "bool" readBool
35 return $ TestStructure
36 { tsName = nameLocalName name
37 , tsInts = [int]
38 , tsBools = pure bool }
40docStruct :: Document
41docStruct = parseText_ def [lt|
42<?xml version="1.0" encoding="utf-8"?>
43<root>
44 <name>name</name>
45 <int>1</int>
46 <int>2</int>
47 <bool>t</bool>
48</root>
49|]
51docAttrStruct :: Document
52docAttrStruct = parseText_ def [lt|
53<?xml version="1.0" encoding="utf-8"?>
54<structure int="10" bool="t">
55</structure>
56|]
58docNone :: Document
59docNone = parseText_ def [lt|
60<?xml version="1.0" encoding="utf-8"?>
61<root>
62</root>
63|]
65docSimpleAttr :: Document
66docSimpleAttr = parseText_ def [lt|
67<?xml version="1.0" encoding="utf-8"?>
68<root>
69<a attr="content"/>
70</root>
71|]
73docMultipleAttr :: Document
74docMultipleAttr = parseText_ def [lt|
75<?xml version="1.0" encoding="utf-8"?>
76<root>
77<a attr="content1"/>
78<a attr="content2"/>
79<a attr="content3"/>
80</root>
81|]
83docSingleEmpty :: Document
84docSingleEmpty = parseText_ def [lt|
85<?xml version="1.0" encoding="utf-8"?>
86<root>
87 <a/>
88</root>
89|]
91docSimple :: Document
92docSimple = parseText_ def [lt|
93<?xml version="1.0" encoding="utf-8"?>
94<root>
95 <a>content</a>
96</root>
97|]
99docMultiple :: Document
100docMultiple = parseText_ def [lt|
101<?xml version="1.0" encoding="utf-8"?>
102<root>
103 <a>content1</a>
104 <a>content2</a>
105 <a>content3</a>
106</root>
107|]
109docDeep :: Document
110docDeep = parseText_ def [lt|
111<?xml version="1.0" encoding="utf-8"?>
112<root>
113 <a><b>content</b></a>
114</root>
115|]
117docDeepWithContent :: Document
118docDeepWithContent = parseText_ def [lt|
119<?xml version="1.0" encoding="utf-8"?>
120<root>
121 <a>content<b>content</b>content</a>
122</root>
123|]
125docDeepMultiple1 :: Document
126docDeepMultiple1 = parseText_ def [lt|
127<?xml version="1.0" encoding="utf-8"?>
128<root>
129 <a>
130 <b>content1</b>
131 <b>content2</b>
132 </a>
133 <a>
134 <b>content3</b>
135 </a>
136 <a/>
137</root>
138|]
140docDeepMultiple2 :: Document
141docDeepMultiple2 = parseText_ def [lt|
142<?xml version="1.0" encoding="utf-8"?>
143<root>
144 <a/>
145 <a>
146 <b>content1</b>
147 </a>
148 <a>
149 <b>content2</b>
150 <b>content3</b>
151 </a>
152</root>
153|]
155specParser
156 :: String -- ^ Name of spec
157 -> Document -- ^ Document to parse
158 -> (a -> Maybe String) -- ^ Value checker, Nothing if all ok
159 -> DomParser Identity a -- ^ Parser itself
160 -> Spec
161specParser name doc check parser = it name $ do
162 result <- either throwIO return $ runDomParser doc parser
163 case check result of
164 Nothing -> return ()
165 Just e -> throwIO $ ErrorCall e
167specParserEq
168 :: (Eq a, Show a)
169 => String -- ^ Name of spec
170 -> Document -- ^ Document to parse
171 -> a -- ^ Value parser should return
172 -> DomParser Identity a -- ^ Parser itself
173 -> Spec
174specParserEq name doc a parser = specParser name doc check parser
175 where
176 check x | x == a = Nothing
177 | otherwise = Just $ "should be " ++ show a
178 ++ " but got " ++ show x
180specParserFailed
181 :: (Show a)
182 => String
183 -> Document
184 -> DomParser Identity a
185 -> Spec
186specParserFailed name doc parser = it name $ example $ do
187 let result = runDomParser doc parser
188 case result of
189 Right a -> fail $ "Expected parser to fail, but returned" ++ (show a)
190 Left _ -> return ()
192specParserFailedPath
193 :: (Show a)
194 => String -- ^ Name of spec
195 -> Document
196 -> DomPath -- ^ Expteced path in error
197 -> DomParser Identity a
198 -> Spec
199specParserFailedPath name doc path parser = it name $ example $ do
200 let result = runDomParser doc parser
201 case result of
202 Right a -> fail $ "Expected parser to fail, but returned" ++ (show a)
203 Left (ParserErrors errs) -> case errs ^? folded . pePath of
204 Nothing -> fail $ "Parser failed, but got no errors to analyze path"
205 Just p | p == path -> return ()
206 | otherwise -> fail $ "Path is not exptected: " <> show p
208combinationsSpec :: Spec
209combinationsSpec = do
210 describe "inElem" $ do
211 describe "succeeds" $ do
212 describe "simple" $ do
213 let parser = inElem "a" textFromDom
214 specParserEq "docSimple" docSimple "content" parser
215 specParserEq "docMultiple" docMultiple "content1" parser
216 describe "deep" $ do
217 let parser = inElem "a" $ inElem "b" textFromDom
218 specParserEq "docDeep" docDeep "content" parser
219 specParserEq "docDeepMultiple1" docDeepMultiple1 "content1" parser
220 specParserEq "docDeepWithContent" docDeepWithContent "content" parser
221 describe "fails" $ do
222 describe "simple" $ do
223 let parser = inElem "a" textFromDom
224 specParserFailed "docNone" docNone parser
225 specParserFailed "docSingleEmpty" docSingleEmpty parser
226 describe "deep" $ do
227 let parser = inElem "a" $ inElem "b" textFromDom
228 specParserFailedPath "docDeepMultiple2" docDeepMultiple2
229 (DomPath ["root", "a", "b"]) parser
230 -- should fail here because first tag "a" does not contains
231 -- tag "b" which is expected by parser @inElem "b"@
233 describe "parseAttribute" $ do
234 describe "succeeds" $ do
235 specParserEq "docSimpleAttr" docSimpleAttr "content"
236 $ inElem "a" $ parseAttribute "attr" Right
237 let res = ["content1", "content2", "content3"]
238 specParserEq "docMultipleAttr" docMultipleAttr res
239 $ inElemAll "a" $ parseAttribute "attr" Right
240 describe "fails" $ do
241 specParserFailed "docNone" docNone $ parseAttribute "attr" Right
243 describe "inElemAll" $ do
244 let parser = inElemAll "a" textFromDom
245 describe "succeeds" $ do
246 specParserEq "docNone" docNone [] parser
247 specParserEq "docSimple" docSimple ["content"] parser
248 specParserEq "docMultiple" docMultiple
249 ["content1", "content2", "content3"] parser
250 describe "fails" $ do
251 specParserFailed "docSingleEmpty" docSingleEmpty parser
253 describe "inElemMay" $ do
254 let parser = inElemMay "a" textFromDom
255 describe "succeeds" $ do
256 specParserEq "docNone" docNone Nothing parser
257 specParserEq "docSimple" docSimple (Just "content") parser
258 specParserEq "docMultiple" docMultiple (Just "content1") parser
259 describe "fails" $ do
260 specParserFailed "docSingleEmpty" docSingleEmpty parser
262 describe "inElemNe" $ do
263 let parser = inElemNe "a" textFromDom
264 describe "succeeds" $ do
265 specParserEq "docSimple" docSimple (pure "content") parser
266 specParserEq "docMultiple" docMultiple
267 (NE.fromList ["content1", "content2", "content3"]) parser
268 describe "fails" $ do
269 specParserFailed "docNone" docNone parser
270 specParserFailed "docSingleEmpty" docSingleEmpty parser
272 describe "diveElem" $ do
273 describe "single element" $ do
274 let parser = diveElem "a" $ inElem "b" textFromDom
275 describe "succeeds" $ do
276 specParserEq "docDeepMultiple1" docDeepMultiple1 "content1" parser
277 specParserEq "docDeepMultiple2" docDeepMultiple2 "content1" parser
278 describe "fails" $ do
279 specParserFailedPath "docSimple" docSimple (DomPath ["root", "a", "b"]) parser
280 describe "multiple elements" $ do
281 let
282 parser = diveElem "a" $ inElemAll "b" textFromDom
283 result = ["content1", "content2", "content3"]
284 describe "succeeds" $ do
285 specParserEq "docDeepMultiple1" docDeepMultiple1 result parser
286 specParserEq "docDeepMultiple2" docDeepMultiple2 result parser
287 specParserEq "docSimple" docSimple [] parser
289 describe "ignoreEmpty" $ do
290 describe "mandatory element" $ do
291 let parser = inElem "a" $ ignoreEmpty textFromDom
292 describe "succeeds" $ do
293 specParserEq "docSingleEmpty" docSingleEmpty Nothing parser
294 specParserEq "docSimple" docSimple (Just "content") parser
295 specParserEq "docMultiple" docMultiple (Just "content1") parser
296 describe "fails" $ do
297 specParserFailed "docNone" docNone parser
298 describe "optional element" $ do
299 let parser = fmap join $ inElemMay "a" $ ignoreEmpty textFromDom
300 describe "succeeds" $ do
301 specParserEq "docNone" docNone Nothing parser
302 specParserEq "docSingleEmpty" docSingleEmpty Nothing parser
303 specParserEq "docSimple" docSimple (Just "content") parser
304 specParserEq "docMultiple" docMultiple (Just "content1") parser
306 describe "checkCurrentName" $ do
307 describe "succeeded" $ do
308 specParserEq "root element" docSimple () $ do
309 checkCurrentName "root"
310 specParserEq "inner element" docSimple () $ do
311 inElem "a" $ do
312 checkCurrentName "a"
313 describe "fails" $ do
314 specParserFailedPath "root element" docSimple (DomPath ["toor"]) $ do
315 checkCurrentName "toor"
316 specParserFailedPath "inner element" docSimple (DomPath ["root", "b"]) $ do
317 inElem "a" $ checkCurrentName "b"
319contentSpec :: Spec
320contentSpec = do
321 describe "fails if inner element found" $ do
322 specParserFailed "docDeep" docDeep $ do
323 inElem "a" $ textFromDom
324 specParserFailed "docDeepWithContent" docDeepWithContent $ do
325 inElem "a" $ textFromDom
327structSpec :: Spec
328structSpec = do
329 describe "succeeds" $ do
330 describe "dom structure" $ do
331 let
332 result = TestStructure
333 { tsName = "name"
334 , tsInts = [1,2]
335 , tsBools = pure True }
336 specParserEq "docStruct" docStruct result testStructureFromDom
337 describe "attribute structure" $ do
338 let
339 result = TestStructure
340 { tsName = "structure"
341 , tsInts = [10]
342 , tsBools = pure True }
343 specParserEq "docAttrStruct" docAttrStruct result testStructureAttributes
344 describe "fails" $ do
345 describe "dom structure" $ do
346 specParserFailed "docSimple" docSimple testStructureFromDom
347 describe "attr structure" $ do
348 specParserFailed "docNone" docNone testStructureAttributes
350main :: IO ()
351main = hspec $ do
352 describe "combinators" $ do
353 combinationsSpec
354 describe "content parsing" $ do
355 contentSpec
356 describe "expected struct" $ do
357 structSpec