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

More code movement

Browse Source
This commit is contained in:
Michael Snoyman 2013-03-12 10:30:34 +02:00
parent 845258e544
commit 062efc9ae3
2 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
yesod-core/Yesod/Core/Internal/Response.hs
View File

@ -16,6 +16,12 @@ import Prelude hiding (catch)
import Web.Cookie (renderSetCookie) import Web.Cookie (renderSetCookie)
import Yesod.Core.Content import Yesod.Core.Content
import Yesod.Core.Types import Yesod.Core.Types
import qualified Network.HTTP.Types as H
import qualified Data.Text as T
import Control.Exception (SomeException, handle)
import Blaze.ByteString.Builder (fromLazyByteString,
toLazyByteString)
import qualified Data.ByteString.Lazy as L
yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response
yarToResponse (YRWai a) _ = a yarToResponse (YRWai a) _ = a
@ -49,3 +55,19 @@ headerToPair (DeleteCookie key path) =
] ]
) )
headerToPair (Header key value) = (CI.mk key, value) headerToPair (Header key value) = (CI.mk key, value)
evaluateContent :: Content -> IO (Either ErrorResponse Content)
evaluateContent (ContentBuilder b mlen) = handle f $ do
let lbs = toLazyByteString b
L.length lbs `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen)
where
f :: SomeException -> IO (Either ErrorResponse Content)
f = return . Left . InternalError . T.pack . show
evaluateContent c = return (Right c)
getStatus :: ErrorResponse -> H.Status
getStatus NotFound = H.status404
getStatus (InternalError _) = H.status500
getStatus (InvalidArgs _) = H.status400
getStatus (PermissionDenied _) = H.status403
getStatus (BadMethod _) = H.status405

23
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -6,11 +6,9 @@
module Yesod.Core.Internal.Run where module Yesod.Core.Internal.Run where
import Yesod.Core.Internal.Response import Yesod.Core.Internal.Response
import Blaze.ByteString.Builder (fromLazyByteString, toByteString, import Blaze.ByteString.Builder (toByteString)
toLazyByteString)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (SomeException, fromException, import Control.Exception (fromException)
handle)
import Control.Exception.Lifted (catch) import Control.Exception.Lifted (catch)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -19,7 +17,6 @@ import Control.Monad.Logger (LogLevel (LevelError), LogSource,
import Control.Monad.Trans.Resource (runResourceT) import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.IORef as I import qualified Data.IORef as I
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (isJust) import Data.Maybe (isJust)
@ -137,22 +134,6 @@ safeEh log' er req = do
(toContent ("Internal Server Error" :: S.ByteString)) (toContent ("Internal Server Error" :: S.ByteString))
(reqSession req) (reqSession req)
evaluateContent :: Content -> IO (Either ErrorResponse Content)
evaluateContent (ContentBuilder b mlen) = Control.Exception.handle f $ do
let lbs = toLazyByteString b
L.length lbs `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen)
where
f :: SomeException -> IO (Either ErrorResponse Content)
f = return . Left . InternalError . T.pack . show
evaluateContent c = return (Right c)
getStatus :: ErrorResponse -> H.Status
getStatus NotFound = H.status404
getStatus (InternalError _) = H.status500
getStatus (InvalidArgs _) = H.status400
getStatus (PermissionDenied _) = H.status403
getStatus (BadMethod _) = H.status405
-- | Run a 'GHandler' completely outside of Yesod. This -- | Run a 'GHandler' completely outside of Yesod. This
-- function comes with many caveats and you shouldn't use it -- function comes with many caveats and you shouldn't use it
-- unless you fully understand what it's doing and how it works. -- unless you fully understand what it's doing and how it works.