nested-routes 2.2.0 → 3.0.0

raw patch · 4 files changed

+52/−85 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• nested-routes.cabal +1/−1
• src/Web/Routes/Nested.hs +23/−33
• src/Web/Routes/Nested/FileExtListener/Types.hs +2/−11
• src/Web/Routes/Nested/VerbListener.hs +26/−40

@@ -1,5 +1,5 @@ Name:                   nested-routes-Version:                2.2.0+Version:                3.0.0 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3

@@ -58,24 +58,18 @@ import Data.Function.Poly  -newtype HandlerT z x m a = HandlerT+newtype HandlerT x m a = HandlerT   { runHandler :: WriterT ( RUPTrie T.Text x                           , RUPTrie T.Text x ) m a }-  deriving (Functor)--deriving instance Applicative m => Applicative (HandlerT z x m)-deriving instance Monad m =>       Monad       (HandlerT z x m)-deriving instance MonadIO m =>     MonadIO     (HandlerT z x m)-instance MonadTrans (HandlerT z x) where-  lift ma = HandlerT $ lift ma+  deriving (Functor, Applicative, Monad, MonadIO, MonadTrans) -type ActionT z m a = VerbListenerT z (FileExtListenerT Response m a) m a+type ActionT m a = VerbListenerT (FileExtListenerT Response m a) m a  -- | For routes ending with a literal. handle :: ( Monad m           , Functor m           , cleanxs ~ OnlyJusts xs-          , HasResult childType (ActionT z m ())+          , HasResult childType (ActionT m ())           , ExpectArity cleanxs childType           , Singleton (UrlChunks xs)               childType@@ -85,11 +79,10 @@               (RUPTrie T.Text result)           , (ArityMinusTypeList childType cleanxs) ~ result           , childType ~ TypeListToArity cleanxs result-          ) =>-          UrlChunks xs -- ^ Path to match against-       -> Maybe childType -- ^ Possibly a function, ending in @ActionT z m ()@.-       -> Maybe (HandlerT z childType m ()) -- ^ Potential child routes-       -> HandlerT z result m ()+          ) => UrlChunks xs -- ^ Path to match against+            -> Maybe childType -- ^ Possibly a function, ending in @ActionT z m ()@.+            -> Maybe (HandlerT childType m ()) -- ^ Potential child routes+            -> HandlerT result m () handle ts (Just vl) Nothing =   HandlerT $ tell (singleton ts vl, mempty) handle ts mvl (Just cs) = do@@ -108,10 +101,9 @@               (RUPTrie T.Text result)           , (ArityMinusTypeList childType cleanxs) ~ result           , childType ~ TypeListToArity cleanxs result-          ) =>-          UrlChunks xs -- ^ Path to match against-       -> HandlerT z childType m () -- ^ Potential child routes-       -> HandlerT z result m ()+          ) => UrlChunks xs+            -> HandlerT childType m ()+            -> HandlerT result m () parent ts cs = do   (Rooted _ ctrie,_) <- lift $ execWriterT $ runHandler cs   HandlerT $ tell (extrude ts $ Rooted Nothing ctrie, mempty)@@ -119,7 +111,7 @@ notFound :: ( Monad m             , Functor m             , cleanxs ~ OnlyJusts xs-            , HasResult childType (ActionT z m ())+            , HasResult childType (ActionT m ())             , ExpectArity cleanxs childType             , Singleton (UrlChunks xs)                 childType@@ -129,11 +121,10 @@                 (RUPTrie T.Text result)             , (ArityMinusTypeList childType cleanxs) ~ result             , childType ~ TypeListToArity cleanxs result-            ) =>-            UrlChunks xs-         -> Maybe childType-         -> Maybe (HandlerT z childType m ())-         -> HandlerT z result m ()+            ) => UrlChunks xs+              -> Maybe childType+              -> Maybe (HandlerT childType m ())+              -> HandlerT result m () notFound ts (Just vl) Nothing =   HandlerT $ tell (mempty, singleton ts vl) notFound ts mvl (Just cs) = do@@ -146,10 +137,9 @@ route :: ( Functor m          , Monad m          , MonadIO m-         ) =>-         HandlerT z (ActionT z m ()) m a -- ^ Assembled @handle@ calls-      -> Request-      -> (Response -> IO ResponseReceived) -> m ResponseReceived+         ) => HandlerT (ActionT m ()) m a -- ^ Assembled @handle@ calls+           -> Request+           -> (Response -> IO ResponseReceived) -> m ResponseReceived route h req respond = do   (rtrie, nftrie) <- execWriterT $ runHandler h   let mMethod  = httpMethodToMSym $ requestMethod req@@ -188,7 +178,7 @@                       Maybe B.ByteString                    -> FileExt                    -> Verb-                   -> Maybe (ActionT z m ())+                   -> Maybe (ActionT m ())                    -> m (Maybe Response)     handleNotFound acceptBS f v mnfcomp =       let handleEither nfcomp = do@@ -205,7 +195,7 @@                 Maybe B.ByteString              -> FileExt              -> Verb-             -> ActionT z m ()+             -> ActionT m ()              -> Maybe Response              -> m ResponseReceived     continue acceptBS f v foundM mnfResp = do@@ -216,7 +206,7 @@                    Maybe B.ByteString                 -> FileExt                 -> Verb-                -> M.Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), FileExtListenerT Response m ())+                -> M.Map Verb (Maybe (BL.ByteString -> m (), Maybe BodyLength), FileExtListenerT Response m ())                 -> Maybe Response                 -> m ResponseReceived     continueMap acceptBS f v vmap mnfResp = do@@ -240,7 +230,7 @@      handleUpload req reqbf respond r = do       body <- liftIO $ strictRequestBody req-      runReaderT reqbf body+      reqbf body       liftIO $ respond r      respond404 :: Maybe Response -> IO ResponseReceived

@@ -41,17 +41,8 @@     texts       = [".txt"]  newtype FileExts a = FileExts { unFileExts :: Map FileExt a }-  deriving (Show, Eq, Functor, Traversable)--deriving instance Monoid      (FileExts a)-deriving instance Foldable     FileExts-+  deriving (Show, Eq, Monoid, Functor, Foldable, Traversable)  newtype FileExtListenerT r m a =   FileExtListenerT { runFileExtListenerT :: WriterT (FileExts r) m a }-    deriving (Functor)--deriving instance Applicative m => Applicative (FileExtListenerT r m)-deriving instance Monad m =>       Monad       (FileExtListenerT r m)-deriving instance MonadIO m =>     MonadIO     (FileExtListenerT r m)-deriving instance                  MonadTrans  (FileExtListenerT r)+    deriving (Functor, Applicative, Monad, MonadIO, MonadTrans)

@@ -29,20 +29,14 @@  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 Verbs m r = Verbs { unVerbs :: Map Verb (Maybe (BL.ByteString -> m (), Maybe BodyLength), r) }+  deriving (Monoid, Functor, Foldable, Traversable) -newtype VerbListenerT z r m a =-  VerbListenerT { runVerbListenerT :: WriterT (Verbs z m r) m a }-    deriving (Functor)+newtype VerbListenerT r m a =+  VerbListenerT { runVerbListenerT :: WriterT (Verbs m r) m a }+    deriving (Functor, Applicative, Monad, MonadIO) -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+instance MonadTrans (VerbListenerT r) where   lift ma = VerbListenerT $ lift ma  @@ -50,55 +44,47 @@ foldMWithKey f i = foldlWithKey (\macc k a -> (\mer -> f mer k a) =<< macc) (return i)  -get :: (Monad m) =>-       a-    -> VerbListenerT z a m ()+get :: ( Monad m+       ) => r -> VerbListenerT r 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 :: ( Monad m+        , MonadIO m+        ) => (BL.ByteString -> m ()) -> r -> VerbListenerT r m () post handle r = do-  let new = singleton Post (Just (ReaderT handle, Nothing), r)+  let new = singleton Post (Just (handle, Nothing), r)   VerbListenerT $ tell $ Verbs new  -postMax :: (Monad m, MonadIO m) =>-           BodyLength-        -> (BL.ByteString -> m z)-        -> a-        -> VerbListenerT z a m ()+postMax :: ( Monad m+           , MonadIO m+           ) => BodyLength -> (BL.ByteString -> m ()) -> r -> VerbListenerT r m () postMax bl handle r = do-  let new = singleton Post (Just (ReaderT handle, Just bl), r)+  let new = singleton Post (Just (handle, Just bl), r)   VerbListenerT $ tell $ Verbs new  -put :: (Monad m, MonadIO m) =>-       (BL.ByteString -> m z)-    -> a-    -> VerbListenerT z a m ()+put :: ( Monad m+       , MonadIO m+       ) => (BL.ByteString -> m ()) -> r -> VerbListenerT r m () put handle r = do-  let new = singleton Put (Just (ReaderT handle, Nothing), r)+  let new = singleton Put (Just (handle, Nothing), r)   VerbListenerT $ tell $ Verbs new  -putMax :: (Monad m, MonadIO m) =>-          BodyLength-       -> (BL.ByteString -> m z)-       -> a-       -> VerbListenerT z a m ()+putMax :: ( Monad m+          , MonadIO m+          ) => BodyLength -> (BL.ByteString -> m ()) -> r -> VerbListenerT r m () putMax bl handle r = do-  let new = singleton Put (Just (ReaderT handle, Just bl), r)+  let new = singleton Put (Just (handle, Just bl), r)   VerbListenerT $ tell $ Verbs new  -delete :: (Monad m) =>-          a-       -> VerbListenerT z a m ()+delete :: ( Monad m+          ) => r -> VerbListenerT r m () delete r = do   let new = singleton Delete (Nothing, r)   VerbListenerT $ tell $ Verbs new