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

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Text.Edifact.Scaffolder.Segments
   4   ( segments
   5   ) where
   6
   7 import           Text.Edifact.Scaffolder.Commons
   8
   9 import           Text.Edifact.Scaffolder.Segments.Dependencies
  10 import           Text.Edifact.Scaffolder.Segments.Elements
  11 import           Text.Edifact.Scaffolder.Segments.Implementation
  12 import           Text.Edifact.Scaffolder.Segments.Specification
  13 import           Text.Edifact.Scaffolder.Segments.Types
  14
  15 import           Data.List.NonEmpty                              (nubBy)
  16 import           Formatting
  17
  18 segments :: Scaffolding ()
  19 segments = listSegments >>= scaffoldElements parentSegmentModule segmentModule
  20
  21 parentSegmentModule :: NonEmpty (ElementWithDefinition SegmentCode) -> Scaffolding ()
  22 parentSegmentModule = parentModule "Segments" "S" segmentModuleName
  23
  24 segmentModuleName :: ModuleName -> SegmentCode -> ModuleName
  25 segmentModuleName mn code = mn <.> fromString (getSegmentCode code)
  26
  27 segmentModule :: ElementWithDefinition SegmentCode -> Scaffolding ()
  28 segmentModule (inputFile, code) = do
  29   moduleName <- getRootModuleNameFor (segmentModuleName "Segments" code)
  30   dependencies <- scanDependencies inputFile (snd <$> specificationParser)
  31   specification <- includeSpecification inputFile
  32   let parserFunction = fSegmentParserFunction
  33       fDescription = "Segment " % fSegmentCode
  34       parserNotYetImplemented = sformat (notYetImplemented fDescription) code
  35       defaultImplementation = haskellList [ parserNotYetImplemented ]
  36       elements = sort . nubBy (\a b -> getCode a == getCode b) . fmap dependencyElement <$> dependencies
  37       implementation = maybe defaultImplementation toImplementation dependencies
  38       buildDependencies b = fromMaybe [] <$> traverse b elements
  39   dependenciesReexports <- buildDependencies mkDependenciesReexports
  40   dependenciesImports   <- buildDependencies mkDependenciesImports
  41   dependenciesHaddock   <- buildDependencies mkDependenciesHaddock
  42   let exports = Comment "* Definition"
  43               : Name (sformat parserFunction code)
  44               : dependenciesReexports
  45       imports = dependenciesImports
  46              <> [ importCombinators ]
  47              <> maybe [ importNotYetImplementedHelper ] (const []) dependencies
  48       documentation = specification <> dependenciesHaddock
  49       signature = sformat (fParserSignature parserFunction) code
  50       definition = [ sformat (fParserDeclaration parserFunction) code
  51                    , indent (sformat ("segment " % quoted fSegmentCode) code)
  52                    ] <> (indent . indent <$> implementation)
  53       parser = signature : definition
  54   scaffoldModule moduleName ["OverloadedStrings"] exports imports (documentation <> parser)