module Okapi.HTTP.RFC9651.Parameters (
    Parameters,
    parser,
    printer,
    param,
    param',
    param_,
    flag,
    flag',
    raw,
) where

import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.List (find)
import Okapi.Tree (Failure, Leaf (..), Parser, Printer, Context)
import Okapi.Tree qualified as Tree
import Okapi.Tree (Tree (..))
import Okapi.Tree qualified as Tree
import Okapi.HTTP.RFC9651.BareItem (BareItem)
import Okapi.HTTP.RFC9651.Lexer (Key, ParseError (..), paramEntries)

type Parameters :: Type -> Type
data Parameters a where
    Param  :: Key -> Leaf BareItem a -> Parameters a
    Param' :: Key -> Leaf BareItem a -> Parameters (Maybe a)
    Param_ :: Key -> Leaf BareItem a -> a -> Parameters ()
    Flag   :: Key -> Parameters ()
    Flag'  :: Key -> Parameters Bool
    Raw    :: Parameters ByteString

type instance Context Parameters = ByteString
type instance Failure Parameters = ParseError

param :: Key -> Leaf BareItem a -> Tree Parameters a a
param :: forall a. Key -> Leaf BareItem a -> Tree Parameters a a
param Key
k Leaf BareItem a
vLeaf = Parameters a -> Tree Parameters a a
forall (t :: * -> *) i. t i -> Tree t i i
Node (Key -> Leaf BareItem a -> Parameters a
forall a. Key -> Leaf BareItem a -> Parameters a
Param Key
k Leaf BareItem a
vLeaf)

param' :: Key -> Leaf BareItem a -> Tree Parameters (Maybe a) (Maybe a)
param' :: forall a.
Key -> Leaf BareItem a -> Tree Parameters (Maybe a) (Maybe a)
param' Key
k Leaf BareItem a
vLeaf = Parameters (Maybe a) -> Tree Parameters (Maybe a) (Maybe a)
forall (t :: * -> *) i. t i -> Tree t i i
Node (Key -> Leaf BareItem a -> Parameters (Maybe a)
forall a. Key -> Leaf BareItem a -> Parameters (Maybe a)
Param' Key
k Leaf BareItem a
vLeaf)

param_ :: Key -> Leaf BareItem a -> a -> Tree Parameters () ()
param_ :: forall a. Key -> Leaf BareItem a -> a -> Tree Parameters () ()
param_ Key
k Leaf BareItem a
vLeaf a
x = Parameters () -> Tree Parameters () ()
forall (t :: * -> *) i. t i -> Tree t i i
Node (Key -> Leaf BareItem a -> a -> Parameters ()
forall a. Key -> Leaf BareItem a -> a -> Parameters ()
Param_ Key
k Leaf BareItem a
vLeaf a
x)

flag :: Key -> Tree Parameters () ()
flag :: Key -> Tree Parameters () ()
flag = Parameters () -> Tree Parameters () ()
forall (t :: * -> *) i. t i -> Tree t i i
Node (Parameters () -> Tree Parameters () ())
-> (Key -> Parameters ()) -> Key -> Tree Parameters () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Parameters ()
Flag

flag' :: Key -> Tree Parameters Bool Bool
flag' :: Key -> Tree Parameters Bool Bool
flag' = Parameters Bool -> Tree Parameters Bool Bool
forall (t :: * -> *) i. t i -> Tree t i i
Node (Parameters Bool -> Tree Parameters Bool Bool)
-> (Key -> Parameters Bool) -> Key -> Tree Parameters Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Parameters Bool
Flag'

raw :: Tree Parameters ByteString ByteString
raw :: Tree Parameters Key Key
raw = Parameters Key -> Tree Parameters Key Key
forall (t :: * -> *) i. t i -> Tree t i i
Node Parameters Key
Raw

parser :: Tree Parameters i o -> Parser Parameters o
parser :: forall i o. Tree Parameters i o -> Parser Parameters o
parser = (forall a. Parameters a -> Parser Parameters a)
-> Tree Parameters i o
-> Context Parameters
-> (Either (Failure Parameters) o, Context Parameters)
forall (t :: * -> *) i o.
(forall a. t a -> Parser t a) -> Tree t i o -> Parser t o
Tree.parser Parameters a -> Parser Parameters a
forall a. Parameters a -> Parser Parameters a
alg
  where
    alg :: Parameters a -> Parser Parameters a
    alg :: forall a. Parameters a -> Parser Parameters a
alg Parameters a
t Context Parameters
s = case Parameters a
t of
        Param Key
key Leaf BareItem a
vLeaf -> case Key -> Key -> Maybe (Maybe Key)
look Key
Context Parameters
s Key
key of
            Just (Just Key
v) -> (Leaf BareItem a
vLeaf.decode Key
v, Context Parameters
s)
            Maybe (Maybe Key)
_             -> (ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
ParseError, Context Parameters
s)
        Param' Key
key Leaf BareItem a
vLeaf -> case Key -> Key -> Maybe (Maybe Key)
look Key
Context Parameters
s Key
key of
            Just (Just Key
v) -> (a -> Either ParseError a
forall a b. b -> Either a b
Right ((ParseError -> a) -> (a -> a) -> Either ParseError a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> ParseError -> a
forall a b. a -> b -> a
const a
Maybe a
forall a. Maybe a
Nothing) a -> a
a -> Maybe a
forall a. a -> Maybe a
Just (Leaf BareItem a
vLeaf.decode Key
v)), Context Parameters
s)
            Maybe (Maybe Key)
_             -> (a -> Either ParseError a
forall a b. b -> Either a b
Right a
Maybe a
forall a. Maybe a
Nothing, Context Parameters
s)
        Param_ Key
key Leaf BareItem a
vLeaf a
x -> case Key -> Key -> Maybe (Maybe Key)
look Key
Context Parameters
s Key
key of
            Just (Just Key
v) | Key
v Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Leaf BareItem a
vLeaf.encode a
x -> (a -> Either ParseError a
forall a b. b -> Either a b
Right (), Context Parameters
s)
            Maybe (Maybe Key)
_                                   -> (ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
ParseError, Context Parameters
s)
        Flag Key
key -> case Key -> Key -> Maybe (Maybe Key)
look Key
Context Parameters
s Key
key of
            Just Maybe Key
Nothing      -> (a -> Either ParseError a
forall a b. b -> Either a b
Right (), Context Parameters
s)
            Just (Just Key
"?1")  -> (a -> Either ParseError a
forall a b. b -> Either a b
Right (), Context Parameters
s)
            Maybe (Maybe Key)
_                 -> (ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
ParseError, Context Parameters
s)
        Flag' Key
key -> case Key -> Key -> Maybe (Maybe Key)
look Key
Context Parameters
s Key
key of
            Just Maybe Key
Nothing     -> (a -> Either ParseError a
forall a b. b -> Either a b
Right a
Bool
True, Context Parameters
s)
            Just (Just Key
"?1") -> (a -> Either ParseError a
forall a b. b -> Either a b
Right a
Bool
True, Context Parameters
s)
            Maybe (Maybe Key)
_                -> (a -> Either ParseError a
forall a b. b -> Either a b
Right a
Bool
False, Context Parameters
s)
        Parameters a
Raw -> (a -> Either ParseError a
forall a b. b -> Either a b
Right a
Context Parameters
s, Context Parameters
s)
      where
        look :: Key -> Key -> Maybe (Maybe Key)
look Key
bs Key
k = ((Key, Maybe Key) -> Maybe Key)
-> Maybe (Key, Maybe Key) -> Maybe (Maybe Key)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key, Maybe Key) -> Maybe Key
forall a b. (a, b) -> b
snd (((Key, Maybe Key) -> Bool)
-> [(Key, Maybe Key)] -> Maybe (Key, Maybe Key)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k) (Key -> Bool)
-> ((Key, Maybe Key) -> Key) -> (Key, Maybe Key) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Maybe Key) -> Key
forall a b. (a, b) -> a
fst) (Key -> [(Key, Maybe Key)]
paramEntries Key
bs))

printer :: Tree Parameters i o -> Printer Parameters i
printer :: forall i o. Tree Parameters i o -> Printer Parameters i
printer = (forall a. Parameters a -> Printer Parameters a)
-> Tree Parameters i o -> i -> Context Parameters
forall (t :: * -> *) i o.
Monoid (Context t) =>
(forall a. t a -> Printer t a) -> Tree t i o -> Printer t i
Tree.printer Parameters a -> Printer Parameters a
forall a. Parameters a -> Printer Parameters a
alg
  where
    alg :: Parameters a -> Printer Parameters a
    alg :: forall a. Parameters a -> Printer Parameters a
alg (Param Key
key Leaf BareItem a
vLeaf)    a
v        = Key
";" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"=" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Leaf BareItem a
vLeaf.encode a
v
    alg (Param' Key
key Leaf BareItem a
vLeaf)   (Just a
v) = Key
";" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"=" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Leaf BareItem a
vLeaf.encode a
v
    alg (Param' Key
_ Leaf BareItem a
_)         a
Maybe a
Nothing  = Key
Context Parameters
""
    alg (Param_ Key
key Leaf BareItem a
vLeaf a
x) ()       = Key
";" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"=" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Leaf BareItem a
vLeaf.encode a
x
    alg (Flag Key
key)           ()       = Key
";" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key
    alg (Flag' Key
key)          a
Bool
True     = Key
";" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key
    alg (Flag' Key
_)            a
Bool
False    = Key
Context Parameters
""
    alg Parameters a
Raw                  a
bs       = a
Context Parameters
bs