module Web.Sqids.Utils.Internal
  ( letterCount
  , charSet
  , swapChars
  , replaceCharAtIndex
  , wordsNoLongerThan
  , unsafeIndex
  , unsafeUncons
  , containsMultibyteChars
  ) where

import Data.Maybe (fromJust)
import Data.Set (Set)
import Data.Text (Text)

import qualified Data.Text as Text
import qualified Data.Set as Set
import qualified Data.Text.Encoding as TextEncoding
import qualified Data.ByteString as ByteString

{-# INLINE letterCount #-}
letterCount :: Text -> Int
letterCount :: Text -> Int
letterCount = Set Char -> Int
forall a. Set a -> Int
Set.size (Set Char -> Int) -> (Text -> Set Char) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Set Char
charSet

{-# INLINE charSet #-}
charSet :: Text -> Set Char
charSet :: Text -> Set Char
charSet = (Char -> Set Char -> Set Char) -> Set Char -> Text -> Set Char
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr' Char -> Set Char -> Set Char
forall a. Ord a => a -> Set a -> Set a
Set.insert Set Char
forall a. Monoid a => a
mempty

swapChars :: Int -> Int -> Text -> Text
swapChars :: Int -> Int -> Text -> Text
swapChars Int
m Int
n Text
input =
  Int -> Char -> Text -> Text
replaceCharAtIndex Int
n (Int -> Char
charAt Int
m) (Int -> Char -> Text -> Text
replaceCharAtIndex Int
m (Int -> Char
charAt Int
n) Text
input)
  where
    charAt :: Int -> Char
charAt = HasCallStack => Text -> Int -> Char
Text -> Int -> Char
Text.index Text
input

replaceCharAtIndex :: Int -> Char -> Text -> Text
replaceCharAtIndex :: Int -> Char -> Text -> Text
replaceCharAtIndex Int
n Char
char Text
input = Text
lhs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
Text.cons Char
char Text
rhs
  where
    lhs :: Text
lhs = Int -> Text -> Text
Text.take Int
n Text
input
    rhs :: Text
rhs = Int -> Text -> Text
Text.drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
input

{-# INLINE wordsNoLongerThan #-}
wordsNoLongerThan :: Int -> [Text] -> [Text]
wordsNoLongerThan :: Int -> [Text] -> [Text]
wordsNoLongerThan Int
n = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Bool) -> [Text] -> [Text])
-> (Text -> Bool) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length

{-# INLINE unsafeIndex #-}
unsafeIndex :: Char -> Text -> Int
unsafeIndex :: Char -> Text -> Int
unsafeIndex Char
c = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (Text -> Maybe Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Maybe Int
Text.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

{-# INLINE unsafeUncons #-}
unsafeUncons :: Text -> (Char, Text)
unsafeUncons :: Text -> (Char, Text)
unsafeUncons = Maybe (Char, Text) -> (Char, Text)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Char, Text) -> (Char, Text))
-> (Text -> Maybe (Char, Text)) -> Text -> (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text.uncons

containsMultibyteChars :: Text -> Bool
containsMultibyteChars :: Text -> Bool
containsMultibyteChars Text
input =
  Text -> Int
Text.length Text
input Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int
ByteString.length (Text -> ByteString
TextEncoding.encodeUtf8 Text
input)