diff options
author | Frédéric Menou <frederic.menou@fretlink.com> | 2016-12-08 10:19:15 +0200 |
---|---|---|
committer | Ismaël Bouya <ismael.bouya@fretlink.com> | 2022-05-17 18:01:51 +0200 |
commit | a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7 (patch) | |
tree | adf3186fdccaeef19151026cdfbd38a530cf9ecb /specification/test | |
download | edi-parser-master.tar.gz edi-parser-master.tar.zst edi-parser-master.zip |
Diffstat (limited to 'specification/test')
-rw-r--r-- | specification/test/Edifact.hs | 127 | ||||
-rw-r--r-- | specification/test/Spec.hs | 11 |
2 files changed, 138 insertions, 0 deletions
diff --git a/specification/test/Edifact.hs b/specification/test/Edifact.hs new file mode 100644 index 0000000..6e9acf2 --- /dev/null +++ b/specification/test/Edifact.hs | |||
@@ -0,0 +1,127 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | |||
3 | module Edifact | ||
4 | ( suite | ||
5 | ) where | ||
6 | |||
7 | import Text.Edifact.Common.Segments | ||
8 | import Text.Edifact.D96A | ||
9 | import Text.Edifact.Parsing | ||
10 | |||
11 | import Data.Text (Text, unpack) | ||
12 | import Text.Parsec (eof) | ||
13 | |||
14 | import Test.Framework | ||
15 | import Test.Framework.Providers.HUnit (testCase) | ||
16 | import Test.HUnit ((@?=)) | ||
17 | |||
18 | suite :: Test | ||
19 | suite = | ||
20 | testGroup "examples" | ||
21 | [ canParse simple1153 "AAV" | ||
22 | , canParse simple1154 "" | ||
23 | , canParse simple1156 "C" | ||
24 | , canParse compositeC506 "AAV" | ||
25 | , canParse compositeC506 "AAV::C" | ||
26 | , canParse segmentRFF "RFF+AAV'" | ||
27 | , canParse segmentRFF "RFF+AAV::C'" | ||
28 | |||
29 | , canParse segmentUNB "UNB+UNOA:1+US::US+50138::THEM+140531:0305+001934++ORDERS'" | ||
30 | , canParse segmentUNH "UNH+1+ORDERS:91:2:UN'" | ||
31 | , canParse segmentRFF "RFF+CT:EUA01349'" | ||
32 | , canParse segmentRFF "RFF+AAV::C'" | ||
33 | , canParse segmentNAD "NAD+BY++OUR NAME PLC::::+++++EW4 34J'" | ||
34 | , canParse segmentCTA "CTA+PD'" | ||
35 | , canParse segmentCTA "CTA+OC+:A.SURNAME'" | ||
36 | , canParse segmentCOM "COM+2407:EX'" | ||
37 | , canParse segmentCTA "CTA+TI+:B.BROWN'" | ||
38 | , canParse segmentCOM "COM+0:EX'" | ||
39 | , canParse segmentCTA "CTA+SU'" | ||
40 | , canParse segmentUNT "UNT+15+1'" | ||
41 | , canParse segmentUNZ "UNZ+1+001934'" | ||
42 | |||
43 | , canParse segmentUNA "UNA:+.? '" | ||
44 | , canParse segmentUNB "UNB+IATB:1+6XPPC+LHPPC+940101:0950+1'" | ||
45 | , canParse segmentUNH "UNH+1+PAORES:93:1:IA'" | ||
46 | , canParse segmentUNT "UNT+13+1'" | ||
47 | , canParse segmentUNZ "UNZ+1+1'" | ||
48 | |||
49 | -- Examples from: | ||
50 | -- https://www.adient.com/-/media/adient/shared/suppliers/supplier-expectations/supply-chain-management-emea-docs/adient_edi-implementation-guide---desadv-un-d96a---updated-logo.pdf | ||
51 | , canParse segmentUNB "UNB+UNOA:3+SENDER+O0013007096JCIEUAG::0711+060206:1708+183'" | ||
52 | , canParse segmentUNH "UNH+LF001+DESADV:D:96A:UN'" | ||
53 | , canParse segmentBGM "BGM+351+DES58765+9'" | ||
54 | , canParse segmentDTM "DTM+137:200506011400:203'" | ||
55 | , canParse segmentDTM "DTM+11:200506011200:203'" | ||
56 | , canParse segmentMEA "MEA+AAX+AAD+KGM:47'" | ||
57 | , canParse segmentNAD "NAD+CZ+32169::92++CONSIGNOR NAME'" | ||
58 | , canParse segmentNAD "NAD+SE+876543210::92++SELLER NAME'" | ||
59 | , canParse segmentNAD "NAD+CN+1801::92++CONSIGNEE NAME'" | ||
60 | , canParse segmentNAD "NAD+CA+18010::92++CARRIER NAME'" | ||
61 | , canParse segmentLOC "LOC+11+ABC123'" | ||
62 | , canParse segmentRFF "RFF+ADE:12332'" | ||
63 | , canParse segmentTOD "TOD+5++EXW'" | ||
64 | , canParse segmentTDT "TDT+12++30'" | ||
65 | , canParse segmentEQD "EQD+TE+XYZ123456'" | ||
66 | , canParse segmentQTY "QTY+52:400:PCE'" | ||
67 | , canParse segmentPCI "PCI+17'" | ||
68 | , canParse segmentRFF "RFF+AAT:00123477'" | ||
69 | , canParse segmentPIA "PIA+1+CR153:SA'" | ||
70 | , canParse segmentQTY "QTY+3:1200:PCE'" | ||
71 | , canParse segmentQTY "QTY+12:400:PCE'" | ||
72 | , canParse segmentRFF "RFF+ON:51523'" | ||
73 | , canParse segmentUNT "UNT+45+LF001'" | ||
74 | |||
75 | , canParse segmentUNB "UNB+UNOA:4+FMFOOBA:ZZZ+FLFOOBA:OG+190515:0557+000000008'" | ||
76 | , canParse segmentUNH "UNH+0002+IFCSUM:D:96A:UN'" | ||
77 | , canParse segmentBGM "BGM+787::86+01234567+9'" | ||
78 | , canParse segmentMOA "MOA+7::EUR'" | ||
79 | , canParse segmentCNT "CNT+7:359.741:KGM'" | ||
80 | , canParse segmentRFF "RFF+AFC:01234567'" | ||
81 | , canParse segmentTDT "TDT+20+++31+0012321001:172::SOME COMPANY+SB'" | ||
82 | , canParse segmentNAD "NAD+CZ+FR01++SHIPPER NAME+ RUE SOMEWHERE+CITY+FRA+01000'" | ||
83 | , canParse segmentCTA "CTA+IC+Some Contact:Some Name'" | ||
84 | , canParse segmentCOM "COM+some.email@example.com:EM'" | ||
85 | , canParse segmentEQD "EQD+TE++E34T'" | ||
86 | , canParse segmentCNI "CNI+++1'" | ||
87 | , canParse segmentDTM "DTM+37:201904040000:203'" | ||
88 | , canParse segmentDTM "DTM+38:201904082358:203'" | ||
89 | , canParse segmentCNT "CNT+10:1'" | ||
90 | , canParse segmentCNT "CNT+7:359.74:KGM'" | ||
91 | , canParse segmentCNT "CNT+15:3.38:KGM'" | ||
92 | , canParse segmentCNT "CNT+9:163:SV'" | ||
93 | , canParse segmentNAD "NAD+SF+FR01++SHIPPER NAME+ RUE SOMEWHERE+CITY+FRA+01000'" | ||
94 | , canParse segmentGID "GID+1+163::::SV'" | ||
95 | , canParse segmentPIA "PIA+1+0212455321:TG'" | ||
96 | , canParse segmentFTX "FTX+AAA+++Default'" | ||
97 | , canParse segmentMEA "MEA+WT+G+KGM:359.741'" | ||
98 | , canParse segmentMEA "MEA+VOL+ACP+MTQ:3.384'" | ||
99 | , canParse segmentRFF "RFF+ACD:0123432105'" | ||
100 | , canParse segmentTCC "TCC+Some Info:ZZZ'" | ||
101 | , canParse segmentQTY "QTY+107:2.000000'" | ||
102 | , canParse segmentCNI "CNI+++2'" | ||
103 | , canParse segmentDTM "DTM+64:201904080001:203'" | ||
104 | , canParse segmentDTM "DTM+63:201904082359:203'" | ||
105 | , canParse segmentCNT "CNT+10:1'" | ||
106 | , canParse segmentCNT "CNT+7:359.74:KGM'" | ||
107 | , canParse segmentCNT "CNT+15:3.38:KGM'" | ||
108 | , canParse segmentCNT "CNT+9:163:SV'" | ||
109 | , canParse segmentNAD "NAD+ST+2000000000++SOME ADDRESS+ ZI SOMEWHERE+CITY+FRA+01000'" | ||
110 | , canParse segmentGID "GID+1+163::::SV'" | ||
111 | , canParse segmentPIA "PIA+1+0212455321:TG'" | ||
112 | , canParse segmentFTX "FTX+AAA+++Default'" | ||
113 | , canParse segmentMEA "MEA+WT+G+KGM:359.741'" | ||
114 | , canParse segmentMEA "MEA+VOL+ACP+MTQ:3.384'" | ||
115 | , canParse segmentRFF "RFF+ACD:012343210'" | ||
116 | , canParse segmentTCC "TCC+Some Info:ZZZ'" | ||
117 | , canParse segmentQTY "QTY+107:2.000000'" | ||
118 | , canParse segmentUNT "UNT+43+0002'" | ||
119 | , canParse segmentUNZ "UNZ+1+000000008'" | ||
120 | |||
121 | , canParse messageIFCSUM "UNH+0002+IFCSUM:D:96A:UN'BGM+787::86+01234567+9'MOA+7::EUR'CNT+7:359.741:KGM'RFF+AFC:01234567'TDT+20+++31+0012332100:172::SOME COMPANY+SB'NAD+CZ+FR01++SHIPPER NAME+ RUE SOMEWHERE+CITY+FRA+01000'CTA+IC+Some Contact:Some Name'COM+some.email@example.com:EM'EQD+TE++E34T'CNI+++1'DTM+37:201904040000:203'DTM+38:201904082358:203'CNT+10:1'CNT+7:359.74:KGM'CNT+15:3.38:KGM'CNT+9:163:SV'NAD+SF+FR01++SHIPPER NAME+ RUE SOMEWHERE+CITY+FRA+01000'GID+1+163::::SV'PIA+1+0212455321:TG'FTX+AAA+++Default'MEA+WT+G+KGM:359.741'MEA+VOL+ACP+MTQ:3.384'RFF+ACD:0123432105'TCC+Some Info:ZZZ'QTY+107:2.000000'CNI+++2'DTM+64:201904080001:203'DTM+63:201904082359:203'CNT+10:1'CNT+7:359.74:KGM'CNT+15:3.38:KGM'CNT+9:163:SV'NAD+ST+2000000000++SOME ADDRESS+ ZI SOMEWHERE+CITY+FRA+01000'GID+1+163::::SV'PIA+1+0212455321:TG'FTX+AAA+++Default'MEA+WT+G+KGM:359.741'MEA+VOL+ACP+MTQ:3.384'RFF+ACD:012343210'TCC+Some Info:ZZZ'QTY+107:2.000000'UNT+43+0002'" | ||
122 | ] | ||
123 | |||
124 | canParse :: Parser a -> Text -> Test | ||
125 | canParse p t = | ||
126 | let title = "\"" <> unpack t <> "\"" | ||
127 | in testCase title (() <$ parse (p <* eof) t @?= Right ()) | ||
diff --git a/specification/test/Spec.hs b/specification/test/Spec.hs new file mode 100644 index 0000000..d102365 --- /dev/null +++ b/specification/test/Spec.hs | |||
@@ -0,0 +1,11 @@ | |||
1 | import qualified Edifact | ||
2 | |||
3 | import Test.Framework | ||
4 | |||
5 | main :: IO () | ||
6 | main = defaultMain [suite] | ||
7 | |||
8 | suite :: Test | ||
9 | suite = testGroup "specification" | ||
10 | [ Edifact.suite | ||
11 | ] | ||