module Web.Routes.Nested.VerbListener where
import Web.Routes.Nested.FileExtListener
import Network.Wai
import Control.Applicative hiding (empty)
import Control.Monad.Trans
import Control.Monad.Writer
import Control.Monad.Reader
import Data.Monoid
import Data.Foldable
import Data.Traversable
import Data.Map.Lazy
import qualified Data.ByteString.Lazy as BL
data Verb = Get
| Post
| Put
| Delete
deriving (Show, Eq, Ord)
newtype Verbs z m r = Verbs { unVerbs :: Map Verb (Maybe (ReaderT BL.ByteString m z), FileExts 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
get :: (Monad m) =>
FileExtListenerT Response m a
-> VerbListenerT z Response m ()
get !flistener = do
(fileexts :: FileExts Response) <- lift $ execWriterT $
runFileExtListenerT flistener
let new = singleton Get (Nothing, fileexts)
VerbListenerT $ tell $ Verbs new
post :: (Monad m, MonadIO m) =>
(BL.ByteString -> m z)
-> FileExtListenerT Response m a
-> VerbListenerT z Response m ()
post !handle !flistener = do
(fileexts :: FileExts Response) <- lift $ execWriterT $
runFileExtListenerT flistener
let new = singleton Post (Just $ ReaderT handle, fileexts)
VerbListenerT $ tell $ Verbs new
put :: (Monad m, MonadIO m) =>
(BL.ByteString -> m z)
-> FileExtListenerT Response m a
-> VerbListenerT z Response m ()
put !handle !flistener = do
(fileexts :: FileExts Response) <- lift $ execWriterT $
runFileExtListenerT flistener
let new = singleton Put (Just $ ReaderT handle, fileexts)
VerbListenerT $ tell $ Verbs new
delete :: (Monad m) =>
FileExtListenerT Response m a
-> VerbListenerT z Response m ()
delete !flistener = do
(fileexts :: FileExts Response) <- lift $ execWriterT $
runFileExtListenerT flistener
let new = singleton Delete (Nothing, fileexts)
VerbListenerT $ tell $ Verbs new