]>
Commit | Line | Data |
---|---|---|
a9d77a20 FM |
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 |