{- | Traits and middleware to handle request query parameters.

 The `queryParam` middleware can extract a query parameter value trait
 and invoke another handler. An error handler is invoked if the parameter
 is missing or the parsing fails.

 The `optionalQueryParam` middleware is similar but will not invoke
 the error handling in case the prameter is missing. Instead, the
 trait value will be set to `Nothing` in that case.

 The `lenientQueryParam` middleware requires the parameter to be
 present. But the trait attribute will be set to 'Left' @msg@ if an
 error occurs while parsing it to a Haskell value. Here @msg@ will
 indicate the error in parsing.

 Finally, we have `optionalLenientQueryParam` which combines the
 behaviors of `optionalQueryParam` and `lenientQueryParam`. In this
 case, the parameter extraction never fails. Missing parameters and
 parse errors are indicated in the trait attribute passed to next
 handler.
-}
module WebGear.Core.Trait.QueryParam (
  -- * Traits
  QueryParam (..),
  RequiredQueryParam,
  OptionalQueryParam,
  ParamNotFound (..),
  ParamParseError (..),

  -- * Middlewares
  queryParam,
  optionalQueryParam,
  lenientQueryParam,
  optionalLenientQueryParam,
) where

import Control.Arrow (ArrowChoice, arr)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Void (Void, absurd)
import GHC.TypeLits (Symbol)
import WebGear.Core.Handler (Middleware)
import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Absence, Attribute, Get, Prerequisite, With, probe)

{- | Capture a query parameter with a specified @name@ and convert it to
 a value of type @val@. The type parameter @e@ denotes whether the
 query parameter is required to be present. The parse style parameter
 @p@ determines whether the conversion is applied strictly or
 leniently.
-}
data QueryParam (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = QueryParam

-- | `QueryParam` that is required and parsed strictly
type RequiredQueryParam = QueryParam Required Strict

-- | `QueryParam` that is optional and parsed strictly
type OptionalQueryParam = QueryParam Optional Strict

-- | Indicates a missing query parameter
data ParamNotFound = ParamNotFound
  deriving stock (ReadPrec [ParamNotFound]
ReadPrec ParamNotFound
Int -> ReadS ParamNotFound
ReadS [ParamNotFound]
(Int -> ReadS ParamNotFound)
-> ReadS [ParamNotFound]
-> ReadPrec ParamNotFound
-> ReadPrec [ParamNotFound]
-> Read ParamNotFound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamNotFound
readsPrec :: Int -> ReadS ParamNotFound
$creadList :: ReadS [ParamNotFound]
readList :: ReadS [ParamNotFound]
$creadPrec :: ReadPrec ParamNotFound
readPrec :: ReadPrec ParamNotFound
$creadListPrec :: ReadPrec [ParamNotFound]
readListPrec :: ReadPrec [ParamNotFound]
Read, Int -> ParamNotFound -> ShowS
[ParamNotFound] -> ShowS
ParamNotFound -> String
(Int -> ParamNotFound -> ShowS)
-> (ParamNotFound -> String)
-> ([ParamNotFound] -> ShowS)
-> Show ParamNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamNotFound -> ShowS
showsPrec :: Int -> ParamNotFound -> ShowS
$cshow :: ParamNotFound -> String
show :: ParamNotFound -> String
$cshowList :: [ParamNotFound] -> ShowS
showList :: [ParamNotFound] -> ShowS
Show, ParamNotFound -> ParamNotFound -> Bool
(ParamNotFound -> ParamNotFound -> Bool)
-> (ParamNotFound -> ParamNotFound -> Bool) -> Eq ParamNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamNotFound -> ParamNotFound -> Bool
== :: ParamNotFound -> ParamNotFound -> Bool
$c/= :: ParamNotFound -> ParamNotFound -> Bool
/= :: ParamNotFound -> ParamNotFound -> Bool
Eq)

-- | Error in converting a query parameter
newtype ParamParseError = ParamParseError Text
  deriving stock (ReadPrec [ParamParseError]
ReadPrec ParamParseError
Int -> ReadS ParamParseError
ReadS [ParamParseError]
(Int -> ReadS ParamParseError)
-> ReadS [ParamParseError]
-> ReadPrec ParamParseError
-> ReadPrec [ParamParseError]
-> Read ParamParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamParseError
readsPrec :: Int -> ReadS ParamParseError
$creadList :: ReadS [ParamParseError]
readList :: ReadS [ParamParseError]
$creadPrec :: ReadPrec ParamParseError
readPrec :: ReadPrec ParamParseError
$creadListPrec :: ReadPrec [ParamParseError]
readListPrec :: ReadPrec [ParamParseError]
Read, Int -> ParamParseError -> ShowS
[ParamParseError] -> ShowS
ParamParseError -> String
(Int -> ParamParseError -> ShowS)
-> (ParamParseError -> String)
-> ([ParamParseError] -> ShowS)
-> Show ParamParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamParseError -> ShowS
showsPrec :: Int -> ParamParseError -> ShowS
$cshow :: ParamParseError -> String
show :: ParamParseError -> String
$cshowList :: [ParamParseError] -> ShowS
showList :: [ParamParseError] -> ShowS
Show, ParamParseError -> ParamParseError -> Bool
(ParamParseError -> ParamParseError -> Bool)
-> (ParamParseError -> ParamParseError -> Bool)
-> Eq ParamParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamParseError -> ParamParseError -> Bool
== :: ParamParseError -> ParamParseError -> Bool
$c/= :: ParamParseError -> ParamParseError -> Bool
/= :: ParamParseError -> ParamParseError -> Bool
Eq)

type instance Attribute (QueryParam Required Strict name val) Request = val
type instance Absence (QueryParam Required Strict name val) = Either ParamNotFound ParamParseError

type instance Attribute (QueryParam Optional Strict name val) Request = Maybe val
type instance Absence (QueryParam Optional Strict name val) = ParamParseError

type instance Attribute (QueryParam Required Lenient name val) Request = Either Text val
type instance Absence (QueryParam Required Lenient name val) = ParamNotFound

type instance Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)
type instance Absence (QueryParam Optional Lenient name val) = Void

type instance Prerequisite (QueryParam e p name val) ts = ()

queryParamHandler ::
  forall name val e p h ts.
  (Get h (QueryParam e p name val), ArrowChoice h) =>
  h (Request `With` ts, Absence (QueryParam e p name val)) Response ->
  Middleware h ts (QueryParam e p name val : ts)
queryParamHandler :: forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val), ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val)) Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler h (With Request ts, Absence (QueryParam e p name val)) Response
errorHandler RequestHandler h (QueryParam e p name val : ts)
nextHandler = proc With Request ts
request -> do
  Either
  (Absence (QueryParam e p name val))
  (With Request (QueryParam e p name val : ts))
result <- QueryParam e p name val
-> h (With Request ts)
     (Either
        (Absence (QueryParam e p name val))
        (With Request (QueryParam e p name val : ts)))
forall t (ts :: [*]) (h :: * -> * -> *).
(Get h t, Prerequisite t ts) =>
t
-> h (With Request ts) (Either (Absence t) (With Request (t : ts)))
probe QueryParam e p name val
forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
QueryParam e p name val
QueryParam -< With Request ts
request
  case Either
  (Absence (QueryParam e p name val))
  (With Request (QueryParam e p name val : ts))
result of
    Left Absence (QueryParam e p name val)
err -> h (With Request ts, Absence (QueryParam e p name val)) Response
errorHandler -< (With Request ts
request, Absence (QueryParam e p name val)
err)
    Right With Request (QueryParam e p name val : ts)
val -> RequestHandler h (QueryParam e p name val : ts)
nextHandler -< With Request (QueryParam e p name val : ts)
val
{-# INLINE queryParamHandler #-}

{- | Extract a query parameter and convert it to a value of type
 @val@.

 The associated trait attribute has type @val@.

 Example usage:

 > queryParam @"limit" @Integer errorHandler okHandler
-}
queryParam ::
  forall name val h ts.
  (Get h (QueryParam Required Strict name val), ArrowChoice h) =>
  h (Request `With` ts, Either ParamNotFound ParamParseError) Response ->
  Middleware h ts (QueryParam Required Strict name val : ts)
queryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Required 'Strict name val), ArrowChoice h) =>
h (With Request ts, Either ParamNotFound ParamParseError) Response
-> Middleware h ts (QueryParam 'Required 'Strict name val : ts)
queryParam = h (With Request ts, Either ParamNotFound ParamParseError) Response
-> h (With Request (QueryParam 'Required 'Strict name val : ts))
     Response
-> h (With Request ts) Response
h (With Request ts,
   Absence (QueryParam 'Required 'Strict name val))
  Response
-> h (With Request (QueryParam 'Required 'Strict name val : ts))
     Response
-> h (With Request ts) Response
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val), ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val)) Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE queryParam #-}

{- | Extract an optional query parameter and convert it to a value of
 type @val@.

 The associated trait attribute has type @Maybe val@; a @Nothing@
 value indicates that the parameter is missing from the request.

 Example usage:

 > optionalQueryParam @"limit" @Integer errorHandler okHandler
-}
optionalQueryParam ::
  forall name val h ts.
  (Get h (QueryParam Optional Strict name val), ArrowChoice h) =>
  h (Request `With` ts, ParamParseError) Response ->
  Middleware h ts (QueryParam Optional Strict name val : ts)
optionalQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Optional 'Strict name val), ArrowChoice h) =>
h (With Request ts, ParamParseError) Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
optionalQueryParam = h (With Request ts,
   Absence (QueryParam 'Optional 'Strict name val))
  Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
h (With Request ts, ParamParseError) Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val), ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val)) Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE optionalQueryParam #-}

{- | Extract a query parameter and convert it to a value of type @val@.

 The associated trait attribute has type @Either Text val@. The
 parsing is done leniently and any errors are reported in the trait
 attribute.

 Example usage:

 > lenientQueryParam @"limit" @Integer errorHandler okHandler
-}
lenientQueryParam ::
  forall name val h ts.
  (Get h (QueryParam Required Lenient name val), ArrowChoice h) =>
  h (Request `With` ts, ParamNotFound) Response ->
  Middleware h ts (QueryParam Required Lenient name val : ts)
lenientQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Required 'Lenient name val), ArrowChoice h) =>
h (With Request ts, ParamNotFound) Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
lenientQueryParam = h (With Request ts,
   Absence (QueryParam 'Required 'Lenient name val))
  Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
h (With Request ts, ParamNotFound) Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val), ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val)) Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE lenientQueryParam #-}

{- | Extract a query parameter and convert it to a value of type @val@.

 Example usage:

 > optionalLenientQueryParam @"Content-Length" @Integer handler

 The associated trait attribute has type @Maybe (Either Text
 val)@. The parsing is done leniently. Any parsing errors and
 missing query parameters are reported in the trait attribute.
-}
optionalLenientQueryParam ::
  forall name val h ts.
  (Get h (QueryParam Optional Lenient name val), ArrowChoice h) =>
  Middleware h ts (QueryParam Optional Lenient name val : ts)
optionalLenientQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Optional 'Lenient name val), ArrowChoice h) =>
Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
optionalLenientQueryParam = h (With Request ts,
   Absence (QueryParam 'Optional 'Lenient name val))
  Response
-> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val), ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val)) Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler (h (With Request ts,
    Absence (QueryParam 'Optional 'Lenient name val))
   Response
 -> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts))
-> h (With Request ts,
      Absence (QueryParam 'Optional 'Lenient name val))
     Response
-> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
forall a b. (a -> b) -> a -> b
$ ((With Request ts, Void) -> Response)
-> h (With Request ts, Void) Response
forall b c. (b -> c) -> h b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Void -> Response
forall a. Void -> a
absurd (Void -> Response)
-> ((With Request ts, Void) -> Void)
-> (With Request ts, Void)
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (With Request ts, Void) -> Void
forall a b. (a, b) -> b
snd)
{-# INLINE optionalLenientQueryParam #-}