{-| Module : Network.Wai.RequestSpec.Internal.Combinators Description : Primitive combinators, operating directly on Env Copyright : Alej Cabrera 2015 License : BSD-3 Maintainer : cpp.cabrera@gmail.com Stability : experimental Portability : POSIX -} {-# LANGUAGE OverloadedStrings #-} 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 ---------------------------------------------------------------------- -- Retrieving Input from the Environment -- ---------------------------------------------------------------------- -- | -- Required parameter from the environment and apply a function to it 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) -- | -- Optional parameter from the environment and apply a function to it 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 -- | -- Required header from the environment and apply a function to it header :: (Text -> P a) -> CI Text -> Env -> P a header f s = maybe (missing $ Header s) f . M.lookup s . headers -- | -- Optional header from the environment and apply a function to it 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 ---------------------------------------------------------------------- -- Parse input text and lift into P context -- ---------------------------------------------------------------------- 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