module Network.Wai.RequestSpec.Internal.Combinators (
param,
paramM,
header,
headerM,
int,
bool,
float
) where
import Control.Applicative
import Data.CaseInsensitive
import Data.Text (Text)
import Data.Text.Read
import qualified Data.Map as M
import Network.Wai.RequestSpec.Error
import Network.Wai.RequestSpec.Parser
import Network.Wai.RequestSpec.Internal.Env
param :: (Text -> P a) -> Text -> Env -> P a
param f s = maybe missingParam (present f) . M.lookup s . params
where present f' (Present t) = f' t
present _ _ = missingParam
missingParam = missing (Param s)
paramM :: (Text -> P a) -> Text -> Env -> P (Maybe a)
paramM f s e = maybe (pure Nothing) (there f) $ M.lookup s (params e)
where there :: (Text -> P a) -> ParamValue -> P (Maybe a)
there f' (Present t) = f' t >>= (pure . Just)
there _ _ = pure Nothing
header :: (Text -> P a) -> CI Text -> Env -> P a
header f s = maybe (missing $ Header s) f . M.lookup s . headers
headerM :: (Text -> P a) -> CI Text -> Env -> P (Maybe a)
headerM f s = maybe (pure Nothing) (go f) . M.lookup s . headers
where go f' a' = f' a' >>= pure . Just
read_ :: (a -> c) -> (b -> c) -> (t -> Either a b) -> t -> c
read_ ff sf p = either ff sf . p
int :: (Read a, Integral a) => Text -> P a
int k = read_ malformedInt (pure . fst) decimal k
where malformedInt _ = malformed "expecting integral" k
float :: (Read a, Fractional a) => Text -> P a
float k = read_ malformedFloat (pure . fst) rational k
where malformedFloat _ = malformed "expecting floating point" k
bool :: Text -> P Bool
bool s =
case s of
"true" -> pure True
"false" -> pure False
_ -> malformed "expecting 'true' or 'false'" s