nested-routes 0.0.3.1 → 0.1

raw patch · 3 files changed

+67/−23 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• nested-routes.cabal +2/−2
• src/Web/Routes/Nested.hs +30/−14
• src/Web/Routes/Nested/VerbListener.hs +35/−7

@@ -1,10 +1,10 @@ Name:                   nested-routes-Version:                0.0.3.1+Version:                0.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3 License-File:           LICENSE-Synopsis:               Like scotty, but nested+Synopsis:               Declarative, compositional Wai responses -- Description: Cabal-Version:          >= 1.10 Build-Type:             Simple

@@ -49,10 +49,11 @@   lift ma = HandlerT $ lift ma  +-- | Add a path to the list of routes handle :: Monad m =>-          [T.Text]-       -> VerbListenerT z Response m ()-       -> [HandlerT z 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@@ -73,10 +74,13 @@             MergeRooted $ Rooted Nothing [P.assign (NE.fromList ts) (Just vfrs) child']  +-- | Turns a @HandlerT@ into a Wai @Application@ route :: (Functor m, Monad m, MonadIO m) =>-         HandlerT z m a-      -> Request -> (Response -> m b) -> m b-route h req respond = do+         Response -- ^ Response to give when not found in the router+      -> HandlerT z m a -- ^ Assembled @handle@ calls+      -> Request+      -> (Response -> m b) -> m b+route notFound h req respond = do   trie <- unMergeRooted <$> (execWriterT $ runHandler h)   let mMethod = httpMethodToMSym $ requestMethod req       mFileext = case pathInfo req of@@ -84,24 +88,38 @@                    xs -> possibleExts $ getFileExt $ last xs    case (mFileext, mMethod) of-    (Just f, Just v) -> let cleanedPathInfo = applyToLast trimFileExt (pathInfo req) in+    (Just f, Just v) -> let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req in                         case R.lookup cleanedPathInfo trie of-      Just vmap -> case M.lookup v $ unVerbs vmap of+      Just vmap -> continue f v vmap+      Nothing  -> case trimFileExt $ last $ pathInfo req of+        "index" -> case R.lookup (init $ pathInfo req) trie of+          Just vmap -> continue f v vmap+          Nothing -> respond notFound+        _       -> respond notFound+    _ -> respond notFound++  where+    continue f v vmap = case M.lookup v $ unVerbs vmap of         Just (mreqbodyf,femap) ->           case lookupMin f $ unFileExts femap of             Just r -> do               case mreqbodyf of                 Nothing    -> respond r-                Just reqbf -> do+                Just (reqbf,Nothing) -> do                   body <- liftIO $ strictRequestBody req                   (runReaderT $ reqbf) body                   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+                                                 respond r+                                         else respond notFound+                    _ -> respond notFound             Nothing -> respond notFound         Nothing -> respond notFound-      Nothing  -> respond notFound-    _ -> respond notFound -  where     lookupMin k map | all (k <) (M.keys map) = M.lookup (minimum $ M.keys map) map                     | otherwise              = M.lookup k map @@ -130,5 +148,3 @@                        | x == methodPut    = Just Put                        | x == methodDelete = Just Delete                        | otherwise         = Nothing--    notFound = responseLBS status404 [("Content-Type","text/plain")] "404 :("

@@ -4,6 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE BangPatterns               #-}  module Web.Routes.Nested.VerbListener where @@ -20,6 +21,7 @@ import           Data.Traversable import           Data.Map.Lazy import qualified Data.ByteString.Lazy                 as BL+import           Data.Word                            (Word64)   data Verb = Get@@ -28,7 +30,9 @@           | Delete   deriving (Show, Eq, Ord) -newtype Verbs z m r = Verbs { unVerbs :: Map Verb (Maybe (ReaderT BL.ByteString m z), FileExts r) }+type BodyLength = Word64++newtype Verbs z m r = Verbs { unVerbs :: Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), FileExts r) }   deriving (Functor, Traversable)  deriving instance                  Monoid    (Verbs z m a)@@ -48,7 +52,7 @@ get :: (Monad m) =>        FileExtListenerT Response m a     -> VerbListenerT z Response m ()-get flistener = do+get !flistener = do   (fileexts :: FileExts Response) <- lift $ execWriterT $                                      runFileExtListenerT flistener   let new = singleton Get (Nothing, fileexts)@@ -59,28 +63,52 @@         (BL.ByteString -> m z)      -> FileExtListenerT Response m a      -> VerbListenerT z Response m ()-post handle flistener = do+post !handle !flistener = do   (fileexts :: FileExts Response) <- lift $ execWriterT $                                      runFileExtListenerT flistener-  let new = singleton Post (Just $ ReaderT handle, fileexts)+  let new = singleton Post (Just $ (ReaderT handle, Nothing), fileexts)   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)+  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+put !handle !flistener = do   (fileexts :: FileExts Response) <- lift $ execWriterT $                                      runFileExtListenerT flistener-  let new = singleton Put (Just $ ReaderT handle, fileexts)+  let new = singleton Put (Just $ (ReaderT handle, Nothing), fileexts)   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)+  VerbListenerT $ tell $ Verbs new++ delete :: (Monad m) =>           FileExtListenerT Response m a        -> VerbListenerT z Response m ()-delete flistener = do+delete !flistener = do   (fileexts :: FileExts Response) <- lift $ execWriterT $                                      runFileExtListenerT flistener   let new = singleton Delete (Nothing, fileexts)