{-|
Module      : Network.Wai.RequestSpec.Internal.Combinators
Description : Primitive combinators, operating directly on Env
Copyright   : Allele Dev 2015
License     : BSD-3
Maintainer  : allele.dev@gmail.com
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.Wai.RequestSpec.Internal.Combinators (
  header,
  headerM,
  qParam,
  qParamM,
  fParam,
  fParamM,

  int,
  bool,
  float
) where

import Prelude hiding (lookup)

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

import Data.CaseInsensitive
import Data.Text (Text)
import Data.Text.Read

import Network.Wai.RequestSpec.Error
import Network.Wai.RequestSpec.Parser
import Network.Wai.RequestSpec.Internal.Env
import Network.Wai.RequestSpec.Internal.Env.Types
import qualified Network.Wai.RequestSpec.Internal.Combinators.Params as Internal

----------------------------------------------------------------------
             -- Retrieving Input from the Environment --
----------------------------------------------------------------------

-- |
-- Required header, apply a function to it
header :: (Text -> P a) -> CI Text -> Env -> P a
header f s = maybe (missing $ Header s) f . lookup s . headers

-- |
-- Optional header, apply a function to it
headerM :: (Text -> P a) -> CI Text -> Env -> P (Maybe a)
headerM f s = maybe (pure Nothing) (go f) . lookup s . headers
  where go f' a' = f' a' >>= pure . Just

-- |
-- Required query parameter, apply a function to it
qParam :: (Text -> P a) -> Text -> Env -> P a
qParam = Internal.qParam qParams

-- |
-- Optional query parameter, apply a function to it
qParamM :: (Text -> P a) -> Text -> Env -> P (Maybe a)
qParamM = Internal.qParamM qParams

-- |
-- Required form parameter, apply a function to it
fParam :: (Text -> P a) -> Text -> Env -> P a
fParam = Internal.fParam fParams

-- |
-- Optional form parameter, apply a function to it
fParamM :: (Text -> P a) -> Text -> Env -> P (Maybe a)
fParamM = Internal.fParamM fParams

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