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

   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