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

   1 {-# LANGUAGE DerivingStrategies         #-}
   2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   3 {-# LANGUAGE OverloadedStrings          #-}
   4
   5 module Text.Edifact.Scaffolder.Commons.Text
   6   ( -- *
   7     indent
   8   , quote
   9   , haskellList
  10   , commaSeparated
  11     -- *
  12   , newline
  13     -- *
  14   , formatSpecification
  15     -- *
  16   , extensions
  17   ) where
  18
  19
  20 import           Text.Edifact.Scaffolder.Commons.Types (LanguageExtension (..))
  21
  22 import           Control.Category                      ((>>>))
  23 import           Data.Char                             (isSpace)
  24 import           Data.List                             (dropWhileEnd)
  25 import           Data.String                           (IsString)
  26 import           Data.Text                             (Text)
  27 import qualified Data.Text                             as T (all, dropWhileEnd,
  28                                                              null)
  29 import           Formatting                            as F (mapf, sformat,
  30                                                              stext, string, (%))
  31
  32 formatSpecification :: [Text] -> [Text]
  33 formatSpecification = cleanEmptyLines
  34                   >>> fmap quoteLine
  35                   >>> prependQuote
  36
  37 prependQuote :: [Text] -> [Text]
  38 prependQuote ls =
  39   [ "-- | Derived from this specification:"
  40   , "--"
  41   ] <> ls
  42
  43 cleanEmptyLines :: [Text] -> [Text]
  44 cleanEmptyLines = dropWhile blank >>> dropWhileEnd blank
  45
  46 blank :: Text -> Bool
  47 blank t = T.null t || T.all isSpace t
  48
  49 quoteLine :: Text -> Text
  50 quoteLine = haskellQuote >>> cleanWhitespaces
  51
  52 haskellQuote :: Text -> Text
  53 haskellQuote line = "-- > " <> line
  54
  55 cleanWhitespaces :: Text -> Text
  56 cleanWhitespaces = T.dropWhileEnd (== ' ')
  57
  58 indent :: Text -> Text
  59 indent t = "  " <> t
  60
  61 quote :: Text -> Text
  62 quote t = "'" <> t <> "'"
  63
  64 haskellList :: [Text] -> [Text]
  65 haskellList =
  66   let prefix :: Int -> Text -> Text
  67       prefix 1 dep = sformat ("[ " % F.stext) dep
  68       prefix _ dep = sformat (", " % F.stext) dep
  69       suffix deps = deps <> ["]"]
  70   in suffix . zipWith prefix [1..]
  71
  72 newtype CommaSeparated = CommaSeparated { getCommaSeparated :: Text } deriving newtype (IsString, Eq)
  73
  74 instance Semigroup CommaSeparated where
  75   t1 <> "" = t1
  76   "" <> t2 = t2
  77   t1 <> t2 = CommaSeparated (getCommaSeparated t1 <> ", " <> getCommaSeparated t2)
  78
  79 instance Monoid CommaSeparated where
  80   mempty = ""
  81
  82 commaSeparated :: Foldable f => f Text -> Text
  83 commaSeparated = getCommaSeparated . foldMap CommaSeparated
  84
  85 newline :: [Text]
  86 newline = [""]
  87
  88 extensions :: [LanguageExtension] -> [Text]
  89 extensions =
  90   let fExtension = "{-# LANGUAGE " % mapf getLanguageExtension F.string % " #-}"
  91   in fmap (sformat fExtension)