haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Replace ContT with MEitherT in Handler monad

Browse Source
This commit is contained in:
Michael Snoyman 2010-06-29 09:04:26 +03:00
parent e4dd6ddd2c
commit d2f0194163
2 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Yesod/Handler.hs
View File

@ -70,6 +70,7 @@ import Yesod.Content
import Yesod.Internal import Yesod.Internal
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Data.List (foldl', intercalate) import Data.List (foldl', intercalate)
import Data.Neither
import Control.Exception hiding (Handler, catch) import Control.Exception hiding (Handler, catch)
import qualified Control.Exception as E import qualified Control.Exception as E
@ -79,7 +80,6 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Class import Control.Monad.Trans.Class
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Control.Monad.Trans.Cont
import System.IO import System.IO
import qualified Network.Wai as W import qualified Network.Wai as W
@ -105,7 +105,7 @@ data HandlerData sub master = HandlerData
-- for headers, and an error-type monad for handling special responses. -- for headers, and an error-type monad for handling special responses.
type GHandler sub master = type GHandler sub master =
ReaderT (HandlerData sub master) ( ReaderT (HandlerData sub master) (
ContT HandlerContents ( MEitherT HandlerContents (
WriterT (Endo [Header]) ( WriterT (Endo [Header]) (
WriterT (Endo [(String, Maybe String)]) ( WriterT (Endo [(String, Maybe String)]) (
IO IO
@ -136,7 +136,7 @@ data HandlerContents =
| HCRedirect RedirectType String | HCRedirect RedirectType String
instance Failure ErrorResponse (GHandler sub master) where instance Failure ErrorResponse (GHandler sub master) where
failure = lift . ContT . const . return . HCError failure = lift . throwMEither . HCError
instance RequestReader (GHandler sub master) where instance RequestReader (GHandler sub master) where
getRequest = handlerRequest <$> ask getRequest = handlerRequest <$> ask
@ -194,12 +194,13 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
, handlerRender = mrender , handlerRender = mrender
, handlerToMaster = tomr , handlerToMaster = tomr
} }
((contents, headers), session') <- E.catch ( ((contents', headers), session') <- E.catch (
runWriterT runWriterT
$ runWriterT $ runWriterT
$ flip runContT (return . HCContent . chooseRep) $ runMEitherT
$ flip runReaderT hd handler $ flip runReaderT hd handler
) (\e -> return ((HCError $ toErrorHandler e, id), id)) ) (\e -> return ((MLeft $ HCError $ toErrorHandler e, id), id))
let contents = meither id (HCContent . chooseRep) contents'
let finalSession = foldl' modifySession (reqSession rr) $ session' [] let finalSession = foldl' modifySession (reqSession rr) $ session' []
let handleError e = do let handleError e = do
(_, hs, ct, c, sess) <- unYesodApp (eh e) safeEh rr cts (_, hs, ct, c, sess) <- unYesodApp (eh e) safeEh rr cts
@ -260,7 +261,7 @@ redirectParams rt url params = do
-- | Redirect to the given URL. -- | Redirect to the given URL.
redirectString :: RedirectType -> String -> GHandler sub master a redirectString :: RedirectType -> String -> GHandler sub master a
redirectString rt url = lift $ ContT $ const $ return $ HCRedirect rt url redirectString rt url = lift $ throwMEither $ HCRedirect rt url
ultDestKey :: String ultDestKey :: String
ultDestKey = "_ULT" ultDestKey = "_ULT"
@ -323,7 +324,7 @@ getMessage = do
-- For some backends, this is more efficient than reading in the file to -- For some backends, this is more efficient than reading in the file to
-- memory, since they can optimize file sending via a system call to sendfile. -- memory, since they can optimize file sending via a system call to sendfile.
sendFile :: ContentType -> FilePath -> GHandler sub master a sendFile :: ContentType -> FilePath -> GHandler sub master a
sendFile ct fp = lift $ ContT $ const $ return $ HCSendFile ct fp sendFile ct fp = lift $ throwMEither $ HCSendFile ct fp
-- | Return a 404 not found page. Also denotes no handler available. -- | Return a 404 not found page. Also denotes no handler available.
notFound :: Failure ErrorResponse m => m a notFound :: Failure ErrorResponse m => m a

3
yesod.cabal
View File

@ -40,7 +40,8 @@ library
control-monad-attempt >= 0.3 && < 0.4, control-monad-attempt >= 0.3 && < 0.4,
cereal >= 0.2 && < 0.3, cereal >= 0.2 && < 0.3,
old-locale >= 1.0.0.2 && < 1.1, old-locale >= 1.0.0.2 && < 1.1,
persistent >= 0.1.0 && < 0.2 persistent >= 0.1.0 && < 0.2,
neither >= 0.0.0 && < 0.1
exposed-modules: Yesod exposed-modules: Yesod
Yesod.Content Yesod.Content
Yesod.Dispatch Yesod.Dispatch