module Rest.Handler
(
mkHandler
, mkInputHandler
, mkConstHandler
, mkIdHandler
, mkListing
, mkOrderedListing
, Range (..)
, range
, orderedRange
, Env (..)
, GenHandler (..)
, mkGenHandler
, Apply
, Handler
, ListHandler
, secureHandler
) where
import Control.Applicative hiding (empty)
import Control.Arrow
import Control.Monad.Error
import Control.Monad.Identity
import Control.Monad.Reader
import Rest.Types.Range
import Safe
import Rest.Dictionary
import Rest.Error
data Env h p i = Env
{ header :: h
, param :: p
, input :: i
}
data GenHandler m f where
GenHandler ::
{ dictionary :: Dict h p i o e
, handler :: Env h p i -> ErrorT (Reason e) m (Apply f o)
, secure :: Bool
} -> GenHandler m f
mkGenHandler :: Monad m => Modifier h p i o e -> (Env h p i -> ErrorT (Reason e) m (Apply f o)) -> GenHandler m f
mkGenHandler d a = GenHandler (d empty) a False
type family Apply (f :: * -> *) a :: *
type instance Apply Identity a = a
type instance Apply [] a = [a]
type Handler m = GenHandler m Identity
type ListHandler m = GenHandler m []
secureHandler :: Handler m -> Handler m
secureHandler h = h { secure = True }
mkListing
:: Monad m
=> Modifier h p () o e
-> (Range -> ErrorT (Reason e) m [o])
-> ListHandler m
mkListing d a = mkGenHandler (mkPar range . d) (a . param)
range :: Param Range
range = Param ["offset", "count"] $ \xs ->
maybe (Left (ParseError "range"))
(Right . normalize)
$ case xs of
[Just o, Just c] -> Range <$> readMay o <*> readMay c
[_ , Just c] -> Range 0 <$> readMay c
[Just o, _ ] -> (`Range` 100) <$> readMay o
_ -> Just $ Range 0 100
where normalize r = Range { offset = max 0 . offset $ r
, count = min 1000 . max 0 . count $ r
}
mkOrderedListing
:: Monad m
=> Modifier h p () o e
-> ((Range, Maybe String, Maybe String) -> ErrorT (Reason e) m [o])
-> ListHandler m
mkOrderedListing d a = mkGenHandler (mkPar orderedRange . d) (a . param)
orderedRange :: Param (Range, Maybe String, Maybe String)
orderedRange = Param ["offset", "count", "order", "direction"] $ \xs ->
case xs of
[mo, mc, mor, md] ->
maybe (Left (ParseError "range"))
(Right . (\(o, c) -> (Range o c, mor, md)) . normalize)
$ case (mo, mc) of
(Just o, Just c) -> (,) <$> readMay o <*> readMay c
(_ , Just c) -> (0,) <$> readMay c
(Just o, _ ) -> (,100) <$> readMay o
_ -> Just (0, 100)
_ -> error "Internal error in orderedRange rest parameters"
where normalize = (max 0 *** (min 1000 . max 0))
mkHandler :: Monad m => Modifier h p i o e -> (Env h p i -> ErrorT (Reason e) m o) -> Handler m
mkHandler = mkGenHandler
mkInputHandler :: Monad m => Modifier () () i o e -> (i -> ErrorT (Reason e) m o) -> Handler m
mkInputHandler d a = mkHandler d (a . input)
mkConstHandler :: Monad m => Modifier () () () o e -> ErrorT (Reason e) m o -> Handler m
mkConstHandler d a = mkHandler d (const a)
mkIdHandler :: MonadReader id m => Modifier h p i o e -> (i -> id -> ErrorT (Reason e) m o) -> Handler m
mkIdHandler d a = mkHandler d (\env -> ask >>= a (input env))