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