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

-- | A mapping from letters to numbers that look like them
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'])
    ]

-- | A mapping from letters to symbols that look like them
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)
        ]

-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the
-- indices of all elements satisfying the predicate, in ascending order.
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'

-- | Transform a letter-type character to something that's easy to type on a
-- QWERTY keyboard
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

-- | All the characters that are easy to type on a QWERTY keyboard
qwertyKeys :: [Char]
qwertyKeys :: [Char]
qwertyKeys =
  [Char]
"1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:'\"ZXCVBNM<>?"