module Data.Gibberish.Utils
( numeralConversions,
symbolConversions,
update1,
updateR,
findIndices,
textTraverse,
toQwertyKey,
qwertyKeys,
) where
import Control.Monad.Random (MonadRandom (), fromList)
import Data.Map (Map ())
import Data.Map qualified as Map
import Data.Ratio (denominator, numerator)
import Data.Text (Text ())
import Data.Text qualified as Text
numeralConversions :: Map Char [Char]
numeralConversions :: Map Char [Char]
numeralConversions =
[(Char, [Char])] -> Map Char [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Char
'o', [Char
'0']),
(Char
'l', [Char
'1']),
(Char
'z', [Char
'2']),
(Char
'e', [Char
'3']),
(Char
'a', [Char
'4']),
(Char
's', [Char
'5']),
(Char
'g', [Char
'6', Char
'9']),
(Char
't', [Char
'7']),
(Char
'b', [Char
'8'])
]
symbolConversions :: Map Char [Char]
symbolConversions :: Map Char [Char]
symbolConversions =
[(Char, [Char])] -> Map Char [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Char
'a', [Char
'@']),
(Char
'l', [Char
'!']),
(Char
's', [Char
'$'])
]
update1 :: Monad m => (Char -> m Char) -> Text -> Int -> m Text
update1 :: forall (m :: * -> *).
Monad m =>
(Char -> m Char) -> Text -> Int -> m Text
update1 Char -> m Char
f Text
t Int
pos =
case Int -> Text -> (Text, Text)
Text.splitAt Int
pos Text
t of
(Text
prefix, Text
suffix) ->
case Text -> Maybe (Char, Text)
Text.uncons Text
suffix of
Maybe (Char, Text)
Nothing -> Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
Just (Char
ch, Text
suffix') -> do
Char
ch' <- Char -> m Char
f Char
ch
Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
prefix Text -> Text -> Text
`Text.append` (Char
ch' Char -> Text -> Text
`Text.cons` Text
suffix')
updateR :: MonadRandom m => (Char -> m Char) -> Rational -> Text -> m Text
updateR :: forall (m :: * -> *).
MonadRandom m =>
(Char -> m Char) -> Rational -> Text -> m Text
updateR Char -> m Char
f Rational
prob = (Char -> m Char) -> Text -> m Text
forall (m :: * -> *). Monad m => (Char -> m Char) -> Text -> m Text
textTraverse Char -> m Char
updateR'
where
updateR' :: Char -> m Char
updateR' Char
ch = do
Char
ch' <- Char -> m Char
f Char
ch
[(Char, Rational)] -> m Char
forall (m :: * -> *) a. MonadRandom m => [(a, Rational)] -> m a
fromList
[ (Char
ch, Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Integer -> Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
denominator Rational
prob),
(Char
ch', Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Integer -> Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
prob)
]
findIndices :: (Char -> Bool) -> Text -> [Int]
findIndices :: (Char -> Bool) -> Text -> [Int]
findIndices Char -> Bool
p = Int -> Text -> [Int]
loop Int
0
where
loop :: Int -> Text -> [Int]
loop !Int
n !Text
qs = case (Char -> Bool) -> Text -> Maybe Int
Text.findIndex Char -> Bool
p Text
qs of
Just !Int
i ->
let !j :: Int
j = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
in Int
j Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Text -> [Int]
loop (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Text -> Text
Text.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
qs)
Maybe Int
Nothing -> []
{-# INLINE [1] findIndices #-}
textTraverse :: Monad m => (Char -> m Char) -> Text -> m Text
textTraverse :: forall (m :: * -> *). Monad m => (Char -> m Char) -> Text -> m Text
textTraverse Char -> m Char
f = (Char -> m Text -> m Text) -> m Text -> Text -> m Text
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> m Text -> m Text
folder (Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
Text.empty)
where
folder :: Char -> m Text -> m Text
folder Char
c m Text
accum = do
Text
accum' <- m Text
accum
Char
c' <- Char -> m Char
f Char
c
Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Text.cons Char
c' Text
accum'
toQwertyKey :: Char -> Char
toQwertyKey :: Char -> Char
toQwertyKey Char
'à' = Char
'a'
toQwertyKey Char
'á' = Char
'a'
toQwertyKey Char
'â' = Char
'a'
toQwertyKey Char
'ä' = Char
'a'
toQwertyKey Char
'å' = Char
'a'
toQwertyKey Char
'ç' = Char
'c'
toQwertyKey Char
'è' = Char
'e'
toQwertyKey Char
'é' = Char
'e'
toQwertyKey Char
'ê' = Char
'e'
toQwertyKey Char
'ë' = Char
'e'
toQwertyKey Char
'í' = Char
'i'
toQwertyKey Char
'ï' = Char
'i'
toQwertyKey Char
'ñ' = Char
'n'
toQwertyKey Char
'ó' = Char
'o'
toQwertyKey Char
'ô' = Char
'o'
toQwertyKey Char
'ö' = Char
'o'
toQwertyKey Char
'û' = Char
'u'
toQwertyKey Char
'ü' = Char
'u'
toQwertyKey Char
'ú' = Char
'u'
toQwertyKey Char
c = Char
c
qwertyKeys :: [Char]
qwertyKeys :: [Char]
qwertyKeys =
[Char]
"1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:'\"ZXCVBNM<>?"