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

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TupleSections     #-}
   3
   4 module Text.Edifact.BundleReader.Messages
   5   ( readMessages
   6   , messagesDirectory
   7   ) where
   8
   9 import           Text.Edifact.BundleReader.Commons              (BundleReader,
  10                                                                  decodeContent,
  11                                                                  fMessageCodeLower,
  12                                                                  getOutputFile,
  13                                                                  parseOrFail,
  14                                                                  toFile)
  15 import           Text.Edifact.BundleReader.Configuration        (BundleReaderEnv (..))
  16 import           Text.Edifact.Scaffolder.Commons
  17 import           Text.Edifact.Scaffolder.Messages.Specification (listSegments, messageNameParser)
  18
  19 import           Control.Monad                                  (when)
  20 import           Control.Monad.Reader                           (asks)
  21 import           Data.ByteString                                as BS (ByteString,
  22                                                                        readFile)
  23 import qualified Data.Text                                      as T (isPrefixOf,
  24                                                                       lines,
  25                                                                       unlines)
  26 import           Formatting
  27
  28 messagesDirectory :: FilePath
  29 messagesDirectory = "messages"
  30
  31 readMessages :: [ByteString] -> BundleReader [(MessageCode, [SegmentCode])]
  32 readMessages contents = do
  33   selectedMessages <- asks messageNames
  34   let parsedFile path = parseFile selectedMessages =<< liftIO (BS.readFile path)
  35       parsedString = parseFile selectedMessages
  36   parsedFiles <- traverse parsedFile =<< asks messagesFiles
  37   parsedStrings <- traverse parsedString contents
  38   let filtered = parsedFiles <> filter (\s -> null selectedMessages || fst s `elem` selectedMessages) parsedStrings
  39   pure filtered
  40
  41 parseFile :: [MessageCode] -> ByteString -> BundleReader (MessageCode, [SegmentCode])
  42 parseFile selectedMessages content = do
  43   let (definition, summary) = splitFile $ decodeContent content
  44   messageCode <- parseOrFail definition messageNameParser
  45   summaryOutputFile <- getOutputFile (fMessageCodeLower % "_s.txt") messagesDirectory messageCode
  46   definitionOutputFile <- getOutputFile (fMessageCodeLower % "_d.txt") messagesDirectory messageCode
  47   when (messageCode `elem` selectedMessages) $ toFile definition definitionOutputFile
  48   when (messageCode `elem` selectedMessages) $ toFile summary summaryOutputFile
  49   (messageCode,) <$> parseOrFail summary listSegments
  50
  51 splitFile :: Text -> (Text, Text)
  52 splitFile content = let
  53   separatorBefore = "4.3    Message structure"
  54   separatorAfter  = "Annex"
  55   textBefore = takeWhile (not . T.isPrefixOf separatorBefore) $ T.lines content
  56   textInsideAndAfter = dropWhile (not . T.isPrefixOf separatorBefore) $ T.lines content
  57   textAfter = dropWhile (not . T.isPrefixOf separatorAfter) textInsideAndAfter
  58   textSummary = T.unlines $ takeWhile (not . T.isPrefixOf separatorAfter) textInsideAndAfter
  59   textDefinition = T.unlines $ textBefore <> [separatorBefore, "", "See summary file", ""] <> textAfter
  60   in
  61     (textDefinition, textSummary)