{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Routing.Purescheme.Core.Query
( singleParameter
, maybeSingleParameter
)
where
import Network.Wai.Routing.Purescheme.Core.Basic
import Network.Wai.Routing.Purescheme.Core.Internal
import Data.ByteString (ByteString)
import qualified Data.Text as T
import Data.String.Interpolate.IsString (i)
import Network.HTTP.Types (badRequest400, statusMessage)
import Network.Wai (queryString)
singleParameter :: FromUri a => ByteString -> (a -> GenericApplication b) -> GenericApplication b
singleParameter :: ByteString -> (a -> GenericApplication b) -> GenericApplication b
singleParameter ByteString
name a -> GenericApplication b
f Request
req =
case ((ByteString, Maybe ByteString) -> Bool)
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
k, Maybe ByteString
_) -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) ([(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)])
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> [(ByteString, Maybe ByteString)]
queryString Request
req of
[(ByteString
_, Just ByteString
value)] -> a -> GenericApplication b
f (ByteString -> a
forall a. FromUri a => ByteString -> a
fromByteString ByteString
value) Request
req
[] -> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection [i|Required query parameter not found: #{name}|]
[(ByteString, Maybe ByteString)]
_ -> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection
[i|Found more than one parameter in query string, required only one: #{name}|]
maybeSingleParameter ::
FromUri a
=> ByteString
-> (Maybe a -> GenericApplication r)
-> GenericApplication r
maybeSingleParameter :: ByteString
-> (Maybe a -> GenericApplication r) -> GenericApplication r
maybeSingleParameter ByteString
name Maybe a -> GenericApplication r
f Request
req =
case ((ByteString, Maybe ByteString) -> Bool)
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
k, Maybe ByteString
_) -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) ([(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)])
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> [(ByteString, Maybe ByteString)]
queryString Request
req of
[(ByteString
_, Just ByteString
value)] -> Maybe a -> GenericApplication r
f (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. FromUri a => ByteString -> a
fromByteString ByteString
value) Request
req
[] -> Maybe a -> GenericApplication r
f Maybe a
forall a. Maybe a
Nothing Request
req
[(ByteString, Maybe ByteString)]
_ ->
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection
[i|Found more than one parameter in query string, required none or only one: #{name}|]
invalidParameterRejection :: T.Text -> Rejection
invalidParameterRejection :: Text -> Rejection
invalidParameterRejection Text
errorMessage =
Rejection :: Text -> Int -> Status -> ResponseHeaders -> Rejection
Rejection
{ status :: Status
status = Status
badRequest400
, message :: Text
message = [i|#{statusMessage badRequest400}: #{errorMessage}|]
, priority :: Int
priority = Int
200
, headers :: ResponseHeaders
headers = []
}