wai-middleware-verbs 0.3.0 → 0.3.1

raw patch · 2 files changed

+19/−11 lines, 2 files

Files

• src/Network/Wai/Middleware/Verbs.hs +18/−10
• wai-middleware-verbs.cabal +1/−1

@@ -61,10 +61,8 @@ import qualified Data.HashMap.Lazy                    as HM import           Data.Monoid import           Data.Hashable-import           Control.Arrow (second) import           Control.Applicative import           Control.Monad.Trans-import           Control.Monad.Trans.Maybe import           Control.Monad.State hiding (get, put) import qualified Control.Monad.State                  as S import           Control.Monad.Reader@@ -83,8 +81,14 @@ -- * Types  -- | A map from an HTTP verb, to a result and uploading method.-type VerbMap r = HashMap Verb r+newtype VerbMap r = VerbMap+  { getVerbMap :: HashMap Verb r+  } deriving (Functor) +instance Monoid r => Monoid (VerbMap r) where+  mempty = VerbMap mempty+  mappend (VerbMap x) (VerbMap y) = VerbMap $ HM.unionWith (<>) x y+ type Verb = StdMethod  deriving instance Generic Verb@@ -107,7 +111,7 @@  -- | Take the monadic partial result of @lookupVerb@, and actually h the upload. lookupVerb :: Verb -> VerbMap r -> Maybe r-lookupVerb = HM.lookup+lookupVerb v = HM.lookup v . getVerbMap  {-# INLINEABLE lookupVerb #-} @@ -135,7 +139,7 @@  deriving instance (MonadResource m, MonadBase IO m) => MonadResource (VerbListenerT r m) -execVerbListenerT :: Monad m => VerbListenerT r m a -> m (VerbMap r)+execVerbListenerT :: (Monad m, Monoid r) => VerbListenerT r m a -> m (VerbMap r) execVerbListenerT xs = execStateT (runVerbListenerT xs) mempty  {-# INLINEABLE execVerbListenerT #-}@@ -149,29 +153,33 @@  -- | For simple @GET@ responses get :: ( Monad m+       , Monoid r        ) => r -> VerbListenerT r m ()-get r = tell' $! HM.singleton GET r+get r = tell' . VerbMap $ HM.singleton GET r  {-# INLINEABLE get #-}  -- | For simple @POST@ responses post :: ( Monad m+        , Monoid r         ) => r -> VerbListenerT r m ()-post r = tell' $! HM.singleton POST r+post r = tell' . VerbMap $ HM.singleton POST r  {-# INLINEABLE post #-}  -- | For simple @PUT@ responses put :: ( Monad m+       , Monoid r        ) => r -> VerbListenerT r m ()-put r = tell' $! HM.singleton PUT r+put r = tell' . VerbMap $ HM.singleton PUT r  {-# INLINEABLE put #-}  -- | For simple @DELETE@ responses delete :: ( Monad m+          , Monoid r           ) => r -> VerbListenerT r m ()-delete r = tell' $! HM.singleton DELETE r+delete r = tell' . VerbMap $ HM.singleton DELETE r  {-# INLINEABLE delete #-} @@ -180,7 +188,7 @@  {-# INLINEABLE tell' #-} -mapVerbs :: Monad m => (r -> s) ->  VerbListenerT r m () -> VerbListenerT s m ()+mapVerbs :: (Monad m, Monoid r, Monoid s) => (r -> s) ->  VerbListenerT r m () -> VerbListenerT s m () mapVerbs f xs = do   vmap <- lift $ execVerbListenerT xs   tell' $ f <$> vmap

@@ -1,5 +1,5 @@ Name:                   wai-middleware-verbs-Version:                0.3.0+Version:                0.3.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3