{- | 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 (Get, Linked, Trait (..), TraitAbsence (..), 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
readListPrec :: ReadPrec [ParamNotFound]
$creadListPrec :: ReadPrec [ParamNotFound]
readPrec :: ReadPrec ParamNotFound
$creadPrec :: ReadPrec ParamNotFound
readList :: ReadS [ParamNotFound]
$creadList :: ReadS [ParamNotFound]
readsPrec :: Int -> ReadS ParamNotFound
$creadsPrec :: Int -> ReadS 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
showList :: [ParamNotFound] -> ShowS
$cshowList :: [ParamNotFound] -> ShowS
show :: ParamNotFound -> String
$cshow :: ParamNotFound -> String
showsPrec :: Int -> ParamNotFound -> ShowS
$cshowsPrec :: Int -> ParamNotFound -> ShowS
Show, ParamNotFound -> ParamNotFound -> Bool
(ParamNotFound -> ParamNotFound -> Bool)
-> (ParamNotFound -> ParamNotFound -> Bool) -> Eq ParamNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamNotFound -> ParamNotFound -> Bool
$c/= :: ParamNotFound -> ParamNotFound -> Bool
== :: ParamNotFound -> ParamNotFound -> Bool
$c== :: 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
readListPrec :: ReadPrec [ParamParseError]
$creadListPrec :: ReadPrec [ParamParseError]
readPrec :: ReadPrec ParamParseError
$creadPrec :: ReadPrec ParamParseError
readList :: ReadS [ParamParseError]
$creadList :: ReadS [ParamParseError]
readsPrec :: Int -> ReadS ParamParseError
$creadsPrec :: Int -> ReadS 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
showList :: [ParamParseError] -> ShowS
$cshowList :: [ParamParseError] -> ShowS
show :: ParamParseError -> String
$cshow :: ParamParseError -> String
showsPrec :: Int -> ParamParseError -> ShowS
$cshowsPrec :: Int -> ParamParseError -> ShowS
Show, ParamParseError -> ParamParseError -> Bool
(ParamParseError -> ParamParseError -> Bool)
-> (ParamParseError -> ParamParseError -> Bool)
-> Eq ParamParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamParseError -> ParamParseError -> Bool
$c/= :: ParamParseError -> ParamParseError -> Bool
== :: ParamParseError -> ParamParseError -> Bool
$c== :: ParamParseError -> ParamParseError -> Bool
Eq)

instance Trait (QueryParam Required Strict name val) Request where
  type Attribute (QueryParam Required Strict name val) Request = val

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

instance Trait (QueryParam Optional Strict name val) Request where
  type Attribute (QueryParam Optional Strict name val) Request = Maybe val

instance TraitAbsence (QueryParam Optional Strict name val) Request where
  type Absence (QueryParam Optional Strict name val) Request = ParamParseError

instance Trait (QueryParam Required Lenient name val) Request where
  type Attribute (QueryParam Required Lenient name val) Request = Either Text val

instance TraitAbsence (QueryParam Required Lenient name val) Request where
  type Absence (QueryParam Required Lenient name val) Request = ParamNotFound

instance Trait (QueryParam Optional Lenient name val) Request where
  type Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)

instance TraitAbsence (QueryParam Optional Lenient name val) Request where
  type Absence (QueryParam Optional Lenient name val) Request = Void

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

{- | 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 req.
  (Get h (QueryParam Required Strict name val) Request, ArrowChoice h) =>
  h (Linked req Request, Either ParamNotFound ParamParseError) Response ->
  Middleware h req (QueryParam Required Strict name val : req)
queryParam :: h (Linked req Request, Either ParamNotFound ParamParseError)
  Response
-> Middleware h req (QueryParam 'Required 'Strict name val : req)
queryParam = h (Linked req Request, Either ParamNotFound ParamParseError)
  Response
-> Middleware h req (QueryParam 'Required 'Strict name val : req)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (req :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (QueryParam e p name val) Request)
  Response
-> Middleware h req (QueryParam e p name val : req)
queryParamHandler

{- | 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 req.
  (Get h (QueryParam Optional Strict name val) Request, ArrowChoice h) =>
  h (Linked req Request, ParamParseError) Response ->
  Middleware h req (QueryParam Optional Strict name val : req)
optionalQueryParam :: h (Linked req Request, ParamParseError) Response
-> Middleware h req (QueryParam 'Optional 'Strict name val : req)
optionalQueryParam = h (Linked req Request, ParamParseError) Response
-> Middleware h req (QueryParam 'Optional 'Strict name val : req)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (req :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (QueryParam e p name val) Request)
  Response
-> Middleware h req (QueryParam e p name val : req)
queryParamHandler

{- | 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 req.
  (Get h (QueryParam Required Lenient name val) Request, ArrowChoice h) =>
  h (Linked req Request, ParamNotFound) Response ->
  Middleware h req (QueryParam Required Lenient name val : req)
lenientQueryParam :: h (Linked req Request, ParamNotFound) Response
-> Middleware h req (QueryParam 'Required 'Lenient name val : req)
lenientQueryParam = h (Linked req Request, ParamNotFound) Response
-> Middleware h req (QueryParam 'Required 'Lenient name val : req)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (req :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (QueryParam e p name val) Request)
  Response
-> Middleware h req (QueryParam e p name val : req)
queryParamHandler

{- | 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 req.
  (Get h (QueryParam Optional Lenient name val) Request, ArrowChoice h) =>
  Middleware h req (QueryParam Optional Lenient name val : req)
optionalLenientQueryParam :: Middleware h req (QueryParam 'Optional 'Lenient name val : req)
optionalLenientQueryParam = h (Linked req Request,
   Absence (QueryParam 'Optional 'Lenient name val) Request)
  Response
-> Middleware h req (QueryParam 'Optional 'Lenient name val : req)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
       (h :: * -> * -> *) (req :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (QueryParam e p name val) Request)
  Response
-> Middleware h req (QueryParam e p name val : req)
queryParamHandler (h (Linked req Request,
    Absence (QueryParam 'Optional 'Lenient name val) Request)
   Response
 -> Middleware h req (QueryParam 'Optional 'Lenient name val : req))
-> h (Linked req Request,
      Absence (QueryParam 'Optional 'Lenient name val) Request)
     Response
-> Middleware h req (QueryParam 'Optional 'Lenient name val : req)
forall a b. (a -> b) -> a -> b
$ ((Linked req Request, Void) -> Response)
-> h (Linked req Request, Void) Response
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Void -> Response
forall a. Void -> a
absurd (Void -> Response)
-> ((Linked req Request, Void) -> Void)
-> (Linked req Request, Void)
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Linked req Request, Void) -> Void
forall a b. (a, b) -> b
snd)