nested-routes 0.1.1 → 0.2

raw patch · 5 files changed

+376/−122 lines, 5 filesdep +attoparsecdep +pred-triedep −pseudo-triePVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, pred-trie

Dependencies removed: pseudo-trie

API changes (from Hackage documentation)

Files

• nested-routes.cabal +4/−2
• src/Web/Routes/Nested.hs +209/−83
• src/Web/Routes/Nested/FileExtListener.hs +26/−0
• src/Web/Routes/Nested/Types.hs +106/−0
• src/Web/Routes/Nested/VerbListener.hs +31/−37

@@ -1,5 +1,5 @@ Name:                   nested-routes-Version:                0.1.1+Version:                0.2 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -14,6 +14,7 @@   HS-Source-Dirs:       src   GHC-Options:          -Wall   Exposed-Modules:      Web.Routes.Nested+                        Web.Routes.Nested.Types                         Web.Routes.Nested.VerbListener                         Web.Routes.Nested.FileExtListener   Build-Depends:        base >= 4 && < 5@@ -24,12 +25,13 @@                       , transformers                       , semigroups                       , containers-                      , pseudo-trie >= 0.0.4.3                       , text                       , aeson                       , blaze-html                       , lucid                       , bytestring+                      , attoparsec+                      , pred-trie >= 0.0.6.1  Test-Suite spec   Type:                 exitcode-stdio-1.0

@@ -1,20 +1,28 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE GADTs                      #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE+    DeriveFunctor+  , GADTs+  , GeneralizedNewtypeDeriving+  , ScopedTypeVariables+  , StandaloneDeriving+  , TypeOperators+  , OverloadedStrings+  , DataKinds+  , TupleSections+  , FlexibleContexts+  #-}  module Web.Routes.Nested   ( module Web.Routes.Nested.FileExtListener   , module Web.Routes.Nested.VerbListener+  , module Web.Routes.Nested.Types   , HandlerT (..)-  , handle+  , handleLit+  , handleParse   , notFound   , route   ) where +import           Web.Routes.Nested.Types import           Web.Routes.Nested.FileExtListener import           Web.Routes.Nested.VerbListener @@ -30,10 +38,8 @@ import           Control.Monad.Reader import qualified Data.List.NonEmpty                as NE import           Data.Monoid-import           Data.Trie.Pseudo-import qualified Data.Trie.Pseudo                  as P-import           Data.Trie.Rooted-import qualified Data.Trie.Rooted                  as R+import           Data.Trie.Pred.Unified+import qualified Data.Trie.Pred.Unified            as P import           Data.Traversable import qualified Data.Text                         as T import qualified Data.Map.Lazy                     as M@@ -42,8 +48,8 @@   newtype HandlerT z m a = HandlerT-  { runHandler :: WriterT ( MergeRooted T.Text (Verbs z m Response)-                          , MergeRooted T.Text (FileExts Response) ) m a }+  { runHandler :: WriterT ( RUPTrie T.Text (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))+                          , RUPTrie T.Text (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ())) ) m a }   deriving (Functor)  deriving instance Applicative m => Applicative (HandlerT z m)@@ -53,41 +59,91 @@   lift ma = HandlerT $ lift ma  --- | Add a path to the list of routes-handle :: Monad m =>-          [T.Text]                      -- ^ Input path, separated by slashes-       -> VerbListenerT z Response m () -- ^ HTTP Method-oriented monad-       -> [HandlerT z m ()]             -- ^ Child paths-       -> HandlerT z m ()-handle ts vl [] = do-  vfrs <- lift $ execWriterT $ runVerbListenerT vl+handleLit :: ( Monad m+             , Singleton (UrlChunks xs)+                 (ExpectArity xs+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+                 (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+             , Extrude (UrlChunks xs)+                 (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+                 (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+             ) =>+             UrlChunks xs+          -> ExpectArity xs (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))+          -> [HandlerT z m ()]+          -> HandlerT z m ()+handleLit ts vl [] =+  HandlerT $ tell (singleton ts vl, mempty)+handleLit ts vl cs = do+  (child,_) <- lift $ foldM (\acc c -> (acc <>) <$> (execWriterT $ runHandler c)) mempty cs -  HandlerT $ tell $-    case ts of-      [] -> (MergeRooted $ Rooted (Just vfrs) [],                           mempty)-      _  -> (MergeRooted $ Rooted Nothing     [Rest (NE.fromList ts) vfrs], mempty)-handle ts vl cs = do-  vfrs <- lift $ execWriterT $ runVerbListenerT vl+  HandlerT $ tell $ let+                      child' = extrude ts child+                    in+                    (P.merge child' $ singleton ts vl, mempty)++handleParse :: ( Monad m+               , Singleton (UrlChunks xs)+                   (ExpectArity xs+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+                   (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+               , Extrude (UrlChunks xs)+                   (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+                   (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+               ) =>+               UrlChunks xs+            -> ExpectArity xs (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))+            -> [HandlerT z m ()]+            -> HandlerT z m ()+handleParse ts vl [] =+  HandlerT $ tell (singleton ts vl, mempty)+handleParse ts vl cs = do   (child,_) <- lift $ foldM (\acc c -> (acc <>) <$> (execWriterT $ runHandler c)) mempty cs -  HandlerT $ tell $-    case ts of-      [] -> case unMergeRooted child of-              Rooted _ xs -> (MergeRooted $ Rooted (Just vfrs) xs, mempty)-      _  -> let child' = push (unMergeRooted child) $ NE.fromList ts in-            (MergeRooted $ Rooted Nothing [P.assign (NE.fromList ts) (Just vfrs) child'], mempty)+  HandlerT $ tell $ let+                      child' = extrude ts child+                    in+                    (P.merge child' $ singleton ts vl, mempty)  -notFound :: Monad m =>-            [T.Text]-         -> FileExtListenerT Response m ()+notFound :: ( Monad m+            , Singleton (UrlChunks xs)+                (ExpectArity xs+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+                (RUPTrie T.Text+                           (Either+                              (VerbListenerT z (FileExtListenerT Response m ()) m ())+                              (VerbListenerT z Response m ())))+            ) =>+            UrlChunks xs+         -> ExpectArity xs (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))          -> HandlerT z m ()-notFound ts flistener = do-  (fes :: FileExts Response) <- lift $ execWriterT $ runFileExtListenerT flistener-  HandlerT $ tell $-    case ts of-      [] -> (mempty, MergeRooted $ Rooted (Just fes) [])-      _  -> (mempty, MergeRooted $ Rooted Nothing    [Rest (NE.fromList ts) fes])+notFound ts vl = do+  HandlerT $ tell (mempty, singleton ts vl)   -- | Turns a @HandlerT@ into a Wai @Application@@@ -96,50 +152,120 @@       -> Request       -> (Response -> IO ResponseReceived) -> m ResponseReceived route h req respond = do-  (rtrie, festrie) <- execWriterT $ runHandler h-  let trie         = unMergeRooted rtrie-      notFoundTrie = unMergeRooted festrie-      mMethod      = httpMethodToMSym $ requestMethod req-      mFileext     = case pathInfo req of-                       [] -> Just Html-                       xs -> possibleExts $ getFileExt $ last xs-      mNotFoundMap :: Maybe (M.Map FileExt Response)-      mNotFoundMap = (return . unFileExts) =<< R.lookupNearestParent (pathInfo req) notFoundTrie+  (rtrie, nftrie) <- execWriterT $ runHandler h+  let mMethod  = httpMethodToMSym $ requestMethod req+      mFileext = case pathInfo req of+                         [] -> Just Html+                         xs -> possibleExts $ getFileExt $ last xs+      -- meitherNotFound :: Maybe (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))+      meitherNotFound = P.lookupNearestParent (pathInfo req) nftrie +  notFoundBasic <- handleNotFound Html Get meitherNotFound+   case (mFileext, mMethod) of-    (Just f, Just v) -> let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req-                        in-                        case R.lookup cleanedPathInfo trie of-      Just vmap -> continue f v vmap mNotFoundMap-      Nothing  -> case trimFileExt $ last $ pathInfo req of-        "index" -> case R.lookup (init $ pathInfo req) trie of-          Just vmap -> continue f v vmap mNotFoundMap-          Nothing -> liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin f-        _       -> liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin f-    _ -> liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin Html+    (Just f, Just v) -> do+      menf <- handleNotFound f v meitherNotFound+      let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req+      case P.lookup cleanedPathInfo rtrie of+        Just eitherM -> continue f v eitherM $ menf+        Nothing  -> case trimFileExt $ last $ pathInfo req of+          "index" -> case P.lookup (init $ pathInfo req) rtrie of+            Just eitherM -> continue f v eitherM $ menf+            Nothing -> liftIO $ respond404 $ menf+          _       -> liftIO $ respond404 $ menf+    _ -> liftIO $ respond404 $ notFoundBasic    where-    continue :: MonadIO m => FileExt -> Verb -> Verbs z m Response -> Maybe (M.Map FileExt Response) -> m ResponseReceived-    continue f v vmap mNotFoundMap = case M.lookup v $ unVerbs vmap of-        Just (mreqbodyf,femap) ->-          case lookupMin f $ unFileExts femap of-            Just r -> do-              case mreqbodyf of-                Nothing    -> liftIO $ respond r-                Just (reqbf,Nothing) -> do-                  body <- liftIO $ strictRequestBody req-                  (runReaderT $ reqbf) body-                  liftIO $ respond r-                Just (reqbf,Just bl) -> do-                  case requestBodyLength req of-                    KnownLength bl' -> if bl' <= bl-                                         then do body <- liftIO $ strictRequestBody req-                                                 (runReaderT $ reqbf) body-                                                 liftIO $ respond r-                                         else liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin f-                    _ -> liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin f-            Nothing -> liftIO $ respond $ fromMaybe plain404 $ mNotFoundMap >>= lookupMin f-        Nothing -> liftIO $ respond $ fromMaybe plain404 $ lookupMin f =<< mNotFoundMap+    handleNotFound :: MonadIO m =>+                      FileExt+                   -> Verb+                   -> Maybe ( Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()) )+                   -> m (Maybe Response)+    handleNotFound f v meitherNotFound = case meitherNotFound of+      Just (Left litmonad) -> do+        vmapLit <- execWriterT $ runVerbListenerT litmonad+        case M.lookup v (unVerbs vmapLit) of+          Just (_, femonad) -> do+            femap <- execWriterT $ runFileExtListenerT femonad+            return $ lookupMin f $ unFileExts femap+          Nothing -> return Nothing+      Just (Right predmonad) -> do+        vmapPred <- execWriterT $ runVerbListenerT predmonad+        case M.lookup v (unVerbs vmapPred) of+          Just (_, r) -> return $ Just r+          Nothing -> return Nothing+      Nothing -> return Nothing++    respond404 mr = respond $ fromMaybe plain404 mr++    continue :: MonadIO m =>+                FileExt+             -> Verb+             -> Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ())+             -> Maybe Response+             -> m ResponseReceived+    continue f v eitherM mnfResp = case eitherM of+       Left litmonad -> do+         vmapLit <- execWriterT $ runVerbListenerT litmonad+         continueLit f v (unVerbs vmapLit) mnfResp+       Right predmonad -> do+         vmapPred <- execWriterT $ runVerbListenerT predmonad+         continuePred f v (unVerbs vmapPred) mnfResp+++    continueLit :: MonadIO m =>+                   FileExt+                -> Verb+                -> M.Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), FileExtListenerT Response m ())+                -> Maybe Response+                -> m ResponseReceived+    continueLit f v vmap mnfResp = case M.lookup v vmap of+      Just (mreqbodyf, femonad) -> do+        femap <- execWriterT $ runFileExtListenerT femonad+        case lookupMin f $ unFileExts femap of+          Just r -> do+            case mreqbodyf of+              Nothing              -> liftIO $ respond r+              Just (reqbf,Nothing) -> do+                body <- liftIO $ strictRequestBody req+                (runReaderT $ reqbf) body+                liftIO $ respond r+              Just (reqbf,Just bl) -> do+                case requestBodyLength req of+                  KnownLength bl' -> if bl' <= bl+                                       then do body <- liftIO $ strictRequestBody req+                                               (runReaderT $ reqbf) body+                                               liftIO $ respond r+                                       else liftIO $ respond404 mnfResp+                  _ -> liftIO $ respond404 mnfResp+          Nothing -> liftIO $ respond404 mnfResp+      Nothing -> liftIO $ respond404 mnfResp+++    continuePred :: MonadIO m =>+                    FileExt+                 -> Verb+                 -> M.Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), Response)+                 -> Maybe Response+                 -> m ResponseReceived+    continuePred f v vmap mnfResp = case M.lookup v vmap of+        Just (mreqbodyf, r) ->+          case mreqbodyf of+            Nothing              -> liftIO $ respond r+            Just (reqbf,Nothing) -> do+              body <- liftIO $ strictRequestBody req+              (runReaderT $ reqbf) body+              liftIO $ respond r+            Just (reqbf,Just bl) -> do+              case requestBodyLength req of+                KnownLength bl' -> if bl' <= bl+                                     then do body <- liftIO $ strictRequestBody req+                                             (runReaderT $ reqbf) body+                                             liftIO $ respond r+                                     else liftIO $ respond404 mnfResp+                _ -> liftIO $ respond404 mnfResp+        Nothing -> liftIO $ respond404 mnfResp+      plain404 = responseLBS status404 [("Content-Type","text/plain")] "404" 

@@ -68,6 +68,10 @@   FileExtListenerT $ tell $     FileExts $ singleton Json r +jsonOnly :: (A.ToJSON j) =>+            j -> Response+jsonOnly i =+  responseLBS status200 [("Content-Type", "application/json")] $ A.encode i  jsonp :: (A.ToJSON j, Monad m) =>          j -> FileExtListenerT Response m ()@@ -77,6 +81,10 @@   FileExtListenerT $ tell $     FileExts $ singleton Json r +jsonpOnly :: (A.ToJSON j) =>+            j -> Response+jsonpOnly i =+  responseLBS status200 [("Content-Type", "application/javascript")] $ A.encode i  text :: (Monad m) =>         LT.Text -> FileExtListenerT Response m ()@@ -86,6 +94,9 @@   FileExtListenerT $ tell $     FileExts $ singleton Text r +textOnly :: LT.Text -> Response+textOnly i =+  responseLBS status200 [("Content-Type", "text/plain")] $ LT.encodeUtf8 i  blaze :: (Monad m ) =>          H.Html -> FileExtListenerT Response m ()@@ -95,6 +106,9 @@   FileExtListenerT $ tell $     FileExts $ singleton Html r +blazeOnly :: H.Html -> Response+blazeOnly i =+  responseLBS status200 [("Content-Type", "text/html")] $ LT.encodeUtf8 $ H.renderHtml i  lucid :: (Monad m) =>          L.HtmlT m () -> FileExtListenerT Response m ()@@ -104,6 +118,11 @@   FileExtListenerT $ tell $     FileExts $ singleton Html r +lucidOnly :: (Monad m) =>+             L.HtmlT m () -> m Response+lucidOnly i = do+  i' <- L.renderBST i+  return $ responseLBS status200 [("Content-Type", "text/html")] $ i'  builder :: (Monad m) =>            BU.Builder -> RequestHeaders@@ -113,6 +132,9 @@   FileExtListenerT $ tell $     FileExts $ singleton e r +builderOnly :: BU.Builder -> RequestHeaders -> Response+builderOnly i hs =+  responseBuilder status200 hs i  bytestring :: (Monad m) =>               B.ByteString -> RequestHeaders@@ -121,3 +143,7 @@   let r = responseLBS status200 hs i in   FileExtListenerT $ tell $     FileExts $ singleton e r++bytestringOnly :: B.ByteString -> RequestHeaders -> Response+bytestringOnly i hs =+  responseLBS status200 hs i

@@ -0,0 +1,106 @@+{-# LANGUAGE+    GADTs+  , TypeOperators+  , TypeFamilies+  , KindSignatures+  , DataKinds+  , RankNTypes+  , FlexibleInstances+  , UndecidableInstances+  , OverlappingInstances+  , MultiParamTypeClasses+  , FunctionalDependencies+  #-}++module Web.Routes.Nested.Types+  ( Singleton (..)+  , Extend (..)+  , Extrude (..)+  , iResultToMaybe+  , restAreLits+  , ToNE (..)+  , ToL (..)+  , ExpectArity+  , module Web.Routes.Nested.Types.UrlChunks+  ) where++import Data.Attoparsec.Text+import Web.Routes.Nested.Types.UrlChunks+import Web.Routes.Nested.VerbListener+import Web.Routes.Nested.FileExtListener+import Network.Wai+import qualified Data.Text as T+import           Data.List.NonEmpty+import qualified Data.List.NonEmpty as NE+import Data.Trie.Pred.Unified+import Data.Trie.Pred.Unified.Tail+++class Singleton chunks a trie | chunks a -> trie where+  singleton :: chunks -> a -> trie++instance Singleton (UrlChunks '[]) a (RUPTrie T.Text a) where+  singleton Root r = Rooted (Just r) []++instance ( Singleton (UrlChunks xs) a trie0+         , Extend (EitherUrlChunk x) trie0 trie1 )=>+         Singleton (UrlChunks (x ': xs)) a trie1 where+  singleton (Cons u us) r = extend u (singleton us r)+++class Extend eitherUrlChunk child result | eitherUrlChunk child -> result where+  extend :: eitherUrlChunk -> child -> result++instance Extend (EitherUrlChunk  'Nothing) (RUPTrie T.Text a)        (RUPTrie T.Text a) where+  extend ((:=) t) (Rooted mx xs) = Rooted Nothing [UMore t mx xs]++instance Extend (EitherUrlChunk ('Just r)) (RUPTrie T.Text (r -> a)) (RUPTrie T.Text a) where+  extend ((:~) (t,q)) (Rooted mx xs) = Rooted Nothing [UPred t (iResultToMaybe . parse q) mx xs]+++class Extrude chunks start result | chunks start -> result where+  extrude :: chunks -> start -> result++instance Extrude (UrlChunks '[]) (RUPTrie T.Text a) (RUPTrie T.Text a) where+  extrude Root r = r++instance ( Extrude (UrlChunks xs) trie0 trie1+         , Extend (EitherUrlChunk x) trie1 trie2 ) => Extrude (UrlChunks (x ': xs)) trie0 trie2 where+  extrude (Cons u us) r = extend u (extrude us r)+++iResultToMaybe :: IResult T.Text r -> Maybe r+iResultToMaybe (Done _ r) = Just r+iResultToMaybe _          = Nothing++restAreLits :: UrlChunks xs -> Bool+restAreLits Root = False+restAreLits (Cons ((:=) _) Root) = True+restAreLits (Cons ((:=) _) us)   = restAreLits us+restAreLits (Cons _ _) = False++class ToNE chunks where+  toNE :: chunks -> NonEmpty T.Text++instance ToNE (UrlChunks ('Nothing ': '[])) where+  toNE (Cons ((:=) t) Root) = t :| []++instance ToNE (UrlChunks xs) => ToNE (UrlChunks ('Nothing ': xs)) where+  toNE (Cons ((:=) t) us) = t :| (toList $ toNE us)+++class ToL chunks where+  toL :: chunks -> [T.Text]++instance ToL (UrlChunks '[]) where+  toL Root = []++instance ToL (UrlChunks xs) => ToL (UrlChunks ('Nothing ': xs)) where+  toL (Cons ((:=) t) us) = t : toL us+++type family ExpectArity (xs :: [Maybe *]) (r :: *) :: * where+  ExpectArity '[] r = r+  ExpectArity ('Nothing  ': xs) r = ExpectArity xs r+  ExpectArity (('Just x) ': xs) r = x -> (ExpectArity xs r)+

@@ -5,6 +5,8 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE FunctionalDependencies     #-}  module Web.Routes.Nested.VerbListener where @@ -32,7 +34,7 @@  type BodyLength = Word64 -newtype Verbs z m r = Verbs { unVerbs :: Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), FileExts r) }+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)@@ -49,67 +51,59 @@   lift ma = VerbListenerT $ lift ma  +foldMWithKey :: Monad m => (acc -> Verb -> a -> m acc) -> acc -> Map Verb a -> m acc+foldMWithKey f i map = foldlWithKey (\macc k a -> (\mer -> f mer k a) =<< macc) (return i) map++ 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)+       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)-     -> 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, Nothing), fileexts)+     -> 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)-        -> FileExtListenerT Response m a-        -> VerbListenerT z Response m ()-postMax !bl !handle !flistener = do-  (fileexts :: FileExts Response) <- lift $ execWriterT $-                                     runFileExtListenerT flistener-  let new = singleton Post (Just $ (ReaderT handle, Just bl), fileexts)+        -> 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)-    -> 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, Nothing), fileexts)+    -> 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)-       -> FileExtListenerT Response m a-       -> VerbListenerT z Response m ()-putMax !bl !handle !flistener = do-  (fileexts :: FileExts Response) <- lift $ execWriterT $-                                     runFileExtListenerT flistener-  let new = singleton Put (Just $ (ReaderT handle, Just bl), fileexts)+       -> 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) =>-          FileExtListenerT Response m a-       -> VerbListenerT z Response m ()-delete !flistener = do-  (fileexts :: FileExts Response) <- lift $ execWriterT $-                                     runFileExtListenerT flistener-  let new = singleton Delete (Nothing, fileexts)+          a+       -> VerbListenerT z a m ()+delete r = do+  let new = singleton Delete (Nothing, r)   VerbListenerT $ tell $ Verbs new