Mock.hs 6.67 KB
Newer Older
Nicolas Lenz's avatar
Nicolas Lenz committed
1
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
2

3
module Text.Mock (version, styles, mockAlternate, mockRandom, letterspace, toDouble, toSubSuper) where
Nicolas Lenz's avatar
Nicolas Lenz committed
4

Nicolas Lenz's avatar
Nicolas Lenz committed
5
6
import qualified Data.Text as T
import Data.Text (Text)
Nicolas Lenz's avatar
Nicolas Lenz committed
7
8
import Data.Char
import Data.List
9
import Data.Hashable
Nicolas Lenz's avatar
Nicolas Lenz committed
10
11
import System.Random

Nicolas Lenz's avatar
Nicolas Lenz committed
12
13
14
-- |Version string
version :: T.Text
version = "3.5.0"
15

Nicolas Lenz's avatar
Nicolas Lenz committed
16
-- |List of possible mock style names and their functions.
Nicolas Lenz's avatar
Nicolas Lenz committed
17
styles :: [(Text, Text -> Text)]
Nicolas Lenz's avatar
Nicolas Lenz committed
18
19
styles = [
    ("random", mockRandom),
20
    ("alternate", mockAlternate),
21
    ("alternate2", mockAlternate . T.toLower),
22
    ("strike", strikethrough),
Nicolas Lenz's avatar
Nicolas Lenz committed
23
    ("double", T.map toDouble),
Nicolas Lenz's avatar
Nicolas Lenz committed
24
    ("dedouble", T.map fromDouble),
Nicolas Lenz's avatar
Nicolas Lenz committed
25
    ("smallcaps", T.map toSmallCap),
26
27
    ("lower", T.toLower),
    ("upper", T.toUpper),
Nicolas Lenz's avatar
Nicolas Lenz committed
28
    ("cyrillic", T.map toCyrillic),
Nicolas Lenz's avatar
Nicolas Lenz committed
29
    ("subsuper", mockSubSuper),
Nicolas Lenz's avatar
Nicolas Lenz committed
30
    ("cc", mockCC),
Nicolas Lenz's avatar
Nicolas Lenz committed
31
    ("b", mockB),
Nicolas Lenz's avatar
Nicolas Lenz committed
32
    ("pray", T.unwords . intersperse "🙏" . T.words),
Nicolas Lenz's avatar
Nicolas Lenz committed
33
    ("clap", T.unwords . intersperse "👏" . T.words),
34
35
36
    ("space", letterspace 1),
    ("space2", letterspace 2),
    ("space3", letterspace 3),
37
    ("lines", T.intersperse '\n'),
Nicolas Lenz's avatar
Nicolas Lenz committed
38
    ("wordlines", T.concat . intersperse "\n" . T.words),
39
    ("square", mockSquare)]
Nicolas Lenz's avatar
Nicolas Lenz committed
40

Nicolas Lenz's avatar
Nicolas Lenz committed
41
-- |Transforms a String into uppercase where the corresponding list is True. For False the String isn't changed.
42
43
44
45
46
toUpperBy :: [Bool] -> T.Text -> T.Text
toUpperBy bs = T.pack . zipWith f bs . T.unpack where
    f :: Bool -> Char -> Char
    f True c = toUpper c
    f False c = c
Nicolas Lenz's avatar
Nicolas Lenz committed
47

Nicolas Lenz's avatar
Nicolas Lenz committed
48
49
50
51
52
53
54
55
56
toUpperBy' :: [Bool] -> String -> String
toUpperBy' (True:bs) (c:cs)
    | isUpper c = c : toUpperBy' (not <$> bs) cs
    | otherwise = toUpper c : toUpperBy' bs cs
toUpperBy' (False:bs) (c:cs)
    | isUpper c = c : toUpperBy' (not <$> bs) cs
    | otherwise = c : toUpperBy' bs cs
toUpperBy' _ _ = []

Nicolas Lenz's avatar
Nicolas Lenz committed
57
-- |Transforms every other of the Chars of a String into uppercase. The other Chars aren't changed.
58
mockAlternate :: T.Text -> T.Text
Nicolas Lenz's avatar
Nicolas Lenz committed
59
mockAlternate = T.pack . toUpperBy' (intersperse True $ repeat False) . T.unpack
Nicolas Lenz's avatar
Nicolas Lenz committed
60

61
-- |Tansforms random (that is, random per input String) Chars of a String into uppercase.
62
mockRandom :: T.Text -> T.Text
Nicolas Lenz's avatar
Nicolas Lenz committed
63
mockRandom txt = T.pack $ toUpperBy' (randoms $ mkStdGen (hash txt)) $ T.unpack txt
64

Nicolas Lenz's avatar
Nicolas Lenz committed
65
-- |Letterspaces a String with the given number of blanks between the Chars.
66
letterspace :: Int -> T.Text -> T.Text
Nicolas Lenz's avatar
Nicolas Lenz committed
67
letterspace n = T.pack . intercalate (replicate n ' ') . map (:[]) . T.unpack
Nicolas Lenz's avatar
Nicolas Lenz committed
68

69
-- |Transforms a character into its double-struck variant (if it is alphanumeric, else it is left unchanged).
70
71
72
73
74
75
76
77
78
toDouble :: Char -> Char
toDouble 'C' = chr 8450
toDouble 'H' = chr 8461
toDouble 'N' = chr 8469
toDouble 'P' = chr 8473
toDouble 'Q' = chr 8474
toDouble 'R' = chr 8477
toDouble 'Z' = chr 8484
toDouble c
Nicolas Lenz's avatar
Nicolas Lenz committed
79
80
81
    | 48 <= ord c && ord c <= 57 =  chr $ ord c - 48 + 120792  -- Number
    | 65 <= ord c && ord c <= 90 =  chr $ ord c - 65 + 120120  -- Uppercase letter
    | 97 <= ord c && ord c <= 122 = chr $ ord c - 97 + 120146  -- Lowercase letter
82
toDouble c = c
Nicolas Lenz's avatar
Nicolas Lenz committed
83

Nicolas Lenz's avatar
Nicolas Lenz committed
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
mockSubSuper :: Text -> Text
mockSubSuper txt = T.pack $ zipWith toSubSuper (intersperse True $ repeat False) (T.unpack txt)

toSubSuper :: Bool -> Char -> Char
toSubSuper sub c = case (sub, c) of
    (_, 'A') -> chr 7468
    (_, 'B') -> chr 7470
    (_, 'D') -> chr 7472
    (_, 'E') -> chr 7473
    (_, 'G') -> chr 7475
    (_, 'H') -> chr 7476
    (_, 'I') -> chr 7477
    (_, 'J') -> chr 7478
    (_, 'K') -> chr 7479
    (_, 'L') -> chr 7480
    (_, 'M') -> chr 7481
    (_, 'N') -> chr 7482
    (_, 'O') -> chr 7484
    (_, 'P') -> chr 7486
    (_, 'R') -> chr 7487
    (_, 'T') -> chr 7488
    (_, 'U') -> chr 7489
    (_, 'V') -> chr 11389
    (_, 'W') -> chr 7490
    (False, 'a') -> 'ᵃ'
    (True, 'a') -> 'ₐ'
    (_, 'b') -> 'ᵇ'
    (_, 'c') -> 'ᶜ'
    (_, 'd') -> 'ᵈ'
    (False, 'e') -> 'ᵉ'
    (True, 'e') -> 'ₑ'
    (_, 'f') -> 'ᶠ'
    (_, 'g') -> 'ᵍ'
    (False, 'h') -> 'ʰ'
    (True, 'h') -> 'ₕ'
    (False, 'i') -> 'ⁱ'
    (True, 'i') -> 'ᵢ'
    (False, 'j') -> 'ʲ'
    (True, 'j') -> 'ⱼ'
    (False, 'k') -> 'ᵏ'
    (True, 'k') -> 'ₖ'
    (False, 'l') -> 'ˡ'
    (True, 'l') -> 'ₗ'
    (False, 'm') -> 'ᵐ'
    (True, 'm') -> 'ₘ'
    (False, 'n') -> 'ⁿ'
    (True, 'n') -> 'ₙ'
    (False, 'o') -> 'ᵒ'
    (True, 'o') -> 'ₒ'
    (False, 'p') -> 'ᵖ'
    (True, 'p') -> 'ₚ'
    (False, 'r') -> 'ʳ'
    (True, 'r') -> 'ᵣ'
    (False, 's') -> 'ˢ'
    (True, 's') -> 'ₛ'
    (False, 't') -> 'ᵗ'
    (True, 't') -> 'ₜ'
    (False, 'u') -> 'ᵘ'
    (True, 'u') -> 'ᵤ'
    (False, 'v') -> 'ᵛ'
    (True, 'v') -> 'ᵥ'
    (_, 'w') -> 'ʷ'
    (False, 'x') -> 'ˣ'
    (True, 'x') -> 'ₓ'
    (_, 'y') -> 'ʸ'
    (_, 'z') -> 'ᶻ'
    (_, c) -> c
Nicolas Lenz's avatar
Nicolas Lenz committed
151

Nicolas Lenz's avatar
Nicolas Lenz committed
152
-- |Transforms double-struck characters back into their normal variant.
Nicolas Lenz's avatar
Nicolas Lenz committed
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
fromDouble :: Char -> Char
fromDouble c = case ord c of
    8450 -> 'C'
    8461 -> 'H'
    8469 -> 'N'
    8473 -> 'P'
    8474 -> 'Q'
    8477 -> 'R'
    8484 -> 'Z'
    code
        | 120792 <= code && code <= 120801 -> chr $ code - 120792 + 48
        | 120120 <= code && code <= 120145 -> chr $ code - 120120 + 65
        | 120146 <= code && code <= 120171 -> chr $ code - 120146 + 97
    code -> chr code

168
-- |Transforms lowercase characters into their unicode small capital variant
Nicolas Lenz's avatar
Nicolas Lenz committed
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
toSmallCap :: Char -> Char
toSmallCap = \case
    'a' -> chr 7424
    'b' -> chr 665
    'c' -> chr 7428
    'd' -> chr 7429
    'e' -> chr 7431
    'f' -> chr 42800
    'g' -> chr 610
    'h' -> chr 668
    'i' -> chr 618
    'j' -> chr 7434
    'k' -> chr 7435
    'l' -> chr 671
    'm' -> chr 7437
    'n' -> chr 628
    'o' -> chr 7439
    'p' -> chr 7448
    'q' -> chr 491
    'r' -> chr 640
    's' -> chr 42801
    't' -> chr 7451
    'u' -> chr 7452
    'v' -> chr 7456
    'w' -> chr 7457
    'y' -> chr 655
    'z' -> chr 7458
    c -> c

Nicolas Lenz's avatar
Nicolas Lenz committed
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
toCyrillic :: Char -> Char
toCyrillic = \case
    'A' -> 'Д'
    'B' -> 'Б'
    'E' -> 'З'
    'N' -> 'И'
    'O' -> 'Ө'
    'R' -> 'Я'
    'U' -> 'Ц'
    'W' -> 'Щ'
    'X' -> 'Ж'
    'a' -> 'д'
    'b' -> 'в'
    'e' -> 'ё'
    'h' -> 'Ђ'
    'i' -> 'ɪ'
    'k' -> 'к'
    'o' -> 'ө'
    'r' -> 'я'
    't' -> 'т'
    'u' -> 'ц'
    'y' -> 'џ'
    c -> c

Nicolas Lenz's avatar
Nicolas Lenz committed
222
223
224
-- |Replaces all occurences of lowercase "ck" and "k" in a string with "cc"s.
mockCC :: T.Text -> T.Text
mockCC = T.replace "k" "cc" . T.replace "ck" "cc"
Nicolas Lenz's avatar
Nicolas Lenz committed
225
226
227
228

-- |Repaclaces all occurences of "b" and "B" with B button emojis.
mockB :: Text -> Text
mockB = T.replace "b" "🅱️" . T.replace "B" "🅱️"
Nicolas Lenz's avatar
Nicolas Lenz committed
229
230
231

-- |Makes a square from a string.
mockSquare :: Text -> Text
Nicolas Lenz's avatar
Fix #7    
Nicolas Lenz committed
232
mockSquare text = T.concat [T.intersperse ' ' text, "\n", T.intercalate "\n" (T.chunksOf 1 $ T.tail text)]
233
234
235
236
237
238

-- |Uses Unicode U+0336 to let a text look struck through.
strikethrough :: Text -> Text
strikethrough text
    | text == T.empty = T.empty
    | otherwise = T.intersperse '\822' text `T.append` "\822"