aboutsummaryrefslogtreecommitdiffhomepage
path: root/core/test/Parsing
diff options
context:
space:
mode:
authorFrédéric Menou <frederic.menou@fretlink.com>2016-12-08 10:19:15 +0200
committerIsmaël Bouya <ismael.bouya@fretlink.com>2022-05-17 18:01:51 +0200
commita9d77a20008efe82862cc1adbfa7a6d4f09f8ff7 (patch)
treeadf3186fdccaeef19151026cdfbd38a530cf9ecb /core/test/Parsing
downloadedi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.tar.gz
edi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.tar.zst
edi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.zip
Release code as open sourceHEADmaster
Diffstat (limited to 'core/test/Parsing')
-rw-r--r--core/test/Parsing/CombinatorsTest.hs288
-rw-r--r--core/test/Parsing/PrimitivesTest.hs105
2 files changed, 393 insertions, 0 deletions
diff --git a/core/test/Parsing/CombinatorsTest.hs b/core/test/Parsing/CombinatorsTest.hs
new file mode 100644
index 0000000..03e6642
--- /dev/null
+++ b/core/test/Parsing/CombinatorsTest.hs
@@ -0,0 +1,288 @@
1{-# LANGUAGE OverloadedStrings #-}
2
3module Parsing.CombinatorsTest
4 ( suite
5 ) where
6
7import Text.Edifact.Parsing
8import Text.Edifact.Types
9
10import Data.Text (Text, unpack)
11import Text.Parsec (eof)
12
13import Test.Framework
14import Test.Framework.Providers.HUnit (testCase)
15import Test.HUnit ((@?=))
16
17suite :: Test
18suite =
19 testGroup "Combinators"
20 [ testMessage
21 , testSegmentGroup
22 , testSegment
23 , testComposite
24 ]
25
26testMessage :: Test
27testMessage =
28 testGroup "Message"
29 [ testGroup "repeated"
30 [ expectSuccess messageABCDEF "TAG'" $
31 Message "ABCDEF" [ "0010" .= Group "sg1" [ "010" .= Segment "TAG" []
32 , ("020", [])
33 ]
34 ]
35 , expectSuccess messageABCDEF "TAG'TAG'" $
36 Message "ABCDEF" [ "0010" .= Group "sg1" [ ("010", [ Segment "TAG" []
37 , Segment "TAG" []
38 ])
39 , ("020", [])
40 ]
41 ]
42 , expectFailure messageABCDEF "TAG'TAG'TAG'"
43 , expectSuccess messageABCDEF "TAG'ANN'" $
44 Message "ABCDEF" [ "0010" .= Group "sg1" [ "010" .= Segment "TAG" []
45 , "020" .= Segment "ANN" []
46 ]
47 ]
48 , expectSuccess messageABCDEF "ANN'" $
49 Message "ABCDEF" [ "0010" .= Group "sg1" [ ("010", [])
50 , "020" .= Segment "ANN" []
51 ]
52 ]
53 ]
54 , testGroup "mandatory repeated"
55 [ expectSuccess messageGHIJKL "TAG'" $
56 Message "GHIJKL" [ "0010" .= Group "sg2" [ "010" .= Segment "TAG" []
57 , ("020", [])
58 ]
59 ]
60 , expectSuccess messageGHIJKL "TAG'TAG'" $
61 Message "GHIJKL" [ "0010" .= Group "sg2" [ ("010", [ Segment "TAG" []
62 , Segment "TAG" []
63 ])
64 , ("020", [])
65 ]
66 ]
67 , expectFailure messageGHIJKL "TAG'TAG'TAG'"
68 , expectSuccess messageGHIJKL "TAG'ANN'" $
69 Message "GHIJKL" [ "0010" .= Group "sg2" [ "010" .= Segment "TAG" []
70 , "020" .= Segment "ANN" []
71 ]
72 ]
73 , expectFailure messageGHIJKL "ANN'"
74 ]
75 ]
76
77messageABCDEF :: Parser Value
78messageABCDEF = message "ABCDEF" [ once sg1 @. "0010"
79 ]
80
81messageGHIJKL :: Parser Value
82messageGHIJKL = message "GHIJKL" [ once sg2 @. "0010"
83 ]
84
85testSegmentGroup :: Test
86testSegmentGroup =
87 testGroup "Segment Group"
88 [ testGroup "repeated"
89 [ expectSuccess sg1 "TAG'" $
90 Group "sg1" [ "010" .= Segment "TAG" []
91 , ("020", [])
92 ]
93 , expectSuccess sg1 "TAG'TAG'" $
94 Group "sg1" [ ("010", [ Segment "TAG" []
95 , Segment "TAG" []
96 ])
97 , ("020", [])
98 ]
99 , expectFailure sg1 "TAG'TAG'TAG'"
100 , expectSuccess sg1 "TAG'ANN'" $
101 Group "sg1" [ "010" .= Segment "TAG" []
102 , "020" .= Segment "ANN" []
103 ]
104 , expectSuccess sg1 "ANN'" $
105 Group "sg1" [ ("010", [])
106 , "020" .= Segment "ANN" []
107 ]
108 ]
109 , testGroup "mandatory repeated"
110 [ expectSuccess sg2 "TAG'" $
111 Group "sg2" [ "010" .= Segment "TAG" []
112 , ("020", [])
113 ]
114 , expectSuccess sg2 "TAG'TAG'" $
115 Group "sg2" [ ("010", [ Segment "TAG" []
116 , Segment "TAG" []
117 ])
118 , ("020", [])
119 ]
120 , expectFailure sg2 "TAG'TAG'TAG'"
121 , expectSuccess sg2 "TAG'ANN'" $
122 Group "sg2" [ "010" .= Segment "TAG" []
123 , "020" .= Segment "ANN" []
124 ]
125 , expectFailure sg2 "ANN'"
126 ]
127 ]
128
129sg1 :: Parser Value
130sg1 = segmentGroup "sg1" [ repeated 2 segmentTAG @. "010"
131 , repeated 9 segmentANN @. "020"
132 ]
133
134sg2 :: Parser Value
135sg2 = segmentGroup "sg2" [ repeatedAtLeastOnce 2 segmentTAG @. "010"
136 , repeated 9 segmentANN @. "020"
137 ]
138
139segmentTAG :: Parser Value
140segmentTAG =
141 segment "TAG" [ optional s01 @. "010"
142 , optional s02 @. "020"
143 , optional s03 @. "030"
144 , optional c01 @. "040"
145 ]
146
147segmentANN :: Parser Value
148segmentANN =
149 segment "ANN" [ optional s01 @. "010"
150 ]
151
152s01 :: Parser Value
153s01 = simple "S01" an2
154
155s02 :: Parser Value
156s02 = simple "S02" an2
157
158s03 :: Parser Value
159s03 = simple "S03" an2
160
161s04 :: Parser Value
162s04 = simple "S04" an2
163
164s05 :: Parser Value
165s05 = simple "S05" an2
166
167s06 :: Parser Value
168s06 = simple "S06" an2
169
170c01 :: Parser Value
171c01 = composite "C01" [ mandatory s04 @. "010"
172 , mandatory s05 @. "020"
173 , mandatory s06 @. "030"
174 ]
175
176testSegment :: Test
177testSegment =
178 let parser = segment "TAG" [ optional s01 @. "010"
179 , optional s02 @. "020"
180 , optional s03 @. "030"
181 , optional c01 @. "040"
182 ]
183 parser2 = segment "TAG" [ mandatory s01 @. "010"
184 , optional s02 @. "020"
185 , optional s03 @. "030"
186 ]
187 in testGroup "Segment"
188 [ expectSuccess parser "TAG'" $
189 Segment "TAG" []
190 , expectSuccess parser "TAG+DE+DE+DE+CE:CE:CE'" $
191 Segment "TAG" [ "010" .= Simple "S01" "DE"
192 , "020" .= Simple "S02" "DE"
193 , "030" .= Simple "S03" "DE"
194 , "040" .= Composite "C01" [ "010" .= Simple "S04" "CE"
195 , "020" .= Simple "S05" "CE"
196 , "030" .= Simple "S06" "CE"
197 ]
198 ]
199 , expectFailure parser "TAG+DE+DE+CE:CE:CE'"
200 , expectSuccess parser "TAG+DE++DE+CE:CE:CE'" $
201 Segment "TAG" [ "010" .= Simple "S01" "DE"
202 , ("020", Nothing)
203 , "030" .= Simple "S03" "DE"
204 , "040" .= Composite "C01" [ "010" .= Simple "S04" "CE"
205 , "020" .= Simple "S05" "CE"
206 , "030" .= Simple "S06" "CE"
207 ]
208 ]
209 , expectSuccess parser2 "TAG+DE+DE'" $
210 Segment "TAG" [ "010" .= Simple "S01" "DE"
211 , "020" .= Simple "S02" "DE"
212 ]
213 , expectSuccess parser2 "TAG+DE'" $
214 Segment "TAG" [ "010" .= Simple "S01" "DE"
215 ]
216 , expectSuccess parser2 "TAG+DE++DE'" $
217 Segment "TAG" [ "010" .= Simple "S01" "DE"
218 , ("020", Nothing)
219 , "030" .= Simple "S03" "DE"
220 ]
221 ]
222
223testComposite :: Test
224testComposite =
225 let parser = compositeX001
226 in testGroup "Composite"
227 [ expectSuccess parser "" $
228 Composite "X001" [ "010" .= Simple "1001" ""
229 ]
230 , expectSuccess parser "ABC" $
231 Composite "X001" [ "010" .= Simple "1001" "ABC"
232 ]
233 , expectSuccess parser ":DEF" $
234 Composite "X001" [ "010" .= Simple "1001" ""
235 , "020" .= Simple "1001" "DEF"
236 ]
237 , expectSuccess parser "ABC:DEF" $
238 Composite "X001" [ "010" .= Simple "1001" "ABC"
239 , "020" .= Simple "1001" "DEF"
240 ]
241 , expectSuccess parser "ABC:DEF:" $
242 Composite "X001" [ "010" .= Simple "1001" "ABC"
243 , "020" .= Simple "1001" "DEF"
244 , "030" .= Simple "1001" ""
245 ]
246 , expectSuccess parser "ABC:DEF:GHI" $
247 Composite "X001" [ "010" .= Simple "1001" "ABC"
248 , "020" .= Simple "1001" "DEF"
249 , "030" .= Simple "1001" "GHI"
250 ]
251 , expectSuccess parser "ABC::GHI" $
252 Composite "X001" [ "010" .= Simple "1001" "ABC"
253 , "020" .= Simple "1001" ""
254 , "030" .= Simple "1001" "GHI"
255 ]
256 ]
257
258compositeX001 :: Parser Value
259compositeX001 =
260 composite "X001"
261 [ mandatory simple1001 @. "010"
262 , optional simple1001 @. "020"
263 , optional simple1001 @. "030"
264 ]
265
266simple1001 :: Parser Value
267simple1001 = simple "1001" an_35
268
269an2 :: Parser Primitive
270an2 = alpha `exactly` 2
271
272an_35 :: Parser Primitive
273an_35 = alphaNumeric `upTo` 35
274
275expectSuccess :: (Show a, Eq a) => Parser a -> Text -> a -> Test
276expectSuccess p t = expectParse p t . pure
277
278expectFailure :: (Show a, Eq a) => Parser a -> Text -> Test
279expectFailure p t = expectParse p t Nothing
280
281expectParse :: (Show a, Eq a) => Parser a -> Text -> Maybe a -> Test
282expectParse p t e =
283 let either2Maybe = either (const Nothing) Just
284 title = "\"" <> unpack t <> "\""
285 in testCase title (either2Maybe (parse (p <* eof) t) @?= e)
286
287(.=) :: Applicative f => Position -> Value -> (Position, f Value)
288pos .= value = (pos, pure value)
diff --git a/core/test/Parsing/PrimitivesTest.hs b/core/test/Parsing/PrimitivesTest.hs
new file mode 100644
index 0000000..95bc8c8
--- /dev/null
+++ b/core/test/Parsing/PrimitivesTest.hs
@@ -0,0 +1,105 @@
1{-# LANGUAGE OverloadedStrings #-}
2
3module Parsing.PrimitivesTest
4 ( suite
5 ) where
6
7import Text.Edifact.Parsing
8
9import Data.Text (Text, unpack)
10import Text.Parsec (eof)
11
12import Test.Framework
13import Test.Framework.Providers.HUnit (testCase)
14import Test.HUnit ((@?=))
15
16suite :: Test
17suite =
18 testGroup "Primitives"
19 [ test_an
20 , test_an_3
21 , test_an3
22 , test_n
23 ]
24
25test_an :: Test
26test_an =
27 let parser = alphaNumeric
28 in testGroup "an"
29 [ expectSuccess parser "A" 'A'
30 , expectSuccess parser "?:" ':'
31 , expectSuccess parser "?+" '+'
32 , expectSuccess parser "??" '?'
33 , expectSuccess parser "?'" '\''
34 ]
35
36test_an_3 :: Test
37test_an_3 =
38 let parser = alphaNumeric `upTo` 3
39 in testGroup "an..3"
40 [ testGroup "valid"
41 [ expectSuccess parser "" ""
42 , expectSuccess parser "A" "A"
43 , expectSuccess parser "AB" "AB"
44 , expectSuccess parser "ABC" "ABC"
45 , expectSuccess parser "AB??" "AB?"
46 ]
47 , testGroup "invalid"
48 [ expectFailure parser "ABCD"
49 ]
50 ]
51
52test_an3 :: Test
53test_an3 =
54 let parser = alphaNumeric `exactly` 3
55 in testGroup "an3"
56 [ testGroup "valid"
57 [ expectSuccess parser "ABC" "ABC"
58 , expectSuccess parser "AB??" "AB?"
59 ]
60 , testGroup "invalid"
61 [ expectFailure parser ""
62 , expectFailure parser "A"
63 , expectFailure parser "AB"
64 , expectFailure parser "ABCD"
65 ]
66 ]
67
68test_n :: Test
69test_n =
70 let parser = numeric
71 in testGroup "n"
72 [ testGroup "valid"
73 [ expectSuccess parser "0" '0'
74 , expectSuccess parser "1" '1'
75 , expectSuccess parser "2" '2'
76 , expectSuccess parser "3" '3'
77 , expectSuccess parser "4" '4'
78 , expectSuccess parser "5" '5'
79 , expectSuccess parser "6" '6'
80 , expectSuccess parser "7" '7'
81 , expectSuccess parser "8" '8'
82 , expectSuccess parser "9" '9'
83 , expectSuccess parser "-" '-'
84 , expectSuccess parser "." '.'
85 ]
86 , testGroup "invalid"
87 [ expectFailure parser "A"
88 , expectFailure parser "?:"
89 , expectFailure parser "?+"
90 , expectFailure parser "??"
91 , expectFailure parser "?'"
92 ]
93 ]
94
95expectSuccess :: (Show a, Eq a) => Parser a -> Text -> a -> Test
96expectSuccess p t = expectParse p t . pure
97
98expectFailure :: (Show a, Eq a) => Parser a -> Text -> Test
99expectFailure p t = expectParse p t Nothing
100
101expectParse :: (Show a, Eq a) => Parser a -> Text -> Maybe a -> Test
102expectParse p t e =
103 let either2Maybe = either (const Nothing) Just
104 title = "\"" <> unpack t <> "\""
105 in testCase title (either2Maybe (parse (p <* eof) t) @?= e)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 18:18:08 +0000