{-|
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