GReAt HAsKeLL tOOl to traNSFoRm TExt
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Mock.hs 3.8KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. {-# LANGUAGE OverloadedStrings, LambdaCase #-}
  2. module Mock (styles, mockAlternate, mockRandom, letterspace, toDouble) where
  3. import qualified Data.Text as T
  4. import Data.Text (Text)
  5. import Data.Char
  6. import Data.List
  7. import Data.Hashable
  8. import System.Random
  9. -- |List of possible mock style names and their functions.
  10. styles :: [(Text, Text -> Text)]
  11. styles = [
  12. ("random", mockRandom),
  13. ("alternate", mockAlternate),
  14. ("strike", strikethrough),
  15. ("space", letterspace 1),
  16. ("space2", letterspace 2),
  17. ("space3", letterspace 3),
  18. ("lines", T.intersperse '\n'),
  19. ("upper", T.toUpper),
  20. ("lower", T.toLower),
  21. ("double", T.map toDouble),
  22. ("dedouble", T.map fromDouble),
  23. ("smallcaps", T.map toSmallCap),
  24. ("cc", mockCC),
  25. ("b", mockB),
  26. ("square", mockSquare)]
  27. -- |Transforms a String into uppercase where the corresponding list is True. For False the String isn't changed.
  28. toUpperBy :: [Bool] -> T.Text -> T.Text
  29. toUpperBy bs = T.pack . zipWith f bs . T.unpack where
  30. f :: Bool -> Char -> Char
  31. f True c = toUpper c
  32. f False c = c
  33. -- |Transforms every other of the Chars of a String into uppercase. The other Chars aren't changed.
  34. mockAlternate :: T.Text -> T.Text
  35. mockAlternate = toUpperBy $ intersperse True $ repeat False
  36. -- |Tansforms random (that is, random per input String) Chars of a String into uppercase.
  37. mockRandom :: T.Text -> T.Text
  38. mockRandom txt = toUpperBy (randoms $ mkStdGen (hash txt)) txt
  39. -- |Letterspaces a String with the given number of blanks between the Chars.
  40. letterspace :: Int -> T.Text -> T.Text
  41. letterspace n = T.pack . intercalate (replicate n ' ') . map (\c -> [c]) . T.unpack
  42. -- |Transforms a character into its double-struck variant (if it is alphanumeric, else it is left unchanged).
  43. toDouble :: Char -> Char
  44. toDouble 'C' = chr 8450
  45. toDouble 'H' = chr 8461
  46. toDouble 'N' = chr 8469
  47. toDouble 'P' = chr 8473
  48. toDouble 'Q' = chr 8474
  49. toDouble 'R' = chr 8477
  50. toDouble 'Z' = chr 8484
  51. toDouble c
  52. | 48 <= ord c && ord c <= 57 = chr $ ord c - 48 + 120792 -- Number
  53. | 65 <= ord c && ord c <= 90 = chr $ ord c - 65 + 120120 -- Uppercase letter
  54. | 97 <= ord c && ord c <= 122 = chr $ ord c - 97 + 120146 -- Lowercase letter
  55. toDouble c = c
  56. fromDouble :: Char -> Char
  57. fromDouble c = case ord c of
  58. 8450 -> 'C'
  59. 8461 -> 'H'
  60. 8469 -> 'N'
  61. 8473 -> 'P'
  62. 8474 -> 'Q'
  63. 8477 -> 'R'
  64. 8484 -> 'Z'
  65. code
  66. | 120792 <= code && code <= 120801 -> chr $ code - 120792 + 48
  67. | 120120 <= code && code <= 120145 -> chr $ code - 120120 + 65
  68. | 120146 <= code && code <= 120171 -> chr $ code - 120146 + 97
  69. code -> chr code
  70. toSmallCap :: Char -> Char
  71. toSmallCap = \case
  72. 'a' -> chr 7424
  73. 'b' -> chr 665
  74. 'c' -> chr 7428
  75. 'd' -> chr 7429
  76. 'e' -> chr 7431
  77. 'f' -> chr 42800
  78. 'g' -> chr 610
  79. 'h' -> chr 668
  80. 'i' -> chr 618
  81. 'j' -> chr 7434
  82. 'k' -> chr 7435
  83. 'l' -> chr 671
  84. 'm' -> chr 7437
  85. 'n' -> chr 628
  86. 'o' -> chr 7439
  87. 'p' -> chr 7448
  88. 'q' -> chr 491
  89. 'r' -> chr 640
  90. 's' -> chr 42801
  91. 't' -> chr 7451
  92. 'u' -> chr 7452
  93. 'v' -> chr 7456
  94. 'w' -> chr 7457
  95. 'y' -> chr 655
  96. 'z' -> chr 7458
  97. c -> c
  98. -- |Replaces all occurences of lowercase "ck" and "k" in a string with "cc"s.
  99. mockCC :: T.Text -> T.Text
  100. mockCC = T.replace "k" "cc" . T.replace "ck" "cc"
  101. -- |Repaclaces all occurences of "b" and "B" with B button emojis.
  102. mockB :: Text -> Text
  103. mockB = T.replace "b" "🅱️" . T.replace "B" "🅱️"
  104. -- |Makes a square from a string.
  105. mockSquare :: Text -> Text
  106. mockSquare text = T.concat [T.intersperse ' ' text, "\n", T.intercalate "\n" (T.chunksOf 1 $ T.tail text)]
  107. -- |Uses Unicode U+0336 to let a text look struck through.
  108. strikethrough :: Text -> Text
  109. strikethrough text
  110. | text == T.empty = T.empty
  111. | otherwise = T.intersperse '\822' text `T.append` "\822"