diff options
Diffstat (limited to 'scaffolder/src/Text/Edifact/BundleReader/Commons.hs')
-rw-r--r-- | scaffolder/src/Text/Edifact/BundleReader/Commons.hs | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/scaffolder/src/Text/Edifact/BundleReader/Commons.hs b/scaffolder/src/Text/Edifact/BundleReader/Commons.hs new file mode 100644 index 0000000..0c8334a --- /dev/null +++ b/scaffolder/src/Text/Edifact/BundleReader/Commons.hs | |||
@@ -0,0 +1,90 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | |||
3 | module Text.Edifact.BundleReader.Commons where | ||
4 | |||
5 | import Text.Edifact.BundleReader.Configuration | ||
6 | import Text.Edifact.Scaffolder.Commons | ||
7 | |||
8 | import Control.Monad.Reader (ReaderT, runReaderT) | ||
9 | import Data.ByteString (ByteString) | ||
10 | import Data.Char (toLower) | ||
11 | import Data.List.Split (splitWhen) | ||
12 | import Data.Text as T (isInfixOf, lines, | ||
13 | map, null, | ||
14 | replicate, strip, | ||
15 | unlines, unpack) | ||
16 | import Data.Text.Encoding as TE (decodeLatin1, | ||
17 | decodeUtf8') | ||
18 | import Data.Text.IO as TIO (writeFile) | ||
19 | import Formatting | ||
20 | import Text.Parsec (Parsec, runParser) | ||
21 | |||
22 | type BundleReader = ReaderT BundleReaderEnv IO | ||
23 | |||
24 | decodeContent :: ByteString -> Text | ||
25 | decodeContent content = either (const $ cleanupAsciiArt $ decodeLatin1 content) id (decodeUtf8' content) | ||
26 | |||
27 | splitFileByDash :: Int -> Text -> [Text] | ||
28 | splitFileByDash n = | ||
29 | let separator = T.replicate n "-" | ||
30 | isNotEmpty = not . T.null . T.strip | ||
31 | in | ||
32 | filter isNotEmpty . fmap T.unlines . splitWhen (separator `T.isInfixOf`) . T.lines | ||
33 | |||
34 | runBundleReader :: BundleReader () -> BundleReaderEnv -> IO () | ||
35 | runBundleReader = runReaderT | ||
36 | |||
37 | getOutputFile :: Format String (a -> String) -> FilePath -> a -> BundleReader FilePath | ||
38 | getOutputFile f d c = do | ||
39 | home <- getSpecificationHome | ||
40 | pure (formatToString (string % "/" % string % "/" % f) home d c) | ||
41 | |||
42 | getSpecificationHome :: BundleReader FilePath | ||
43 | getSpecificationHome = do | ||
44 | home <- getHome | ||
45 | rev <- getTargetRevision | ||
46 | pure (home </> formatToString fRevision rev) | ||
47 | |||
48 | toFile :: Text -> FilePath -> BundleReader () | ||
49 | toFile specification outputFile = liftIO (TIO.writeFile outputFile specification) | ||
50 | |||
51 | parseOrFail :: (Monoid u) => Text -> Parsec String u a -> BundleReader a | ||
52 | parseOrFail specification parser = either (error . (\a -> show specification <> show a)) pure (runParser parser mempty "" (T.unpack specification)) | ||
53 | |||
54 | toFileWithParser :: (Monoid a, Monoid u) => Text -> FilePath -> Parsec String u a -> BundleReader a | ||
55 | toFileWithParser specification outputFile parser = do | ||
56 | liftIO (TIO.writeFile outputFile specification) | ||
57 | either (error . show) pure (runParser parser mempty "" (T.unpack specification)) | ||
58 | |||
59 | lower :: Format r (String -> r) | ||
60 | lower = mapf (fmap toLower) string | ||
61 | |||
62 | fRevision :: Format r (Revision -> r) | ||
63 | fRevision = mapf getRevision string | ||
64 | |||
65 | fRevisionLower :: Format r (Revision -> r) | ||
66 | fRevisionLower = mapf getRevision lower | ||
67 | |||
68 | fMessageCodeLower :: Format r (MessageCode -> r) | ||
69 | fMessageCodeLower = mapf getMessageCode lower | ||
70 | |||
71 | fSegmentCodeLower :: Format r (SegmentCode -> r) | ||
72 | fSegmentCodeLower = mapf getSegmentCode lower | ||
73 | |||
74 | fCompositeCodeLower :: Format r (CompositeCode -> r) | ||
75 | fCompositeCodeLower = mapf getCompositeCode lower | ||
76 | |||
77 | fSimpleCodeLower :: Format r (SimpleCode -> r) | ||
78 | fSimpleCodeLower = mapf getSimpleCode lower | ||
79 | |||
80 | -- This might not be the proper way to do it... | ||
81 | -- Use Data.Text.Encoding.decodeUtf8With instead? | ||
82 | cleanupAsciiArt :: Text -> Text | ||
83 | cleanupAsciiArt = | ||
84 | let f 'Ä' = '-' | ||
85 | f '¿' = '+' | ||
86 | f '³' = '|' | ||
87 | f 'Ù' = '+' | ||
88 | f 'Á' = '+' | ||
89 | f c = c | ||
90 | in T.map f | ||