module Web.Routes.Nested.VerbListener where
import Control.Applicative hiding (empty)
import Control.Monad.Trans
import Control.Monad.Writer
import Control.Monad.Reader
import Data.Foldable
import Data.Traversable
import Data.Map.Lazy
import qualified Data.ByteString.Lazy as BL
import Data.Word (Word64)
data Verb = Get
| Post
| Put
| Delete
deriving (Show, Eq, Ord)
type BodyLength = Word64
newtype Verbs z m r = Verbs { unVerbs :: Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), r) }
deriving (Functor, Traversable)
deriving instance Monoid (Verbs z m a)
deriving instance Foldable (Verbs z m)
newtype VerbListenerT z r m a =
VerbListenerT { runVerbListenerT :: WriterT (Verbs z m r) m a }
deriving (Functor)
deriving instance Applicative m => Applicative (VerbListenerT z r m)
deriving instance Monad m => Monad (VerbListenerT z r m)
deriving instance MonadIO m => MonadIO (VerbListenerT z r m)
instance MonadTrans (VerbListenerT z r) where
lift ma = VerbListenerT $ lift ma
foldMWithKey :: Monad m => (acc -> Verb -> a -> m acc) -> acc -> Map Verb a -> m acc
foldMWithKey f i = foldlWithKey (\macc k a -> (\mer -> f mer k a) =<< macc) (return i)
get :: (Monad m) =>
a
-> VerbListenerT z a m ()
get r = do
let new = singleton Get (Nothing, r)
VerbListenerT $ tell $ Verbs new
post :: (Monad m, MonadIO m) =>
(BL.ByteString -> m z)
-> a
-> VerbListenerT z a m ()
post handle r = do
let new = singleton Post (Just (ReaderT handle, Nothing), r)
VerbListenerT $ tell $ Verbs new
postMax :: (Monad m, MonadIO m) =>
BodyLength
-> (BL.ByteString -> m z)
-> a
-> VerbListenerT z a m ()
postMax bl handle r = do
let new = singleton Post (Just (ReaderT handle, Just bl), r)
VerbListenerT $ tell $ Verbs new
put :: (Monad m, MonadIO m) =>
(BL.ByteString -> m z)
-> a
-> VerbListenerT z a m ()
put handle r = do
let new = singleton Put (Just (ReaderT handle, Nothing), r)
VerbListenerT $ tell $ Verbs new
putMax :: (Monad m, MonadIO m) =>
BodyLength
-> (BL.ByteString -> m z)
-> a
-> VerbListenerT z a m ()
putMax bl handle r = do
let new = singleton Put (Just (ReaderT handle, Just bl), r)
VerbListenerT $ tell $ Verbs new
delete :: (Monad m) =>
a
-> VerbListenerT z a m ()
delete r = do
let new = singleton Delete (Nothing, r)
VerbListenerT $ tell $ Verbs new