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

3
module Text.Mock (styles, version) where
Nicolas Lenz's avatar
Nicolas Lenz committed
4

Nicolas Lenz's avatar
Nicolas Lenz committed
5
import Data.Text (Text)
6
import qualified Data.Text as T
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
-- |Version string
13
version :: Text
Nicolas Lenz's avatar
Nicolas Lenz committed
14
version = "3.5.0"
15

16
-- | List of all mock styles as tuples of the name and the transformation function.
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

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
-- | Transforms characters of a string into uppercase where the corresponding element of the bool list is true. On encountering a letter that already is uppercase the mask is reversed.
toUpperBy :: [Bool] -> Text -> Text
toUpperBy mask' = fst . T.foldl f ("", mask') where
    f :: (Text, [Bool]) -> Char -> (Text, [Bool])
    f (txt, bit:mask) char
        | isUpper char = (txt `T.snoc` char, map not mask)
        | isSpace char = (txt `T.snoc` char, bit:mask)
    f (txt, True:mask) char = (txt `T.snoc` toUpper char, mask)
    f (txt, False:mask) char = (txt `T.snoc` char, mask)
    f (txt, []) char = (txt `T.snoc` char, [])  -- If the mask is empty, treat is as all false

-- | Transforms every other of the characters of a string into uppercase. The other characters aren't changed.
mockAlternate :: Text -> Text
mockAlternate = toUpperBy (intersperse True $ repeat False)

-- | Tansforms random (that is, pseudo-random per input) characters of a string into uppercase.
mockRandom :: Text -> Text
mockRandom txt = toUpperBy (randoms $ mkStdGen (hash txt)) txt

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

64
-- | Transforms characters into their double-struck variant if available.
65
66
67
68
69
70
71
72
73
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
74
75
76
    | 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
77
toDouble c = c
Nicolas Lenz's avatar
Nicolas Lenz committed
78

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
-- | Transforms double-struck characters back into their normal variant.
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

-- | Transforms characters into sub- and superscript alternatingly.
Nicolas Lenz's avatar
Nicolas Lenz committed
96
97
98
mockSubSuper :: Text -> Text
mockSubSuper txt = T.pack $ zipWith toSubSuper (intersperse True $ repeat False) (T.unpack txt)

99
-- | Transforms a character into a unicode sub- or superscript variant. If true is given and a subscript version is available, that is used. If none is available or false is given, a superscript version is used. If none is available, the character is left unchanged.
Nicolas Lenz's avatar
Nicolas Lenz committed
100
toSubSuper :: Bool -> Char -> Char
101
toSubSuper = curry $ \case
Nicolas Lenz's avatar
Nicolas Lenz committed
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
151
152
153
154
155
156
157
158
159
160
161
162
163
    (_, '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
164

165
-- | Transforms lowercase characters into their unicode small capital variants.
Nicolas Lenz's avatar
Nicolas Lenz committed
166
167
168
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
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

195
-- | Replaces some characters with cyrillic ones *looking* similarly.
Nicolas Lenz's avatar
Nicolas Lenz committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
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

220
221
-- | Replaces all occurences of *lowercase* "g", "ck" and "k" in a string with "cc".
mockCC :: Text -> Text
Nicolas Lenz's avatar
Nicolas Lenz committed
222
mockCC = T.replace "k" "cc" . T.replace "ck" "cc"
Nicolas Lenz's avatar
Nicolas Lenz committed
223

224
-- | Replaces all occurences of "b", "B", "p" and "P" with B button emojis.
Nicolas Lenz's avatar
Nicolas Lenz committed
225
226
mockB :: Text -> Text
mockB = T.replace "b" "🅱️" . T.replace "B" "🅱️"
Nicolas Lenz's avatar
Nicolas Lenz committed
227

228
-- | Makes a square of a string by putting it with spaces in the first line and then all characters except the first in single lines after that first line.
Nicolas Lenz's avatar
Nicolas Lenz committed
229
mockSquare :: Text -> Text
Nicolas Lenz's avatar
Fix #7    
Nicolas Lenz committed
230
mockSquare text = T.concat [T.intersperse ' ' text, "\n", T.intercalate "\n" (T.chunksOf 1 $ T.tail text)]
231

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