1 {-# LANGUAGE TupleSections #-}
4 Module : Text.Edifact.Parsing.Combinators
5 Description : High level combinators
7 module Text.Edifact.Parsing.Combinators
16 -- ** Position and strictness
23 -- ** Repetition of segments and segment groups
30 import Text.Edifact.Parsing.Commons
31 import Text.Edifact.Types
33 import Text.Parsec (lookAhead, many1, optionMaybe,
35 import qualified Text.Parsec as P (many)
37 -- | Parses a 'Message'.
39 -- > messageABCDEF :: Parser Value
41 -- > let simple1234 = simple "1234" (alphaNumeric `upTo` 35)
42 -- > c101 = composite "C101" [ position "010" (mandatory simple1234)
43 -- > , position "020" (optional simple1234)
45 -- > segmentABC = segment "ABC" [ position "010" (mandatory c101)
47 -- > in message "ABCDEF" [ position "0010" (mandatory segmentABC)
49 message :: MessageCode -> [Parser (Position, [Value])] -> Parser Value
51 let description = "message " <> show code
52 in Message code <$> sequence ps <??> description
54 -- | Parses a 'Group'.
56 -- A Segment Group is the way Edifact format represents hierarchy. One can view
57 -- a segment group as a sub message. A segment group can be repeated like
58 -- segments. A segment group wraps segments and segment groups.
59 segmentGroup :: GroupCode -> [Parser (Position, [Value])] -> Parser Value
60 segmentGroup code ps =
61 let description = "segment-group " <> show code
62 in Group code <$> sequence ps <??> description
64 -- | Parses a 'Segment'.
68 -- > segmentABC :: Parser Value
70 -- > let simple1234 = simple "1234" (alphaNumeric `upTo` 35)
71 -- > simple2001 = simple "2001" (alphaNumeric `exactly` 3)
72 -- > c101 = composite "C101" [ position "010" (mandatory simple1234)
73 -- > , position "020" (optional simple1234)
74 -- > , position "030" (optional simple1234)
76 -- > in segment "ABC" [ position "010" (mandatory simple2001)
77 -- > , position "020" (optional c101)
80 -- would parse strings such as:
82 -- >>> parse segmentABC "ABC+123'"
83 -- Segment "ABC" [ ("010", Just (Simple "2001" "123"))
85 -- >>> parse segmentABC "ABC+123+abcdefgh'"
86 -- Segment "ABC" [ ("010", Just (Simple "2001" "123"))
87 -- , ("020", Just (Composite "C101" [ ("010", Just (Simple "1234" "abcdefgh"))
91 -- >>> parse segmentABC "ABC+123+abcdefgh:ijklmno'"
92 -- Segment "ABC" [ ("010", Just (Simple "2001" "123"))
93 -- , ("020", Just (Composite "C101" [ ("010", Just (Simple "1234" "abcdefgh"))
94 -- , ("020", Just (Simple "1234" "ijklmno"))
98 segment :: SegmentCode -> [Parser (Position, Maybe Value)] -> Parser Value
99 segment code parsers =
100 let go [] = [] <$ parseSegmentSeparator
102 tries [ [] <$ parseSegmentSeparator
103 , (:) <$> (parseElementSeparator *> p)
106 description = "segment " <> show code
107 in Segment <$> parseSegmentCode code
111 parseSegmentCode :: SegmentCode -> Parser SegmentCode
112 parseSegmentCode (SegmentCode code) =
113 let description = "segment code " <> show code
114 in SegmentCode <$> string code <??> description
116 -- | Parses a 'Composite' element.
120 -- > compositeC101 :: Parser Value
122 -- > let simple1234 = simple "1234" (alphaNumeric `upTo` 35)
123 -- > in composite "C101" [ position "010" (mandatory simple1234)
124 -- > , position "020" (optional simple1234)
125 -- > , position "030" (optional simple1234)
128 -- would parse strings such as:
130 -- >>> parse compositeC101 "abcdefgh"
131 -- Composite "C101" [ ("010", Just (Simple "1234" "abcdefgh"))
133 -- >>> parse compositeC101 "abcdefgh:ijklmno"
134 -- Composite "C101" [ ("010", Just (Simple "1234" "abcdefgh"))
135 -- , ("020", Just (Simple "1234" "ijklmno"))
137 -- >>> parse compositeC101 "abcdefgh::pqrstu"
138 -- Composite "C101" [ ("010", Just (Simple "1234" "abcdefgh"))
139 -- , ("020", Just (Simple "1234" ""))
140 -- , ("030", Just (Simple "1234" "pqrstu"))
142 composite :: CompositeCode -> [Parser (Position, Maybe Value)] -> Parser Value
143 composite code parsers =
146 let parseSeparator = tries [ parseCompositeSeparator
147 , lookAhead parseElementSeparator
148 , lookAhead parseSegmentSeparator
150 (value, continuation) <- tries [ (, ps) <$> p <* parseSeparator
153 (:) value <$> go continuation
154 description = "composite element " <> show code
155 in Composite code <$> go parsers <??> description
157 -- | Parses a 'Simple' element.
159 -- Following parser would parse strings of size between 0 and 35 characters.
161 -- > simple1234 :: Parser Value
162 -- > simple1234 = simple "1234" (alphaNumeric `upTo` 35)
163 simple :: SimpleCode -> Parser Primitive -> Parser Value
165 let description = "simple element " <> show code
166 in Simple code <$> p <??> description
168 -- | Makes the parsing of the element optional, which doesn't consume input if the given parser doesn't succeed.
169 optional :: Parser Value -> Parser (Maybe Value)
170 optional = optionMaybe
172 -- | Makes the parsing of the element mandatory.
173 mandatory :: Parser Value -> Parser (Maybe Value)
174 mandatory = fmap Just
176 -- | Sets the current 'Position'. This is relevant for segment in a message, for composite or simple element in a segment, and for simple element in a composite.
177 position :: Position -> Parser (f Value) -> Parser (Position, f Value)
179 let decorated = (pos,) <$> p
180 in setCurrentPosition pos *> decorated <* resetCurrentPosition
182 -- | Alias to 'position'.
184 -- > compositeC101 :: Parser Value
186 -- > let simple1234 = simple "1234" (alphaNumeric `upTo` 35)
187 -- > in composite "C101" [ "010" .@ mandatory simple1234
188 -- > , "020" .@ optional simple1234
189 -- > , "030" .@ optional simple1234
191 (.@) :: Position -> Parser (f Value) -> Parser (Position, f Value)
194 -- | Flipped alias to 'position'.
196 -- > compositeC101 :: Parser Value
198 -- > let simple1234 = simple "1234" (alphaNumeric `upTo` 35)
199 -- > in composite "C101" [ mandatory simple1234 @. "010"
200 -- > , optional simple1234 @. "020"
201 -- > , optional simple1234 @. "030"
203 (@.) :: Parser (f Value) -> Position -> Parser (Position, f Value)
206 -- | For segments or segment groups, let you express how many occurrences.
207 repeated :: Int -> Parser a -> Parser [a]
208 repeated limit p = do
209 values <- P.many (try p)
210 let parsed = length values
212 then failWithPosition ("expected up to " <> show limit <> " items, but encountered " <> show parsed)
215 -- | For segments or segment groups, let you express how many occurrences with at least one occurrence.
216 repeatedAtLeastOnce :: Int -> Parser a -> Parser [a]
217 repeatedAtLeastOnce limit p = do
218 values <- many1 (try p)
219 let parsed = length values
221 then failWithPosition ("expected up to " <> show limit <> " items, but encountered " <> show parsed)
224 -- | For segments or segment groups, let you express you expect only one occurrence.
225 once :: Parser a -> Parser [a]
228 -- | For segments or segment groups, let you express you expect one or no occurrence.
229 maybeOnce :: Parser a -> Parser [a]
230 maybeOnce = fmap (maybe [] pure) . optionMaybe