module Okapi.HTTP.RFC9651.Lexer (
    ParseError (..),
    Key,
    eParse,
    strip,
    stripLead,
    firstTop,
    splitTop,
    firstAndRest,
    breakKey,
    paramEntries,
    memberEntries,
    parseInnerBare,
) where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Maybe (fromMaybe)
import Data.Word (Word8)

type Key = ByteString

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

eParse :: Either e a -> Either ParseError a
eParse :: forall e a. Either e a -> Either ParseError a
eParse = (e -> Either ParseError a)
-> (a -> Either ParseError a) -> Either e a -> Either ParseError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ParseError a -> e -> Either ParseError a
forall a b. a -> b -> a
const (ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
ParseError)) a -> Either ParseError a
forall a b. b -> Either a b
Right

paramEntries :: ByteString -> [(ByteString, Maybe ByteString)]
paramEntries :: ByteString -> [(ByteString, Maybe ByteString)]
paramEntries = (ByteString -> (ByteString, Maybe ByteString))
-> [ByteString] -> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, Maybe ByteString)
breakKey ([ByteString] -> [(ByteString, Maybe ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
strip ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
splitTop Word8
59

memberEntries :: ByteString -> [(ByteString, Maybe ByteString)]
memberEntries :: ByteString -> [(ByteString, Maybe ByteString)]
memberEntries = (ByteString -> (ByteString, Maybe ByteString))
-> [ByteString] -> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, Maybe ByteString)
breakKey ([ByteString] -> [(ByteString, Maybe ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
strip ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
splitTop Word8
44

breakKey :: ByteString -> (ByteString, Maybe ByteString)
breakKey :: ByteString -> (ByteString, Maybe ByteString)
breakKey ByteString
bs = case Word8 -> ByteString -> Maybe Int
firstTop Word8
61 ByteString
bs of
    Maybe Int
Nothing -> (ByteString -> ByteString
strip ByteString
bs, Maybe ByteString
forall a. Maybe a
Nothing)
    Just Int
i  -> (ByteString -> ByteString
strip (Int -> ByteString -> ByteString
BS.take Int
i ByteString
bs), ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
strip (Int -> ByteString -> ByteString
BS.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs)))

parseInnerBare :: ByteString -> Maybe [ByteString]
parseInnerBare :: ByteString -> Maybe [ByteString]
parseInnerBare ByteString
m = case ByteString -> Maybe (Word8, ByteString)
BS.uncons (ByteString -> ByteString
strip ByteString
m) of
    Just (Word8
40, ByteString
rest) -> case Word8 -> ByteString -> Maybe Int
firstTop Word8
41 ByteString
rest of
        Just Int
i  -> [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
Just ((ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
strip (Word8 -> ByteString -> [ByteString]
splitTop Word8
32 (Int -> ByteString -> ByteString
BS.take Int
i ByteString
rest))))
        Maybe Int
Nothing -> Maybe [ByteString]
forall a. Maybe a
Nothing
    Maybe (Word8, ByteString)
_ -> Maybe [ByteString]
forall a. Maybe a
Nothing

firstTop :: Word8 -> ByteString -> Maybe Int
firstTop :: Word8 -> ByteString -> Maybe Int
firstTop Word8
sep ByteString
bs = Bool -> Int -> Int -> Maybe Int
go Bool
False (Int
0 :: Int) Int
0
  where
    n :: Int
n = ByteString -> Int
BS.length ByteString
bs
    go :: Bool -> Int -> Int -> Maybe Int
go Bool
inQ Int
depth Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Maybe Int
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let w :: Word8
w = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
i
            in if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34 then Bool -> Int -> Int -> Maybe Int
go (Bool -> Bool
not Bool
inQ) Int
depth (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else if Bool
inQ then Bool -> Int -> Int -> Maybe Int
go Bool
inQ Int
depth (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
40 then Bool -> Int -> Int -> Maybe Int
go Bool
inQ (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
41 then Bool -> Int -> Int -> Maybe Int
go Bool
inQ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sep Bool -> Bool -> Bool
&& Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
               else Bool -> Int -> Int -> Maybe Int
go Bool
inQ Int
depth (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

splitTop :: Word8 -> ByteString -> [ByteString]
splitTop :: Word8 -> ByteString -> [ByteString]
splitTop Word8
sep ByteString
bs = case Word8 -> ByteString -> Maybe Int
firstTop Word8
sep ByteString
bs of
    Maybe Int
Nothing -> [ByteString
bs]
    Just Int
i  -> Int -> ByteString -> ByteString
BS.take Int
i ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Word8 -> ByteString -> [ByteString]
splitTop Word8
sep (Int -> ByteString -> ByteString
BS.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs)

firstAndRest :: Word8 -> ByteString -> (ByteString, ByteString)
firstAndRest :: Word8 -> ByteString -> (ByteString, ByteString)
firstAndRest Word8
sep ByteString
bs = case Word8 -> ByteString -> Maybe Int
firstTop Word8
sep ByteString
bs of
    Maybe Int
Nothing -> (ByteString
bs, ByteString
BS.empty)
    Just Int
i  -> (Int -> ByteString -> ByteString
BS.take Int
i ByteString
bs, Int -> ByteString -> ByteString
BS.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs)

strip :: ByteString -> ByteString
strip :: ByteString -> ByteString
strip = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhileEnd Word8 -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSp (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSp
  where isSp :: a -> Bool
isSp a
w = a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
32 Bool -> Bool -> Bool
|| a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
9

stripLead :: ByteString -> ByteString
stripLead :: ByteString -> ByteString
stripLead ByteString
bs = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
bs (ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix ByteString
", " ByteString
bs)