diff options
Diffstat (limited to 'scaffolder/src/Text/Edifact/Scaffolder/Commons/Text.hs')
-rw-r--r-- | scaffolder/src/Text/Edifact/Scaffolder/Commons/Text.hs | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/scaffolder/src/Text/Edifact/Scaffolder/Commons/Text.hs b/scaffolder/src/Text/Edifact/Scaffolder/Commons/Text.hs new file mode 100644 index 0000000..ef4e805 --- /dev/null +++ b/scaffolder/src/Text/Edifact/Scaffolder/Commons/Text.hs | |||
@@ -0,0 +1,91 @@ | |||
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) | ||