5 files changed, 220 insertions, 0 deletions

diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Segments/Dependencies.hs b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Dependencies.hs
new file mode 100644
index 0000000..acb9ea8
--- /dev/null
+++ b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Dependencies.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.Edifact.Scaffolder.Segments.Dependencies
+  ( -- *
+    mkDependenciesHaddock
+  , mkDependenciesImports
+  , mkDependenciesReexports
+  ) where
+
+import           Text.Edifact.Scaffolder.Commons
+import           Text.Edifact.Scaffolder.Segments.Types
+
+import           Data.List.NonEmpty                     as NE (nonEmpty, toList)
+import           Data.Maybe                             (catMaybes, mapMaybe)
+import           Formatting                             as F
+
+mkDependenciesReexports :: NonEmpty Element -> Scaffolding [Export]
+mkDependenciesReexports = reexportDependencies fElementFunction
+
+mkDependenciesImports :: NonEmpty Element -> Scaffolding [ImportGroup]
+mkDependenciesImports elements =
+  let filterElements optic = mapMaybe optic . NE.toList
+  in maybe [] (pure . ImportGroup) . nonEmpty . catMaybes <$>
+       sequence
+         [ mkCompositeDependenciesImports (filterElements getComposite elements)
+         , mkSimpleDependenciesImports    (filterElements getSimple    elements)
+         ]
+
+mkSimpleDependenciesImports :: [SimpleCode] -> Scaffolding (Maybe Import)
+mkSimpleDependenciesImports =
+  ifNonEmpty (importDependencies "Simples" fSimpleParserFunction)
+
+mkCompositeDependenciesImports :: [CompositeCode] -> Scaffolding (Maybe Import)
+mkCompositeDependenciesImports =
+  ifNonEmpty (importDependencies "Composites" fCompositeParserFunction)
+
+ifNonEmpty :: Applicative f => (NonEmpty input -> f output) -> [input] -> f (Maybe output)
+ifNonEmpty f = traverse f . nonEmpty
+
+mkDependenciesHaddock :: NonEmpty Element -> Scaffolding [Text]
+mkDependenciesHaddock = haddockDependencies fElementFunction
+
+fElementFunction :: Format r (Element -> r)
+fElementFunction =
+  let buildElementFunction (Simple    code _ _ _ _) = bprint fSimpleParserFunction    code
+      buildElementFunction (Composite code _ _)     = bprint fCompositeParserFunction code
+  in later buildElementFunction
diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Segments/Elements.hs b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Elements.hs
new file mode 100644
index 0000000..4e8b39c
--- /dev/null
+++ b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Elements.hs
@@ -0,0 +1,26 @@
+module Text.Edifact.Scaffolder.Segments.Elements
+  ( listSegments
+  ) where
+
+import           Text.Edifact.Scaffolder.Commons
+
+import           Data.Char                       (isLower, toUpper)
+import           Text.Parsec                     (eof, lower, satisfy, string,
+                                                  (<?>))
+import           Text.Parsec.String              (Parser)
+
+listSegments :: Scaffolding [ElementWithDefinition SegmentCode]
+listSegments = listElements "segments" segmentCodeParser
+
+segmentCodeParser :: Parser SegmentCode
+segmentCodeParser = do
+  c1 <- lowerExceptU
+  c2 <- lower
+  c3 <- lower
+  let code = SegmentCode (toUpper <$> [c1,c2,c3])
+  code <$  string ".txt"
+       <*  eof
+       <?> "SegmentCode"
+
+lowerExceptU :: Parser Char
+lowerExceptU = satisfy (\ c -> isLower c && c /= 'u')
diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Segments/Implementation.hs b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Implementation.hs
new file mode 100644
index 0000000..8535a17
--- /dev/null
+++ b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Implementation.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.Edifact.Scaffolder.Segments.Implementation
+  ( -- *
+    toImplementation
+  ) where
+
+import           Text.Edifact.Scaffolder.Commons
+import           Text.Edifact.Scaffolder.Segments.Types
+
+import           Data.List.NonEmpty                     as NE (toList)
+import           Formatting
+
+toImplementation :: NonEmpty Dependency -> [Text]
+toImplementation = haskellList . fmap callDependency . NE.toList
+
+callDependency :: Dependency -> Text
+callDependency (Dependency pos (Simple code _ presence _ _)) =
+  sformat ( quoted fPosition % " .@ " % fPresence % " simple" % fSimpleCode) pos presence code
+callDependency (Dependency pos (Composite code _ presence)) =
+  sformat ( quoted fPosition % " .@ " % fPresence % " composite" % fCompositeCode) pos presence code
diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Segments/Specification.hs b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Specification.hs
new file mode 100644
index 0000000..39a7ad4
--- /dev/null
+++ b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Specification.hs
@@ -0,0 +1,99 @@
+module Text.Edifact.Scaffolder.Segments.Specification
+  ( -- *
+    specificationParser
+  , listCompositesAndSimples
+  ) where
+
+import           Text.Edifact.Scaffolder.Commons
+import           Text.Edifact.Scaffolder.Segments.Types
+
+import           Text.Parsec                            as P (anyChar, choice,
+                                                              count, digit,
+                                                              endOfLine, many,
+                                                              many1, manyTill,
+                                                              oneOf, skipMany,
+                                                              string, try,
+                                                              upper, (<?>))
+import           Text.Parsec.String                     (Parser)
+
+specificationParser :: Parser ((SegmentCode, SegmentName), [Dependency])
+specificationParser = do
+  segmentInfo <- scanUntil [ segmentParser ]
+  dependencies <- scan [ inLine dependencyParser ] <?> "Segments specification"
+  pure (segmentInfo, dependencies)
+
+listCompositesAndSimples :: Parser (SegmentCode, [Element])
+listCompositesAndSimples = do
+  parsed <- specificationParser
+  pure (fst $ fst parsed, dependencyElement <$> snd parsed)
+
+segmentParser :: Parser (SegmentCode, SegmentName)
+segmentParser = do
+  _ <- count 6 (oneOf "+*#|X ")
+  skipMany (string " ")
+  code <- SegmentCode <$> count 3 upper
+  _ <- count 2 (string " ")
+  skipMany (string " ")
+  name <- SegmentName <$> manyTill anyChar (() <$ try endOfLine)
+  pure (code, name)
+
+dependencyParser :: Parser Dependency
+dependencyParser =
+  Dependency <$> positionParser
+             <*  many1 (oneOf "+*#|-X ")
+             <*> elementParser
+             <?> "Dependency"
+
+inLine :: Parser a -> Parser [a]
+inLine p = single (many (string " ") *> p)
+
+positionParser :: Parser Position
+positionParser =
+  fromString <$> count 3 digit
+             <?> "Position"
+
+elementParser :: Parser Element
+elementParser =
+  choice [ compositeParser
+         , simpleParser
+         ]
+         <?> "Element"
+
+compositeParser :: Parser Element
+compositeParser = Composite <$> compositeCodeParser
+                      <*  many (string " ")
+                      <*> stringToPresenceParser
+                      <*  many1 (string " ")
+                      <*> presenceParser
+                      <*  string " "
+                      <*  many (oneOf " 0123456789")
+                      <?> "Composite"
+
+simpleParser :: Parser Element
+simpleParser = Simple <$> (fromString <$> count 4 digit)
+                      <*  many1 (string " ")
+                      <*> stringToPresenceParser
+                      <*  many1 (string " ")
+                      <*> presenceParser
+                      <*  string "  "
+                      <*  many (oneOf " 0123456789")
+                      <*> simpleTypeParser
+                      <*> simpleLengthParser
+                      <?> "Simple"
+
+simpleTypeParser :: Parser SimpleType
+simpleTypeParser = choice [ Alphanumeric <$ string "an"
+                          , Alphabetic   <$ string "a"
+                          , Numeric      <$ string "n"
+                          ] <?> "SimpleType"
+
+simpleLengthParser :: Parser SimpleLength
+simpleLengthParser = choice [ UpTo <$> fmap fromString (string ".." >> many1 digit)
+                            , Exactly <$> (fromString <$> many1 digit)
+                            ] <?> "SimpleLength"
+
+compositeCodeParser :: Parser CompositeCode
+compositeCodeParser = do
+  initial <- oneOf "CE"
+  rest <- count 3 digit
+  pure (fromString (initial : rest))
diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Segments/Types.hs b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Types.hs
new file mode 100644
index 0000000..6a34cbc
--- /dev/null
+++ b/scaffolder/src/Text/Edifact/Scaffolder/Segments/Types.hs
@@ -0,0 +1,27 @@
+module Text.Edifact.Scaffolder.Segments.Types where
+
+import           Text.Edifact.Scaffolder.Commons
+
+data Dependency = Dependency { dependencyPosition :: Position
+                             , dependencyElement  :: Element
+                             } deriving Show
+
+data Element = Composite CompositeCode Text Presence
+             | Simple SimpleCode Text Presence SimpleType SimpleLength
+               deriving (Show, Eq, Ord)
+
+data SimpleType = Alphanumeric | Alphabetic | Numeric deriving (Show, Eq, Ord)
+
+data SimpleLength = Exactly Text | UpTo Text deriving (Show, Eq, Ord)
+
+getCode :: Element -> String
+getCode (Simple (SimpleCode c) _ _ _ _)   = c
+getCode (Composite (CompositeCode c) _ _) = c
+
+getSimple :: Element -> Maybe SimpleCode
+getSimple (Simple c _ _ _ _) = Just c
+getSimple _                  = Nothing
+
+getComposite :: Element -> Maybe CompositeCode
+getComposite (Composite c _ _) = Just c
+getComposite _                 = Nothing