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

module Mock (styles, mockAlternate, mockRandom, letterspace, toDouble) 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

12

Nicolas Lenz's avatar
Nicolas Lenz committed
13
-- |List of possible mock style names and their functions.
Nicolas Lenz's avatar
Nicolas Lenz committed
14
styles :: [(Text, Text -> Text)]
Nicolas Lenz's avatar
Nicolas Lenz committed
15
16
styles = [
    ("random", mockRandom),
17
    ("alternate", mockAlternate),
18
    ("strike", strikethrough),
19
20
21
    ("space", letterspace 1),
    ("space2", letterspace 2),
    ("space3", letterspace 3),
22
    ("lines", T.intersperse '\n'),
23
24
    ("upper", T.toUpper),
    ("lower", T.toLower),
Nicolas Lenz's avatar
Nicolas Lenz committed
25
    ("double", T.map toDouble),
Nicolas Lenz's avatar
Nicolas Lenz committed
26
    ("dedouble", T.map fromDouble),
Nicolas Lenz's avatar
Nicolas Lenz committed
27
    ("smallcaps", T.map toSmallCap),
Nicolas Lenz's avatar
Nicolas Lenz committed
28
    ("cc", mockCC),
Nicolas Lenz's avatar
Nicolas Lenz committed
29
    ("b", mockB),
30
    ("square", mockSquare)]
Nicolas Lenz's avatar
Nicolas Lenz committed
31

Nicolas Lenz's avatar
Nicolas Lenz committed
32
-- |Transforms a String into uppercase where the corresponding list is True. For False the String isn't changed.
33
34
35
36
37
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
38

Nicolas Lenz's avatar
Nicolas Lenz committed
39
-- |Transforms every other of the Chars of a String into uppercase. The other Chars aren't changed.
40
41
mockAlternate :: T.Text -> T.Text
mockAlternate = toUpperBy $ intersperse True $ repeat False
Nicolas Lenz's avatar
Nicolas Lenz committed
42

43
-- |Tansforms random (that is, random per input String) Chars of a String into uppercase.
44
45
mockRandom :: T.Text -> T.Text
mockRandom txt = toUpperBy (randoms $ mkStdGen (hash txt)) txt
46

Nicolas Lenz's avatar
Nicolas Lenz committed
47
-- |Letterspaces a String with the given number of blanks between the Chars.
48
49
letterspace :: Int -> T.Text -> T.Text
letterspace n = T.pack . intercalate (replicate n ' ') . map (\c -> [c]) . T.unpack
Nicolas Lenz's avatar
Nicolas Lenz committed
50

51
-- |Transforms a character into its double-struck variant (if it is alphanumeric, else it is left unchanged).
52
53
54
55
56
57
58
59
60
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
61
62
63
    | 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
64
toDouble c = c
Nicolas Lenz's avatar
Nicolas Lenz committed
65

66
-- |Transforms a double-struck letter into its normal variant. If it isn't double-struck, it is left unchanged.
Nicolas Lenz's avatar
Nicolas Lenz committed
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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

Nicolas Lenz's avatar
Nicolas Lenz committed
82
83
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
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
111
112
113
-- |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
114
115
116
117

-- |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
118
119
120

-- |Makes a square from a string.
mockSquare :: Text -> Text
Nicolas Lenz's avatar
Fix #7    
Nicolas Lenz committed
121
mockSquare text = T.concat [T.intersperse ' ' text, "\n", T.intercalate "\n" (T.chunksOf 1 $ T.tail text)]
122
123
124
125
126
127

-- |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"