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

MEitherT -> ErrorT

Browse Source
This commit is contained in:
Michael Snoyman 2010-12-30 06:13:46 +02:00
parent 3a5969b8e8
commit 5c730104c8
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Yesod/Handler.hs
View File

@ -95,7 +95,6 @@ module Yesod.Handler
import Prelude hiding (catch) import Prelude hiding (catch)
import Yesod.Request import Yesod.Request
import Yesod.Internal import Yesod.Internal
import Data.Neither
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Control.Exception hiding (Handler, catch, finally) import Control.Exception hiding (Handler, catch, finally)
@ -107,6 +106,7 @@ 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.State import Control.Monad.Trans.State
import Control.Monad.Trans.Error (throwError, ErrorT (runErrorT), Error (..))
import System.IO import System.IO
import qualified Network.Wai as W import qualified Network.Wai as W
@ -211,7 +211,7 @@ newtype GHandler sub master a =
type GHInner s m = type GHInner s m =
ReaderT (HandlerData s m) ( ReaderT (HandlerData s m) (
MEitherT HandlerContents ( ErrorT HandlerContents (
WriterT (Endo [Header]) ( WriterT (Endo [Header]) (
StateT SessionMap ( -- session StateT SessionMap ( -- session
IO IO
@ -245,8 +245,11 @@ data HandlerContents =
| HCCreated String | HCCreated String
| HCEnum (forall a. W.ResponseEnumerator a) | HCEnum (forall a. W.ResponseEnumerator a)
instance Error HandlerContents where
strMsg = HCError . InternalError
instance Failure ErrorResponse (GHandler sub master) where instance Failure ErrorResponse (GHandler sub master) where
failure = GHandler . lift . throwMEither . HCError failure = GHandler . lift . throwError . HCError
instance RequestReader (GHandler sub master) where instance RequestReader (GHandler sub master) where
getRequest = handlerRequest <$> GHandler ask getRequest = handlerRequest <$> GHandler ask
@ -304,11 +307,11 @@ runHandler handler mrender sroute tomr ma tosa =
((contents', headers), finalSession) <- E.catch ( ((contents', headers), finalSession) <- E.catch (
flip runStateT initSession flip runStateT initSession
$ runWriterT $ runWriterT
$ runMEitherT $ runErrorT
$ flip runReaderT hd $ flip runReaderT hd
$ unGHandler handler $ unGHandler handler
) (\e -> return ((MLeft $ HCError $ toErrorHandler e, id), initSession)) ) (\e -> return ((Left $ HCError $ toErrorHandler e, id), initSession))
let contents = meither id (HCContent W.status200 . chooseRep) contents' let contents = either id (HCContent W.status200 . chooseRep) contents'
let handleError e = do let handleError e = do
yar <- unYesodApp (eh e) safeEh rr cts finalSession yar <- unYesodApp (eh e) safeEh rr cts finalSession
case yar of case yar of
@ -364,7 +367,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 = GHandler . lift . throwMEither . HCRedirect rt redirectString rt = GHandler . lift . throwError . HCRedirect rt
ultDestKey :: String ultDestKey :: String
ultDestKey = "_ULT" ultDestKey = "_ULT"
@ -433,18 +436,18 @@ 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 = GHandler . lift . throwMEither . HCSendFile ct sendFile ct = GHandler . lift . throwError . HCSendFile ct
-- | Bypass remaining handler code and output the given content with a 200 -- | Bypass remaining handler code and output the given content with a 200
-- status code. -- status code.
sendResponse :: HasReps c => c -> GHandler sub master a sendResponse :: HasReps c => c -> GHandler sub master a
sendResponse = GHandler . lift . throwMEither . HCContent W.status200 sendResponse = GHandler . lift . throwError . HCContent W.status200
. chooseRep . chooseRep
-- | Bypass remaining handler code and output the given content with the given -- | Bypass remaining handler code and output the given content with the given
-- status code. -- status code.
sendResponseStatus :: HasReps c => W.Status -> c -> GHandler s m a sendResponseStatus :: HasReps c => W.Status -> c -> GHandler s m a
sendResponseStatus s = GHandler . lift . throwMEither . HCContent s sendResponseStatus s = GHandler . lift . throwError . HCContent s
. chooseRep . chooseRep
-- | Send a 201 "Created" response with the given route as the Location -- | Send a 201 "Created" response with the given route as the Location
@ -452,7 +455,7 @@ sendResponseStatus s = GHandler . lift . throwMEither . HCContent s
sendResponseCreated :: Route m -> GHandler s m a sendResponseCreated :: Route m -> GHandler s m a
sendResponseCreated url = do sendResponseCreated url = do
r <- getUrlRender r <- getUrlRender
GHandler $ lift $ throwMEither $ HCCreated $ r url GHandler $ lift $ throwError $ HCCreated $ r url
-- | Send a 'W.ResponseEnumerator'. Please note: this function is rarely -- | Send a 'W.ResponseEnumerator'. Please note: this function is rarely
-- necessary, and will /disregard/ any changes to response headers and session -- necessary, and will /disregard/ any changes to response headers and session
@ -460,7 +463,7 @@ sendResponseCreated url = do
-- considered only for they specific needs. If you are not sure if you need it, -- considered only for they specific needs. If you are not sure if you need it,
-- you don't. -- you don't.
sendResponseEnumerator :: (forall a. W.ResponseEnumerator a) -> GHandler s m b sendResponseEnumerator :: (forall a. W.ResponseEnumerator a) -> GHandler s m b
sendResponseEnumerator = GHandler . lift . throwMEither . HCEnum sendResponseEnumerator = GHandler . lift . throwError . HCEnum
-- | 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

1
yesod-core.cabal
View File

@ -41,7 +41,6 @@ library
, random >= 1.0.0.2 && < 1.1 , random >= 1.0.0.2 && < 1.1
, cereal >= 0.2 && < 0.4 , cereal >= 0.2 && < 0.4
, old-locale >= 1.0.0.2 && < 1.1 , old-locale >= 1.0.0.2 && < 1.1
, neither >= 0.2 && < 0.3
, web-routes >= 0.23 && < 0.24 , web-routes >= 0.23 && < 0.24
, failure >= 0.1 && < 0.2 , failure >= 0.1 && < 0.2
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5