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

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Text.Edifact.Scaffolder.Messages
   4   ( messages
   5   ) where
   6
   7 import           Text.Edifact.Scaffolder.Commons
   8
   9 import           Text.Edifact.Scaffolder.Messages.Dependencies
  10 import           Text.Edifact.Scaffolder.Messages.Elements
  11 import           Text.Edifact.Scaffolder.Messages.Implementation
  12 import           Text.Edifact.Scaffolder.Messages.Specification
  13 import           Text.Edifact.Scaffolder.Messages.Types
  14
  15 import           Formatting
  16
  17 messages :: Scaffolding ()
  18 messages = listMessages >>= scaffoldElements parentMessageModule messageModule
  19
  20 parentMessageModule :: NonEmpty (ElementWithDefinition MessageCode) -> Scaffolding ()
  21 parentMessageModule = parentModule "Messages" "M" messageModuleName
  22
  23 messageModuleName :: ModuleName -> MessageCode -> ModuleName
  24 messageModuleName mn code = mn <.> fromString (getMessageCode code)
  25
  26 messageModule :: ElementWithDefinition MessageCode -> Scaffolding ()
  27 messageModule (inputFile, code) = do
  28   moduleName <- getRootModuleNameFor (messageModuleName "Messages" code)
  29   dependencies <- scanDependencies inputFile specificationParser
  30   specification <- includeSpecification inputFile
  31   let parserFunction = fMessageParserFunction
  32       fDescription = "Message " % fMessageCode
  33       parserNotYetImplemented = sformat (notYetImplemented fDescription) code
  34       defaultImplementation = haskellList [ parserNotYetImplemented ]
  35       elements = sort . nub . fmap getElement <$> dependencies
  36       implementation = maybe defaultImplementation (toImplementation code) dependencies
  37       buildDependencies b = fromMaybe [] <$> traverse b elements
  38   dependenciesReexports <- buildDependencies mkDependenciesReexports
  39   dependenciesImports   <- buildDependencies mkDependenciesImports
  40   dependenciesHaddock   <- buildDependencies mkDependenciesHaddock
  41   let exports = Comment "* Definition"
  42               : Name (sformat parserFunction code)
  43               : dependenciesReexports
  44       segmentImport = singleImport (ImportAll "Text.Edifact.Common.Segments")
  45       imports = maybe importNotYetImplementedHelper (const segmentImport) dependencies
  46               : dependenciesImports
  47              <> [ importCombinators ]
  48       documentation = specification <> dependenciesHaddock
  49       signature = sformat (fParserSignature parserFunction) code
  50       definition = [ sformat (fParserDeclaration parserFunction) code
  51                    , indent (sformat ("message " % quoted fMessageCode) code)
  52                    ] <> (indent . indent <$> implementation)
  53       parser = signature : definition
  54   scaffoldModule moduleName ["OverloadedStrings"] exports imports (documentation <> parser)