module Data.BAByNF.Util.Ascii
    ( lowerAlphaFirst
    , lowerAlphaLast
    , upperAlphaFirst
    , upperAlphaLast
    , rangedCompare
    , AlphaClass (..)
    , classifyAlpha
    , lowerToUpperUnsafe
    , lowerToUpper
    , eqNoCase
    , eqNoCaseSeq
    , eqNoCaseBS
    , fromChar
    , fromCharOrNull
    , bs
    , parseHex
    , toHexDigit
    , bsToHexDigit
    , toHexSeq
    , toDecimalDigit
    , bsToDecimalDigit
    , toBinaryDigit
    , bsToBinaryDigit
    , stringAsBytesUnsafe
    , parseCaseInsensitive
    , parseCaseSensitive
    ) where

import Data.Functor ((<&>))
import Data.Char qualified as Char
import Data.Maybe qualified as Maybe
import Data.Word (Word8)
import Data.List qualified as List

import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.ByteString.Char8 qualified as ByteString.Char8

import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString

import Data.BAByNF.Util.Binary qualified as Binary
import Data.BAByNF.Util.Decimal qualified as Decimal
import Data.BAByNF.Util.Hex qualified as Hex
import Control.Applicative ((<|>))

lowerAlphaFirst :: Word8
lowerAlphaFirst :: Word8
lowerAlphaFirst = Word8
97

lowerAlphaLast :: Word8
lowerAlphaLast :: Word8
lowerAlphaLast = Word8
122

upperAlphaFirst :: Word8
upperAlphaFirst :: Word8
upperAlphaFirst = Word8
65

upperAlphaLast :: Word8
upperAlphaLast :: Word8
upperAlphaLast = Word8
90


rangedCompare :: Ord a =>  a -> a -> a -> Ordering
rangedCompare :: forall a. Ord a => a -> a -> a -> Ordering
rangedCompare a
lo a
hi a
x
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lo = Ordering
LT
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
hi = Ordering
GT
  | Bool
otherwise = Ordering
EQ

data AlphaClass = UpperAlpha | LowerAlpha deriving (AlphaClass -> AlphaClass -> Bool
(AlphaClass -> AlphaClass -> Bool)
-> (AlphaClass -> AlphaClass -> Bool) -> Eq AlphaClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlphaClass -> AlphaClass -> Bool
== :: AlphaClass -> AlphaClass -> Bool
$c/= :: AlphaClass -> AlphaClass -> Bool
/= :: AlphaClass -> AlphaClass -> Bool
Eq, Int -> AlphaClass -> ShowS
[AlphaClass] -> ShowS
AlphaClass -> String
(Int -> AlphaClass -> ShowS)
-> (AlphaClass -> String)
-> ([AlphaClass] -> ShowS)
-> Show AlphaClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlphaClass -> ShowS
showsPrec :: Int -> AlphaClass -> ShowS
$cshow :: AlphaClass -> String
show :: AlphaClass -> String
$cshowList :: [AlphaClass] -> ShowS
showList :: [AlphaClass] -> ShowS
Show)

classifyAlpha :: Word8 -> Maybe AlphaClass
classifyAlpha :: Word8 -> Maybe AlphaClass
classifyAlpha Word8
a = case Word8 -> Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> a -> Ordering
rangedCompare Word8
upperAlphaFirst Word8
upperAlphaLast Word8
a of
    Ordering
LT -> Maybe AlphaClass
forall a. Maybe a
Nothing
    Ordering
EQ -> AlphaClass -> Maybe AlphaClass
forall a. a -> Maybe a
Just AlphaClass
UpperAlpha
    Ordering
GT -> case Word8 -> Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> a -> Ordering
rangedCompare Word8
lowerAlphaFirst Word8
lowerAlphaLast Word8
a of
        Ordering
EQ -> AlphaClass -> Maybe AlphaClass
forall a. a -> Maybe a
Just AlphaClass
LowerAlpha
        Ordering
_ -> Maybe AlphaClass
forall a. Maybe a
Nothing

lowerToUpperUnsafe :: Word8 -> Word8
lowerToUpperUnsafe :: Word8 -> Word8
lowerToUpperUnsafe Word8
a = Word8
a Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
lowerUpperDiff
    where lowerUpperDiff :: Word8
lowerUpperDiff = Word8
lowerAlphaFirst Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
upperAlphaFirst

lowerToUpper :: Word8 -> Maybe Word8
lowerToUpper :: Word8 -> Maybe Word8
lowerToUpper Word8
a = do
    AlphaClass
alphaClass <- Word8 -> Maybe AlphaClass
classifyAlpha Word8
a
    if AlphaClass
alphaClass AlphaClass -> AlphaClass -> Bool
forall a. Eq a => a -> a -> Bool
== AlphaClass
LowerAlpha
        then Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Word8
lowerToUpperUnsafe Word8
a)
        else Maybe Word8
forall a. Maybe a
Nothing

eqNoCase :: Word8 -> Word8 -> Bool
eqNoCase :: Word8 -> Word8 -> Bool
eqNoCase Word8
a Word8
b =
    case Word8 -> Maybe AlphaClass
classifyAlpha Word8
a of
        Maybe AlphaClass
Nothing -> Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b
        Just AlphaClass
ac -> case Word8 -> Maybe AlphaClass
classifyAlpha Word8
b of
           Maybe AlphaClass
Nothing -> Bool
False
           Just AlphaClass
bc -> if AlphaClass
bc AlphaClass -> AlphaClass -> Bool
forall a. Eq a => a -> a -> Bool
== AlphaClass
ac
               then Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b
               else if AlphaClass
ac AlphaClass -> AlphaClass -> Bool
forall a. Eq a => a -> a -> Bool
== AlphaClass
UpperAlpha
                   then Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Word8
lowerToUpperUnsafe Word8
b
                   else Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Word8
lowerToUpperUnsafe Word8
a

eqNoCaseSeq :: [Word8] -> [Word8] -> Bool
eqNoCaseSeq :: [Word8] -> [Word8] -> Bool
eqNoCaseSeq [] [] = Bool
True
eqNoCaseSeq [Word8]
_ [] = Bool
False
eqNoCaseSeq [] [Word8]
_ = Bool
False
eqNoCaseSeq (Word8
x:[Word8]
xs) (Word8
y:[Word8]
ys) = Word8 -> Word8 -> Bool
eqNoCase Word8
x Word8
y Bool -> Bool -> Bool
&& [Word8] -> [Word8] -> Bool
eqNoCaseSeq [Word8]
xs [Word8]
ys

eqNoCaseBS :: ByteString -> ByteString -> Bool
eqNoCaseBS :: ByteString -> ByteString -> Bool
eqNoCaseBS ByteString
a ByteString
b = ByteString -> Int
ByteString.length ByteString
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
ByteString.length ByteString
b Bool -> Bool -> Bool
&& ((Word8, Word8) -> Bool) -> [(Word8, Word8)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8, Word8) -> Bool
eq' [(Word8, Word8)]
pairs
    where eq' :: (Word8, Word8) -> Bool
eq' = (Word8 -> Word8 -> Bool) -> (Word8, Word8) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> Word8 -> Bool
eqNoCase
          pairs :: [(Word8, Word8)]
pairs = ByteString -> ByteString -> [(Word8, Word8)]
ByteString.zip ByteString
a ByteString
b

fromChar :: Char -> Maybe Word8
fromChar :: Char -> Maybe Word8
fromChar Char
ch =
    if Char -> Bool
Char.isAscii Char
ch
        then Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.ord Char
ch))
        else Maybe Word8
forall a. Maybe a
Nothing

fromCharOrNull :: Char -> Word8
fromCharOrNull :: Char -> Word8
fromCharOrNull Char
ch = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
Maybe.fromMaybe Word8
0 (Char -> Maybe Word8
fromChar Char
ch)

bs :: Char -> ByteString
bs :: Char -> ByteString
bs Char
ch = Word8 -> ByteString
ByteString.singleton (Char -> Word8
fromCharOrNull Char
ch)

parseHex :: (Integral a) => ByteString -> Maybe a
parseHex :: forall a. Integral a => ByteString -> Maybe a
parseHex ByteString
s = ([Digit] -> a) -> Maybe [Digit] -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq -> a
forall a. Integral a => Seq -> a
Hex.toNum (Seq -> a) -> ([Digit] -> Seq) -> [Digit] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Digit] -> Seq
Hex.Seq) ((Word8 -> Maybe Digit) -> [Word8] -> Maybe [Digit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Word8 -> Maybe Digit
toHexDigit (ByteString -> [Word8]
ByteString.unpack ByteString
s))

toHexDigit :: Word8 -> Maybe Hex.Digit
toHexDigit :: Word8 -> Maybe Digit
toHexDigit Word8
w
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = Word8 -> Maybe Digit
forall a. Integral a => a -> Maybe Digit
Hex.fromVal (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
102 = Word8 -> Maybe Digit
forall a. Integral a => a -> Maybe Digit
Hex.fromVal (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10)
    |  Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
70 = Word8 -> Maybe Digit
forall a. Integral a => a -> Maybe Digit
Hex.fromVal (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10)
    | Bool
otherwise = Maybe Digit
forall a. Maybe a
Nothing

bsToHexDigit :: ByteString -> Maybe Hex.Digit
bsToHexDigit :: ByteString -> Maybe Digit
bsToHexDigit ByteString
b =
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
b of
        Just (Word8
w, ByteString
t) | ByteString -> Bool
ByteString.null ByteString
t -> Word8 -> Maybe Digit
toHexDigit Word8
w
                    | Bool
otherwise -> Maybe Digit
forall a. Maybe a
Nothing
        Maybe (Word8, ByteString)
_ -> Maybe Digit
forall a. Maybe a
Nothing
toHexSeq :: ByteString -> Maybe Hex.Seq
toHexSeq :: ByteString -> Maybe Seq
toHexSeq ByteString
b = ByteString -> Maybe [Digit]
toHexDigs ByteString
b Maybe [Digit] -> ([Digit] -> Seq) -> Maybe Seq
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Digit] -> Seq
Hex.Seq
    where toHexDigs :: ByteString -> Maybe [Digit]
toHexDigs ByteString
x = ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
x Maybe (Word8, ByteString)
-> ((Word8, ByteString) -> Maybe [Digit]) -> Maybe [Digit]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            \(Word8
h, ByteString
rest) ->  Word8 -> Maybe Digit
toHexDigit Word8
h Maybe Digit -> (Digit -> Maybe [Digit]) -> Maybe [Digit]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            \Digit
hexdig -> if ByteString -> Bool
ByteString.null ByteString
rest
                then [Digit] -> Maybe [Digit]
forall a. a -> Maybe a
Just [Digit
hexdig]
                else ByteString -> Maybe [Digit]
toHexDigs ByteString
rest Maybe [Digit] -> ([Digit] -> Maybe [Digit]) -> Maybe [Digit]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Digit]
hexdigs -> [Digit] -> Maybe [Digit]
forall a. a -> Maybe a
Just (Digit
hexdigDigit -> [Digit] -> [Digit]
forall a. a -> [a] -> [a]
:[Digit]
hexdigs)

toDecimalDigit :: Word8 -> Maybe Decimal.Digit
toDecimalDigit :: Word8 -> Maybe Digit
toDecimalDigit Word8
w
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = Word8 -> Maybe Digit
forall a. Integral a => a -> Maybe Digit
Decimal.fromVal (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
    | Bool
otherwise = Maybe Digit
forall a. Maybe a
Nothing

bsToDecimalDigit :: ByteString -> Maybe Decimal.Digit
bsToDecimalDigit :: ByteString -> Maybe Digit
bsToDecimalDigit ByteString
b =
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
b of
        Just (Word8
w, ByteString
t) | ByteString -> Bool
ByteString.null ByteString
t -> Word8 -> Maybe Digit
toDecimalDigit Word8
w
                    | Bool
otherwise -> Maybe Digit
forall a. Maybe a
Nothing
        Maybe (Word8, ByteString)
_ -> Maybe Digit
forall a. Maybe a
Nothing

toBinaryDigit :: Word8 -> Maybe Binary.Digit
toBinaryDigit :: Word8 -> Maybe Digit
toBinaryDigit Word8
w
    | Word8
w Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
48, Word8
49] = Word8 -> Maybe Digit
forall a. Integral a => a -> Maybe Digit
Binary.fromVal (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
    | Bool
otherwise = Maybe Digit
forall a. Maybe a
Nothing

bsToBinaryDigit :: ByteString -> Maybe Binary.Digit
bsToBinaryDigit :: ByteString -> Maybe Digit
bsToBinaryDigit ByteString
b =
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
b of
        Just (Word8
w, ByteString
t) | ByteString -> Bool
ByteString.null ByteString
t -> Word8 -> Maybe Digit
toBinaryDigit Word8
w
                    | Bool
otherwise -> Maybe Digit
forall a. Maybe a
Nothing
        Maybe (Word8, ByteString)
_ -> Maybe Digit
forall a. Maybe a
Nothing

stringAsBytesUnsafe :: String -> ByteString
stringAsBytesUnsafe :: String -> ByteString
stringAsBytesUnsafe String
s =
    case (Char -> Bool) -> String -> Maybe Char
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isAscii) String
s of
        Just Char
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"string contains non-ascii characters"
        Maybe Char
Nothing -> String -> ByteString
ByteString.Char8.pack String
s

parseCaseInsensitive :: ByteString -> Attoparsec.ByteString.Parser ByteString
parseCaseInsensitive :: ByteString -> Parser ByteString
parseCaseInsensitive ByteString
b = Int -> Parser ByteString
Attoparsec.ByteString.take (ByteString -> Int
ByteString.length ByteString
b)
    Parser ByteString
-> (ByteString -> Parser ByteString) -> Parser ByteString
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
b' -> if ByteString
b ByteString -> ByteString -> Bool
`eqNoCaseBS` ByteString
b' then ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b' else String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"case insensitive match fail"

parseCaseSensitive :: ByteString -> Attoparsec.ByteString.Parser ByteString
parseCaseSensitive :: ByteString -> Parser ByteString
parseCaseSensitive ByteString
b = ByteString -> Parser ByteString
Attoparsec.ByteString.string ByteString
b Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"case sensitive match fail"