happstack-server 6.4.4 → 6.4.5

raw patch · 3 files changed

+63/−8 lines, 3 filesdep +monad-controldep +transformersdep +transformers-basedep −MaybeTPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: monad-control, transformers, transformers-base

Dependencies removed: MaybeT

API changes (from Hackage documentation)

Files

• happstack-server.cabal +4/−2
• src/Happstack/Server/Internal/Monads.hs +55/−2
• src/Happstack/Server/RqData.hs +4/−4

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             6.4.4+Version:             6.4.5 Synopsis:            Web related tools and services. Description:         Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License:             BSD3@@ -88,7 +88,7 @@                        hslogger >= 1.0.2,                        happstack-data >= 6.0 && < 6.1,                        html,-                       MaybeT,+                       monad-control >= 0.3 && < 0.4,                        mtl >= 1.1 && < 2.1,                        old-locale,                        old-time,@@ -98,6 +98,8 @@                        template-haskell,                        text >= 0.10 && < 0.12,                        time,+                       transformers >= 0.1.3 && < 0.3,+                       transformers-base >= 0.4 && < 0.5,                        utf8-string >= 0.3.4 && < 0.4,                        xhtml,                        zlib

@@ -7,9 +7,14 @@  import Control.Monad                             ( MonadPlus(mzero, mplus), ap, liftM, msum                                                  )+import Control.Monad.Base                        ( MonadBase, liftBase ) import Control.Monad.Trans                       ( MonadTrans, lift                                                  , MonadIO, liftIO                                                  )+import Control.Monad.Trans.Control               ( MonadTransControl(..)+                                                 , MonadBaseControl(..)+                                                 , ComposeSt, defaultLiftBaseWith, defaultRestoreM+                                                 ) import Control.Monad.Reader                      ( ReaderT(ReaderT), runReaderT                                                  , MonadReader, ask, local                                                  )@@ -23,7 +28,7 @@                                                  , Error, MonadError, throwError                                                  , catchError, mapErrorT                                                  )-import Control.Monad.Maybe                       (MaybeT(MaybeT), runMaybeT)+import Control.Monad.Trans.Maybe                 (MaybeT(MaybeT), runMaybeT) import qualified Data.ByteString.Lazy.UTF8       as LU (fromString) import Data.Char                                 (ord) import Data.List                                 (inits, isPrefixOf, stripPrefix, tails)@@ -48,10 +53,25 @@ newtype ServerPartT m a = ServerPartT { unServerPartT :: ReaderT Request (WebT m) a }     deriving (Monad, MonadPlus, Functor) +instance MonadBase b m => MonadBase b (ServerPartT m) where+    liftBase = lift . liftBase+ instance (MonadIO m) => MonadIO (ServerPartT m) where     liftIO = ServerPartT . liftIO     {-# INLINE liftIO #-} +instance MonadTransControl ServerPartT where+    newtype StT ServerPartT a = StSP {unStSP :: StT WebT (StT (ReaderT Request) a)}+    liftWith f = ServerPartT $ liftWith $ \runReader ->+                                 liftWith $ \runWeb ->+                                   f $ liftM StSP . runWeb . runReader . unServerPartT+    restoreT = ServerPartT . restoreT . restoreT . liftM unStSP++instance MonadBaseControl b m => MonadBaseControl b (ServerPartT m) where+    newtype StM (ServerPartT m) b = StMSP {unStMSP :: ComposeSt ServerPartT m b}+    liftBaseWith = defaultLiftBaseWith StMSP+    restoreM     = defaultRestoreM     unStMSP+ -- | Particularly useful when combined with 'runWebT' to produce -- a @m ('Maybe' 'Response')@ from a 'Request'. runServerPartT :: ServerPartT m a -> Request -> WebT m a@@ -228,12 +248,25 @@ filterFun = Set . Dual . Endo  newtype FilterT a m b = FilterT { unFilterT :: WriterT (FilterFun a) m b }-   deriving (Monad, MonadTrans, Functor)+   deriving (Functor, Applicative, Monad, MonadTrans) +instance MonadBase b m => MonadBase b (FilterT a m) where+    liftBase = lift . liftBase+ instance (MonadIO m) => MonadIO (FilterT a m) where     liftIO = FilterT . liftIO     {-# INLINE liftIO #-} +instance MonadTransControl (FilterT a) where+    newtype StT (FilterT a) b = StFilter {unStFilter :: StT (WriterT (FilterFun a)) b}+    liftWith f = FilterT $ liftWith $ \run -> f $ liftM StFilter . run . unFilterT+    restoreT = FilterT . restoreT . liftM unStFilter++instance MonadBaseControl b m => MonadBaseControl b (FilterT a m) where+    newtype StM (FilterT a m) b = StMFilter {unStMFilter :: ComposeSt (FilterT a) m b}+    liftBaseWith = defaultLiftBaseWith StMFilter+    restoreM     = defaultRestoreM     unStMFilter+ -- | A set of functions for manipulating filters.   -- -- 'ServerPartT' implements 'FilterMonad' 'Response' so these methods@@ -270,9 +303,29 @@ newtype WebT m a = WebT { unWebT :: ErrorT Response (FilterT (Response) (MaybeT m)) a }     deriving (Functor) +instance MonadBase b m => MonadBase b (WebT m) where+    liftBase = lift . liftBase+ instance (MonadIO m) => MonadIO (WebT m) where     liftIO = WebT . liftIO     {-# INLINE liftIO #-}++instance MonadTransControl WebT where+    newtype StT WebT a = StWeb {unStWeb :: StT MaybeT+                                             (StT (FilterT Response)+                                               (StT (ErrorT Response) a))}+    liftWith f = WebT $ liftWith $ \runError ->+                          liftWith $ \runFilter ->+                            liftWith $ \runMaybe ->+                              f $ liftM StWeb . runMaybe .+                                                  runFilter .+                                                    runError . unWebT+    restoreT = WebT . restoreT . restoreT . restoreT . liftM unStWeb++instance MonadBaseControl b m => MonadBaseControl b (WebT m) where+    newtype StM (WebT m) b = StMWeb {unStMWeb :: ComposeSt WebT m b}+    liftBaseWith = defaultLiftBaseWith StMWeb+    restoreM     = defaultRestoreM     unStMWeb  -- | 'UnWebT' is almost exclusively used with 'mapServerPartT'. If you -- are not using 'mapServerPartT' then you do not need to wrap your

@@ -526,7 +526,7 @@ -- -- NOTE: you must call 'decodeBody' prior to calling this function if -- the request method is POST or PUT.-getDataFn :: (HasRqData m, ServerMonad m, MonadIO m) => +getDataFn :: (HasRqData m, ServerMonad m) =>              RqData a -- ^ 'RqData' monad to evaluate           -> m (Either [String] a) -- ^ return 'Left' errors or 'Right' a getDataFn rqData =@@ -538,7 +538,7 @@ --  -- NOTE: you must call 'decodeBody' prior to calling this function if -- the request method is POST or PUT.-withDataFn :: (HasRqData m, MonadIO m, MonadPlus m, ServerMonad m) => RqData a -> (a -> m r) -> m r+withDataFn :: (HasRqData m, MonadPlus m, ServerMonad m) => RqData a -> (a -> m r) -> m r withDataFn fn handle = getDataFn fn >>= either (const mzero) handle  -- | A variant of 'getDataFn' that uses 'FromData' to chose your@@ -568,14 +568,14 @@ -- -- NOTE: you must call 'decodeBody' prior to calling this function if -- the request method is POST or PUT.-getData :: (HasRqData m, MonadIO m, ServerMonad m, FromData a) => m (Either [String] a)+getData :: (HasRqData m, ServerMonad m, FromData a) => m (Either [String] a) getData = getDataFn fromData  -- | similar to 'getData' except it calls a subhandler on success or 'mzero' on failure. -- -- NOTE: you must call 'decodeBody' prior to calling this function if -- the request method is POST or PUT.-withData :: (HasRqData m, MonadIO m, FromData a, MonadPlus m, ServerMonad m) => (a -> m r) -> m r+withData :: (HasRqData m, FromData a, MonadPlus m, ServerMonad m) => (a -> m r) -> m r withData = withDataFn fromData  -- | limit the scope to the Request body