diff options
author | Frédéric Menou <frederic.menou@fretlink.com> | 2016-12-08 10:19:15 +0200 |
---|---|---|
committer | Ismaël Bouya <ismael.bouya@fretlink.com> | 2022-05-17 18:01:51 +0200 |
commit | a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7 (patch) | |
tree | adf3186fdccaeef19151026cdfbd38a530cf9ecb /scaffolder/src/Text/Edifact/BundleReader/Segments.hs | |
download | edi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.tar.gz edi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.tar.zst edi-parser-a9d77a20008efe82862cc1adbfa7a6d4f09f8ff7.zip |
Diffstat (limited to 'scaffolder/src/Text/Edifact/BundleReader/Segments.hs')
-rw-r--r-- | scaffolder/src/Text/Edifact/BundleReader/Segments.hs | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/scaffolder/src/Text/Edifact/BundleReader/Segments.hs b/scaffolder/src/Text/Edifact/BundleReader/Segments.hs new file mode 100644 index 0000000..6b71266 --- /dev/null +++ b/scaffolder/src/Text/Edifact/BundleReader/Segments.hs | |||
@@ -0,0 +1,55 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | |||
3 | module Text.Edifact.BundleReader.Segments | ||
4 | ( readSegments | ||
5 | , segmentsDirectory | ||
6 | ) where | ||
7 | |||
8 | import Text.Edifact.BundleReader.Commons | ||
9 | import Text.Edifact.BundleReader.Configuration (BundleReaderEnv (..)) | ||
10 | import Text.Edifact.Scaffolder.Commons | ||
11 | |||
12 | import Text.Edifact.Scaffolder.Segments.Specification (listCompositesAndSimples) | ||
13 | import Text.Edifact.Scaffolder.Segments.Types (Element, | ||
14 | getComposite, | ||
15 | getSimple) | ||
16 | |||
17 | import Control.Monad (when) | ||
18 | import Control.Monad.Reader (asks) | ||
19 | import Data.Bifunctor (bimap) | ||
20 | import Data.ByteString as BS (ByteString, | ||
21 | readFile) | ||
22 | import Data.List as L (partition) | ||
23 | import Data.Maybe (isJust, | ||
24 | mapMaybe) | ||
25 | import Formatting | ||
26 | |||
27 | segmentsDirectory :: FilePath | ||
28 | segmentsDirectory = "segments" | ||
29 | |||
30 | readSegments :: [ByteString] -> [SegmentCode] -> BundleReader ([CompositeCode], [SimpleCode]) | ||
31 | readSegments contents segments = do | ||
32 | let parsedFile path = parseFile segments =<< liftIO (BS.readFile path) | ||
33 | parsedString = parseFile segments | ||
34 | files <- asks segmentsFiles | ||
35 | parsedFiles <- traverse parsedFile files | ||
36 | parsedStrings <- traverse parsedString contents | ||
37 | let filtered = concatMap snd $ filter (\s -> fst s `elem` segments) $ concat (parsedFiles <> parsedStrings) | ||
38 | pure $ partitionElements filtered | ||
39 | |||
40 | parseFile :: [SegmentCode] -> ByteString -> BundleReader [(SegmentCode, [Element])] | ||
41 | parseFile segments content = | ||
42 | let chunks = tail $ splitFileByDash 70 $ decodeContent content | ||
43 | in traverse (parseChunk segments) chunks | ||
44 | |||
45 | parseChunk :: [SegmentCode] -> Text -> BundleReader (SegmentCode, [Element]) | ||
46 | parseChunk segments chunk = do | ||
47 | parsed <- parseOrFail chunk listCompositesAndSimples | ||
48 | outputFile <- getOutputFile (fSegmentCodeLower % ".txt") segmentsDirectory (fst parsed) | ||
49 | when (fst parsed `elem` segments) $ toFile chunk outputFile | ||
50 | pure parsed | ||
51 | |||
52 | partitionElements :: [Element] -> ([CompositeCode], [SimpleCode]) | ||
53 | partitionElements = | ||
54 | let isComposite = isJust . getComposite | ||
55 | in bimap (mapMaybe getComposite) (mapMaybe getSimple) . partition isComposite | ||