scaffolder/src/Text/Edifact/Scaffolder/Segments/Specification.hs

   1 module Text.Edifact.Scaffolder.Segments.Specification
   2   ( -- *
   3     specificationParser
   4   , listCompositesAndSimples
   5   ) where
   6
   7 import           Text.Edifact.Scaffolder.Commons
   8 import           Text.Edifact.Scaffolder.Segments.Types
   9
  10 import           Text.Parsec                            as P (anyChar, choice,
  11                                                               count, digit,
  12                                                               endOfLine, many,
  13                                                               many1, manyTill,
  14                                                               oneOf, skipMany,
  15                                                               string, try,
  16                                                               upper, (<?>))
  17 import           Text.Parsec.String                     (Parser)
  18
  19 specificationParser :: Parser ((SegmentCode, SegmentName), [Dependency])
  20 specificationParser = do
  21   segmentInfo <- scanUntil [ segmentParser ]
  22   dependencies <- scan [ inLine dependencyParser ] <?> "Segments specification"
  23   pure (segmentInfo, dependencies)
  24
  25 listCompositesAndSimples :: Parser (SegmentCode, [Element])
  26 listCompositesAndSimples = do
  27   parsed <- specificationParser
  28   pure (fst $ fst parsed, dependencyElement <$> snd parsed)
  29
  30 segmentParser :: Parser (SegmentCode, SegmentName)
  31 segmentParser = do
  32   _ <- count 6 (oneOf "+*#|X ")
  33   skipMany (string " ")
  34   code <- SegmentCode <$> count 3 upper
  35   _ <- count 2 (string " ")
  36   skipMany (string " ")
  37   name <- SegmentName <$> manyTill anyChar (() <$ try endOfLine)
  38   pure (code, name)
  39
  40 dependencyParser :: Parser Dependency
  41 dependencyParser =
  42   Dependency <$> positionParser
  43              <*  many1 (oneOf "+*#|-X ")
  44              <*> elementParser
  45              <?> "Dependency"
  46
  47 inLine :: Parser a -> Parser [a]
  48 inLine p = single (many (string " ") *> p)
  49
  50 positionParser :: Parser Position
  51 positionParser =
  52   fromString <$> count 3 digit
  53              <?> "Position"
  54
  55 elementParser :: Parser Element
  56 elementParser =
  57   choice [ compositeParser
  58          , simpleParser
  59          ]
  60          <?> "Element"
  61
  62 compositeParser :: Parser Element
  63 compositeParser = Composite <$> compositeCodeParser
  64                       <*  many (string " ")
  65                       <*> stringToPresenceParser
  66                       <*  many1 (string " ")
  67                       <*> presenceParser
  68                       <*  string " "
  69                       <*  many (oneOf " 0123456789")
  70                       <?> "Composite"
  71
  72 simpleParser :: Parser Element
  73 simpleParser = Simple <$> (fromString <$> count 4 digit)
  74                       <*  many1 (string " ")
  75                       <*> stringToPresenceParser
  76                       <*  many1 (string " ")
  77                       <*> presenceParser
  78                       <*  string "  "
  79                       <*  many (oneOf " 0123456789")
  80                       <*> simpleTypeParser
  81                       <*> simpleLengthParser
  82                       <?> "Simple"
  83
  84 simpleTypeParser :: Parser SimpleType
  85 simpleTypeParser = choice [ Alphanumeric <$ string "an"
  86                           , Alphabetic   <$ string "a"
  87                           , Numeric      <$ string "n"
  88                           ] <?> "SimpleType"
  89
  90 simpleLengthParser :: Parser SimpleLength
  91 simpleLengthParser = choice [ UpTo <$> fmap fromString (string ".." >> many1 digit)
  92                             , Exactly <$> (fromString <$> many1 digit)
  93                             ] <?> "SimpleLength"
  94
  95 compositeCodeParser :: Parser CompositeCode
  96 compositeCodeParser = do
  97   initial <- oneOf "CE"
  98   rest <- count 3 digit
  99   pure (fromString (initial : rest))