nested-routes 3.1.0 → 3.2.0

raw patch · 5 files changed

+44/−28 lines, 5 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 +9/−8
• src/Web/Routes/Nested/FileExtListener/Types.hs +1/−0
• src/Web/Routes/Nested/Types/UrlChunks.hs +7/−1
• src/Web/Routes/Nested/VerbListener.hs +26/−18

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

@@ -125,24 +125,25 @@ notFound _ Nothing Nothing = return ()  +type Application' m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived+ -- | Turns a @HandlerT@ into a Wai @Application@ route :: ( Functor m          , Monad m          , MonadIO m          ) => HandlerT (ActionT m ()) m a -- ^ Assembled @handle@ calls-           -> Request-           -> (Response -> IO ResponseReceived) -> m ResponseReceived+           -> Application' m route h req respond = do   (rtrie, nftrie) <- execWriterT $ runHandler h   let mMethod  = httpMethodToMSym $ requestMethod req       mFileext = case pathInfo req of                          [] -> Just Html-                         xs -> toExt $ T.pack $ dropWhile (/= '.') $ T.unpack $ last xs+                         xs -> toExt $ T.dropWhile (/= '.') $ last xs       mnftrans = P.lookupNearestParent (pathInfo req) nftrie       acceptBS = Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req       fe = fromMaybe Html mFileext -  notFoundBasic <- handleNotFound req acceptBS Html Get mnftrans+  notFoundBasic <- handleNotFound req acceptBS Html GET mnftrans    case mMethod of     Nothing -> liftIO $ respond404 notFoundBasic@@ -279,8 +280,8 @@         endsWithAny s xs = dropWhile (/= '.') s `elem` xs      httpMethodToMSym :: Method -> Maybe Verb-    httpMethodToMSym x | x == methodGet    = Just Get-                       | x == methodPost   = Just Post-                       | x == methodPut    = Just Put-                       | x == methodDelete = Just Delete+    httpMethodToMSym x | x == methodGet    = Just GET+                       | x == methodPost   = Just POST+                       | x == methodPut    = Just PUT+                       | x == methodDelete = Just DELETE                        | otherwise         = Nothing

@@ -19,6 +19,7 @@ import           Data.Traversable  +-- | Supported file extensions data FileExt = Html              | Css              | JavaScript

@@ -14,21 +14,25 @@ import qualified Data.Text as T  --- | Constrained to AttoParsec & T.Text+-- | Constrained to AttoParsec, Regex-Compat and T.Text data EitherUrlChunk (x :: Maybe *) where   (:=) :: T.Text             -> EitherUrlChunk 'Nothing   (:~) :: (T.Text, Parser r) -> EitherUrlChunk ('Just r)   (:*) :: (T.Text, Regex)    -> EitherUrlChunk ('Just [String]) +-- | Match against a /literal/ chunk l :: T.Text -> EitherUrlChunk 'Nothing l = (:=) +-- | Use raw strings instead of prepending @l@ instance x ~ 'Nothing => IsString (EitherUrlChunk x) where   fromString = l . T.pack +-- | Match against a /parsed/ chunk p :: (T.Text, Parser r) -> EitherUrlChunk ('Just r) p = (:~) +-- | Match against a /regular expression/ chunk r :: (T.Text, Regex) -> EitherUrlChunk ('Just [String]) r = (:*) @@ -37,10 +41,12 @@   Cons :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs) -- stack is left-to-right   Root  :: UrlChunks '[] +-- | Glue two chunks together (</>) :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs) (</>) = Cons  infixr 9 </> +-- | The /origin/ chunk - the equivalent to @./@ in BASH o :: UrlChunks '[] o = Root

@@ -11,6 +11,7 @@ module Web.Routes.Nested.VerbListener where  import           Network.Wai (Request)+import           Network.HTTP.Types (StdMethod (..))  import           Data.Foldable import           Data.Traversable@@ -23,11 +24,7 @@ import           Control.Monad.Writer  -data Verb = Get-          | Post-          | Put-          | Delete-  deriving (Show, Eq, Ord)+type Verb = StdMethod  type BodyLength = Word64 @@ -68,86 +65,97 @@ foldMWithKey f i = foldlWithKey (\macc k a -> (\mer -> f mer k a) =<< macc) (return i)  +-- | For simple @GET@ responses get :: ( Monad m        ) => r -> VerbListenerT r m () get r = do-  let new = singleton Get (Nothing, Left r)+  let new = singleton GET (Nothing, Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI getReq :: ( Monad m           ) => (Request -> r) -> VerbListenerT r m () getReq r = do-  let new = singleton Get (Nothing, Right r)+  let new = singleton GET (Nothing, Right r)   VerbListenerT $ tell $ Verbs new  +-- | For simple @POST@ responses post :: ( Monad m         , MonadIO m         ) => (BL.ByteString -> m ()) -> r -> VerbListenerT r m () post handle r = do-  let new = singleton Post (Just (handle, Nothing), Left r)+  let new = singleton POST (Just (handle, Nothing), Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI postReq :: ( Monad m            , MonadIO m            ) => (BL.ByteString -> m ()) -> (Request -> r) -> VerbListenerT r m () postReq handle r = do-  let new = singleton Post (Just (handle, Nothing), Right r)+  let new = singleton POST (Just (handle, Nothing), Right r)   VerbListenerT $ tell $ Verbs new -+-- | Supply a maximum size bound for file uploads postMax :: ( Monad m            , MonadIO m            ) => BodyLength -> (BL.ByteString -> m ()) -> r -> VerbListenerT r m () postMax bl handle r = do-  let new = singleton Post (Just (handle, Just bl), Left r)+  let new = singleton POST (Just (handle, Just bl), Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI postMaxReq :: ( Monad m               , MonadIO m               ) => BodyLength -> (BL.ByteString -> m ()) -> (Request -> r) -> VerbListenerT r m () postMaxReq bl handle r = do-  let new = singleton Post (Just (handle, Just bl), Right r)+  let new = singleton POST (Just (handle, Just bl), Right r)   VerbListenerT $ tell $ Verbs new  +-- | For simple @PUT@ responses put :: ( Monad m        , MonadIO m        ) => (BL.ByteString -> m ()) -> r -> VerbListenerT r m () put handle r = do-  let new = singleton Put (Just (handle, Nothing), Left r)+  let new = singleton PUT (Just (handle, Nothing), Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI putReq :: ( Monad m           , MonadIO m           ) => (BL.ByteString -> m ()) -> (Request -> r) -> VerbListenerT r m () putReq handle r = do-  let new = singleton Put (Just (handle, Nothing), Right r)+  let new = singleton PUT (Just (handle, Nothing), Right r)   VerbListenerT $ tell $ Verbs new +-- | Supply a maximum size bound for file uploads putMax :: ( Monad m           , MonadIO m           ) => BodyLength -> (BL.ByteString -> m ()) -> r -> VerbListenerT r m () putMax bl handle r = do-  let new = singleton Put (Just (handle, Just bl), Left r)+  let new = singleton PUT (Just (handle, Just bl), Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI putMaxReq :: ( Monad m              , MonadIO m              ) => BodyLength -> (BL.ByteString -> m ()) -> (Request -> r) -> VerbListenerT r m () putMaxReq bl handle r = do-  let new = singleton Put (Just (handle, Just bl), Right r)+  let new = singleton PUT (Just (handle, Just bl), Right r)   VerbListenerT $ tell $ Verbs new  +-- | For simple @DELETE@ responses delete :: ( Monad m           ) => r -> VerbListenerT r m () delete r = do-  let new = singleton Delete (Nothing, Left r)+  let new = singleton DELETE (Nothing, Left r)   VerbListenerT $ tell $ Verbs new +-- | Inspect the @Request@ object supplied by WAI deleteReq :: ( Monad m              ) => (Request -> r) -> VerbListenerT r m () deleteReq r = do-  let new = singleton Delete (Nothing, Right r)+  let new = singleton DELETE (Nothing, Right r)   VerbListenerT $ tell $ Verbs new