diff --git a/yesod-core/Yesod/Content.hs b/yesod-core/Yesod/Content.hs index 6244474c..292859ac 100644 --- a/yesod-core/Yesod/Content.hs +++ b/yesod-core/Yesod/Content.hs @@ -54,7 +54,6 @@ import System.Locale import qualified Data.Text.Encoding import qualified Data.Text.Lazy.Encoding -import Data.Enumerator (Enumerator) import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString) import Data.Monoid (mempty) @@ -62,9 +61,10 @@ import Text.Hamlet (Html) import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder) import Data.String (IsString (fromString)) import Network.Wai (FilePart) +import Data.Conduit (Source) data Content = ContentBuilder Builder (Maybe Int) -- ^ The content and optional content length. - | ContentEnum (forall a. Enumerator Builder IO a) + | ContentSource (Source IO Builder) | ContentFile FilePath (Maybe FilePart) -- | Zero-length enumerator. diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 4a78bec7..d96d656b 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -34,7 +34,6 @@ module Yesod.Core , module Yesod.Request , module Yesod.Widget , module Yesod.Message - , module Yesod.Config ) where import Yesod.Internal.Core @@ -44,7 +43,6 @@ import Yesod.Handler import Yesod.Request import Yesod.Widget import Yesod.Message -import Yesod.Config import Language.Haskell.TH.Syntax import Data.Text (Text) diff --git a/yesod-core/Yesod/Dispatch.hs b/yesod-core/Yesod/Dispatch.hs index abe49064..a5998bfc 100644 --- a/yesod-core/Yesod/Dispatch.hs +++ b/yesod-core/Yesod/Dispatch.hs @@ -15,8 +15,8 @@ module Yesod.Dispatch , mkYesodDispatch , mkYesodSubDispatch -- ** Path pieces - , SinglePiece (..) - , MultiPiece (..) + , PathPiece (..) + , PathMultiPiece (..) , Texts -- * Convert to WAI , toWaiApp @@ -31,7 +31,7 @@ import Yesod.Handler import Yesod.Internal.Dispatch import Yesod.Widget (GWidget) -import Web.PathPieces (SinglePiece (..), MultiPiece (..)) +import Web.PathPieces import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesNoCheck, parseRoutesFile, parseRoutesFileNoCheck) import Language.Haskell.TH.Syntax diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index bd7d30ea..7538429a 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -28,7 +28,7 @@ module Yesod.Handler , YesodSubRoute (..) -- * Handler monad , GHandler - , GGHandler + , GHandlerT -- ** Read information from handler , getYesod , getYesodSub @@ -148,8 +148,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Map as Map import qualified Data.ByteString as S -import Data.ByteString (ByteString) -import Data.Enumerator (Iteratee (..), run_, ($$)) import Network.Wai.Parse (parseHttpAccept) import Yesod.Content @@ -165,12 +163,15 @@ import Data.Text (Text) import Yesod.Message (RenderMessage (..)) import Text.Blaze (toHtml, preEscapedText) -import Yesod.Internal.TestApi (catchIter) import qualified Yesod.Internal.Cache as Cache import Yesod.Internal.Cache (mkCacheKey, CacheKey) import Data.Typeable (Typeable) import qualified Data.IORef as I +import Control.Monad.Trans.Resource (ResourceT) +import Control.Exception.Lifted (catch) +import Network.Wai (requestBody) +import Data.Conduit (($$)) -- | The type-safe URLs associated with a site argument. type family Route a @@ -206,22 +207,22 @@ handlerSubDataMaybe tm ts route hd = hd , handlerRoute = route } -get :: MonadIO monad => GGHandler sub master monad GHState +get :: MonadIO monad => GHandlerT sub master monad GHState get = do hd <- ask liftIO $ I.readIORef $ handlerState hd -put :: MonadIO monad => GHState -> GGHandler sub master monad () +put :: MonadIO monad => GHState -> GHandlerT sub master monad () put g = do hd <- ask liftIO $ I.writeIORef (handlerState hd) g -modify :: MonadIO monad => (GHState -> GHState) -> GGHandler sub master monad () +modify :: MonadIO monad => (GHState -> GHState) -> GHandlerT sub master monad () modify f = do hd <- ask liftIO $ I.atomicModifyIORef (handlerState hd) $ \g -> (f g, ()) -tell :: MonadIO monad => Endo [Header] -> GGHandler sub master monad () +tell :: MonadIO monad => Endo [Header] -> GHandlerT sub master monad () tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs } -- | Used internally for promoting subsite handler functions to master site @@ -229,16 +230,16 @@ tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs } toMasterHandler :: (Route sub -> Route master) -> (master -> sub) -> Route sub - -> GGHandler sub master mo a - -> GGHandler sub' master mo a + -> GHandlerT sub master mo a + -> GHandlerT sub' master mo a toMasterHandler tm ts route = withReaderT (handlerSubData tm ts route) toMasterHandlerDyn :: Monad mo => (Route sub -> Route master) - -> GGHandler sub' master mo sub + -> GHandlerT sub' master mo sub -> Route sub - -> GGHandler sub master mo a - -> GGHandler sub' master mo a + -> GHandlerT sub master mo a + -> GHandlerT sub' master mo a toMasterHandlerDyn tm getSub route h = do sub <- getSub withReaderT (handlerSubData tm (const sub) route) h @@ -258,8 +259,8 @@ instance (anySub ~ anySub' toMasterHandlerMaybe :: (Route sub -> Route master) -> (master -> sub) -> Maybe (Route sub) - -> GGHandler sub master mo a - -> GGHandler sub' master mo a + -> GHandlerT sub master mo a + -> GHandlerT sub' master mo a toMasterHandlerMaybe tm ts route = withReaderT (handlerSubDataMaybe tm ts route) -- | A generic handler monad, which can have a different subsite and master @@ -267,9 +268,9 @@ toMasterHandlerMaybe tm ts route = withReaderT (handlerSubDataMaybe tm ts route) -- 'WriterT' for headers and session, and an 'MEitherT' monad for handling -- special responses. It is declared as a newtype to make compiler errors more -- readable. -type GGHandler sub master = ReaderT (HandlerData sub master) +type GHandlerT sub master = ReaderT (HandlerData sub master) -type GHandler sub master = GGHandler sub master (Iteratee ByteString IO) +type GHandler sub master = GHandlerT sub master (ResourceT IO) data GHState = GHState { ghsSession :: SessionMap @@ -290,7 +291,7 @@ newtype YesodApp = YesodApp -> Request -> [ContentType] -> SessionMap - -> Iteratee ByteString IO YesodAppResult + -> ResourceT IO YesodAppResult } data YesodAppResult @@ -310,10 +311,10 @@ instance Show HandlerContents where show _ = "Cannot show a HandlerContents" instance Exception HandlerContents -getRequest :: Monad mo => GGHandler s m mo Request +getRequest :: Monad mo => GHandlerT s m mo Request getRequest = handlerRequest `liftM` ask -instance MonadIO monad => Failure ErrorResponse (GGHandler sub master monad) where +instance MonadIO monad => Failure ErrorResponse (GHandlerT sub master monad) where failure = liftIO . throwIO . HCError runRequestBody :: GHandler s m RequestBodyContents @@ -327,9 +328,9 @@ runRequestBody = do put x { ghsRBC = Just rbc } return rbc -rbHelper :: W.Request -> Iteratee ByteString IO RequestBodyContents +rbHelper :: W.Request -> ResourceT IO RequestBodyContents rbHelper req = - (map fix1 *** map fix2) <$> iter + (map fix1 *** map fix2) <$> (requestBody req $$ iter) where iter = NWP.parseRequestBody NWP.lbsSink req fix1 = go *** go @@ -338,15 +339,15 @@ rbHelper req = go = decodeUtf8With lenientDecode -- | Get the sub application argument. -getYesodSub :: Monad m => GGHandler sub master m sub +getYesodSub :: Monad m => GHandlerT sub master m sub getYesodSub = handlerSub `liftM` ask -- | Get the master site appliation argument. -getYesod :: Monad m => GGHandler sub master m master +getYesod :: Monad m => GHandlerT sub master m master getYesod = handlerMaster `liftM` ask -- | Get the URL rendering function. -getUrlRender :: Monad m => GGHandler sub master m (Route master -> Text) +getUrlRender :: Monad m => GHandlerT sub master m (Route master -> Text) getUrlRender = do x <- handlerRender `liftM` ask return $ flip x [] @@ -354,17 +355,17 @@ getUrlRender = do -- | The URL rendering function with query-string parameters. getUrlRenderParams :: Monad m - => GGHandler sub master m (Route master -> [(Text, Text)] -> Text) + => GHandlerT sub master m (Route master -> [(Text, Text)] -> Text) getUrlRenderParams = handlerRender `liftM` ask -- | Get the route requested by the user. If this is a 404 response- where the -- user requested an invalid route- this function will return 'Nothing'. -getCurrentRoute :: Monad m => GGHandler sub master m (Maybe (Route sub)) +getCurrentRoute :: Monad m => GHandlerT sub master m (Maybe (Route sub)) getCurrentRoute = handlerRoute `liftM` ask -- | Get the function to promote a route for a subsite to a route for the -- master site. -getRouteToMaster :: Monad m => GGHandler sub master m (Route sub -> Route master) +getRouteToMaster :: Monad m => GHandlerT sub master m (Route sub -> Route master) getRouteToMaster = handlerToMaster `liftM` ask -- | Function used internally by Yesod in the process of converting a @@ -399,7 +400,7 @@ runHandler handler mrender sroute tomr master sub = , handlerToMaster = tomr , handlerState = istate } - contents' <- catchIter (fmap Right $ runReaderT handler hd) + contents' <- catch (fmap Right $ runReaderT handler hd) (\e -> return $ Left $ maybe (HCError $ toErrorHandler e) id $ fromException e) state <- liftIO $ I.readIORef istate @@ -425,7 +426,7 @@ runHandler handler mrender sroute tomr master sub = return $ YARPlain (getRedirectStatus rt $ reqWaiRequest rr) hs typePlain emptyContent finalSession - HCSendFile ct fp p -> catchIter + HCSendFile ct fp p -> catch (sendFile' ct fp p) (handleError . toErrorHandler) HCCreated loc -> do @@ -449,19 +450,19 @@ safeEh er = YesodApp $ \_ _ _ session -> do session -- | Redirect to the given route. -redirect :: MonadIO mo => RedirectType -> Route master -> GGHandler sub master mo a +redirect :: MonadIO mo => RedirectType -> Route master -> GHandlerT sub master mo a redirect rt url = redirectParams rt url [] -- | Redirects to the given route with the associated query-string parameters. redirectParams :: MonadIO mo => RedirectType -> Route master -> [(Text, Text)] - -> GGHandler sub master mo a + -> GHandlerT sub master mo a redirectParams rt url params = do r <- getUrlRenderParams redirectString rt $ r url params -- | Redirect to the given URL. -redirectString, redirectText :: MonadIO mo => RedirectType -> Text -> GGHandler sub master mo a +redirectString, redirectText :: MonadIO mo => RedirectType -> Text -> GHandlerT sub master mo a redirectText rt = liftIO . throwIO . HCRedirect rt redirectString = redirectText {-# DEPRECATED redirectString "Use redirectText instead" #-} @@ -473,16 +474,16 @@ ultDestKey = "_ULT" -- -- An ultimate destination is stored in the user session and can be loaded -- later by 'redirectUltDest'. -setUltDest :: MonadIO mo => Route master -> GGHandler sub master mo () +setUltDest :: MonadIO mo => Route master -> GHandlerT sub master mo () setUltDest dest = do render <- getUrlRender setUltDestString $ render dest -- | Same as 'setUltDest', but use the given string. -setUltDestText :: MonadIO mo => Text -> GGHandler sub master mo () +setUltDestText :: MonadIO mo => Text -> GHandlerT sub master mo () setUltDestText = setSession ultDestKey -setUltDestString :: MonadIO mo => Text -> GGHandler sub master mo () +setUltDestString :: MonadIO mo => Text -> GHandlerT sub master mo () setUltDestString = setSession ultDestKey {-# DEPRECATED setUltDestString "Use setUltDestText instead" #-} @@ -490,7 +491,7 @@ setUltDestString = setSession ultDestKey -- -- If this is a 404 handler, there is no current page, and then this call does -- nothing. -setUltDest' :: MonadIO mo => GGHandler sub master mo () +setUltDest' :: MonadIO mo => GHandlerT sub master mo () setUltDest' = do route <- getCurrentRoute case route of @@ -504,7 +505,7 @@ setUltDest' = do -- | Sets the ultimate destination to the referer request header, if present. -- -- This function will not overwrite an existing ultdest. -setUltDestReferer :: MonadIO mo => GGHandler sub master mo () +setUltDestReferer :: MonadIO mo => GHandlerT sub master mo () setUltDestReferer = do mdest <- lookupSession ultDestKey maybe @@ -521,14 +522,14 @@ setUltDestReferer = do redirectUltDest :: MonadIO mo => RedirectType -> Route master -- ^ default destination if nothing in session - -> GGHandler sub master mo a + -> GHandlerT sub master mo a redirectUltDest rt def = do mdest <- lookupSession ultDestKey deleteSession ultDestKey maybe (redirect rt def) (redirectText rt) mdest -- | Remove a previously set ultimate destination. See 'setUltDest'. -clearUltDest :: MonadIO mo => GGHandler sub master mo () +clearUltDest :: MonadIO mo => GHandlerT sub master mo () clearUltDest = deleteSession ultDestKey msgKey :: Text @@ -537,13 +538,13 @@ msgKey = "_MSG" -- | Sets a message in the user's session. -- -- See 'getMessage'. -setMessage :: MonadIO mo => Html -> GGHandler sub master mo () +setMessage :: MonadIO mo => Html -> GHandlerT sub master mo () setMessage = setSession msgKey . T.concat . TL.toChunks . Text.Blaze.Renderer.Text.renderHtml -- | Sets a message in the user's session. -- -- See 'getMessage'. -setMessageI :: (RenderMessage y msg, MonadIO mo) => msg -> GGHandler sub y mo () +setMessageI :: (RenderMessage y msg, MonadIO mo) => msg -> GHandlerT sub y mo () setMessageI msg = do mr <- getMessageRender setMessage $ toHtml $ mr msg @@ -552,7 +553,7 @@ setMessageI msg = do -- variable. -- -- See 'setMessage'. -getMessage :: MonadIO mo => GGHandler sub master mo (Maybe Html) +getMessage :: MonadIO mo => GHandlerT sub master mo (Maybe Html) getMessage = do mmsg <- liftM (fmap preEscapedText) $ lookupSession msgKey deleteSession msgKey @@ -562,7 +563,7 @@ getMessage = do -- -- 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. -sendFile :: MonadIO mo => ContentType -> FilePath -> GGHandler sub master mo a +sendFile :: MonadIO mo => ContentType -> FilePath -> GHandlerT sub master mo a sendFile ct fp = liftIO . throwIO $ HCSendFile ct fp Nothing -- | Same as 'sendFile', but only sends part of a file. @@ -571,25 +572,25 @@ sendFilePart :: MonadIO mo -> FilePath -> Integer -- ^ offset -> Integer -- ^ count - -> GGHandler sub master mo a + -> GHandlerT sub master mo a sendFilePart ct fp off count = liftIO . throwIO $ HCSendFile ct fp $ Just $ W.FilePart off count -- | Bypass remaining handler code and output the given content with a 200 -- status code. -sendResponse :: (MonadIO mo, HasReps c) => c -> GGHandler sub master mo a +sendResponse :: (MonadIO mo, HasReps c) => c -> GHandlerT sub master mo a sendResponse = liftIO . throwIO . HCContent H.status200 . chooseRep -- | Bypass remaining handler code and output the given content with the given -- status code. -sendResponseStatus :: (MonadIO mo, HasReps c) => H.Status -> c -> GGHandler s m mo a +sendResponseStatus :: (MonadIO mo, HasReps c) => H.Status -> c -> GHandlerT s m mo a sendResponseStatus s = liftIO . throwIO . HCContent s . chooseRep -- | Send a 201 "Created" response with the given route as the Location -- response header. -sendResponseCreated :: MonadIO mo => Route m -> GGHandler s m mo a +sendResponseCreated :: MonadIO mo => Route m -> GHandlerT s m mo a sendResponseCreated url = do r <- getUrlRender liftIO . throwIO $ HCCreated $ r url @@ -599,7 +600,7 @@ sendResponseCreated url = do -- that you have already specified. This function short-circuits. It should be -- considered only for very specific needs. If you are not sure if you need it, -- you don't. -sendWaiResponse :: MonadIO mo => W.Response -> GGHandler s m mo b +sendWaiResponse :: MonadIO mo => W.Response -> GHandlerT s m mo b sendWaiResponse = liftIO . throwIO . HCWai -- | Return a 404 not found page. Also denotes no handler available. @@ -607,7 +608,7 @@ notFound :: Failure ErrorResponse m => m a notFound = failure NotFound -- | Return a 405 method not supported page. -badMethod :: MonadIO mo => GGHandler s m mo a +badMethod :: MonadIO mo => GHandlerT s m mo a badMethod = do w <- waiRequest failure $ BadMethod $ W.requestMethod w @@ -617,7 +618,7 @@ permissionDenied :: Failure ErrorResponse m => Text -> m a permissionDenied = failure . PermissionDenied -- | Return a 403 permission denied page. -permissionDeniedI :: (RenderMessage y msg, MonadIO mo) => msg -> GGHandler s y mo a +permissionDeniedI :: (RenderMessage y msg, MonadIO mo) => msg -> GHandlerT s y mo a permissionDeniedI msg = do mr <- getMessageRender permissionDenied $ mr msg @@ -627,7 +628,7 @@ invalidArgs :: Failure ErrorResponse m => [Text] -> m a invalidArgs = failure . InvalidArgs -- | Return a 400 invalid arguments page. -invalidArgsI :: (RenderMessage y msg, MonadIO mo) => [msg] -> GGHandler s y mo a +invalidArgsI :: (RenderMessage y msg, MonadIO mo) => [msg] -> GHandlerT s y mo a invalidArgsI msg = do mr <- getMessageRender invalidArgs $ map mr msg @@ -638,26 +639,26 @@ setCookie :: MonadIO mo => Int -- ^ minutes to timeout -> H.Ascii -- ^ key -> H.Ascii -- ^ value - -> GGHandler sub master mo () + -> GHandlerT sub master mo () setCookie a b = addHeader . AddCookie a b -- | Unset the cookie on the client. -deleteCookie :: MonadIO mo => H.Ascii -> GGHandler sub master mo () +deleteCookie :: MonadIO mo => H.Ascii -> GHandlerT sub master mo () deleteCookie = addHeader . DeleteCookie -- | Set the language in the user session. Will show up in 'languages' on the -- next request. -setLanguage :: MonadIO mo => Text -> GGHandler sub master mo () +setLanguage :: MonadIO mo => Text -> GHandlerT sub master mo () setLanguage = setSession langKey -- | Set an arbitrary response header. setHeader :: MonadIO mo - => CI H.Ascii -> H.Ascii -> GGHandler sub master mo () + => CI H.Ascii -> H.Ascii -> GHandlerT sub master mo () setHeader a = addHeader . Header a -- | Set the Cache-Control header to indicate this response should be cached -- for the given number of seconds. -cacheSeconds :: MonadIO mo => Int -> GGHandler s m mo () +cacheSeconds :: MonadIO mo => Int -> GHandlerT s m mo () cacheSeconds i = setHeader "Cache-Control" $ S8.pack $ concat [ "max-age=" , show i @@ -666,16 +667,16 @@ cacheSeconds i = setHeader "Cache-Control" $ S8.pack $ concat -- | Set the Expires header to some date in 2037. In other words, this content -- is never (realistically) expired. -neverExpires :: MonadIO mo => GGHandler s m mo () +neverExpires :: MonadIO mo => GHandlerT s m mo () neverExpires = setHeader "Expires" "Thu, 31 Dec 2037 23:55:55 GMT" -- | Set an Expires header in the past, meaning this content should not be -- cached. -alreadyExpired :: MonadIO mo => GGHandler s m mo () +alreadyExpired :: MonadIO mo => GHandlerT s m mo () alreadyExpired = setHeader "Expires" "Thu, 01 Jan 1970 05:05:05 GMT" -- | Set an Expires header to the given date. -expiresAt :: MonadIO mo => UTCTime -> GGHandler s m mo () +expiresAt :: MonadIO mo => UTCTime -> GHandlerT s m mo () expiresAt = setHeader "Expires" . encodeUtf8 . formatRFC1123 -- | Set a variable in the user's session. @@ -686,18 +687,18 @@ expiresAt = setHeader "Expires" . encodeUtf8 . formatRFC1123 setSession :: MonadIO mo => Text -- ^ key -> Text -- ^ value - -> GGHandler sub master mo () + -> GHandlerT sub master mo () setSession k = modify . modSession . Map.insert k -- | Unsets a session variable. See 'setSession'. -deleteSession :: MonadIO mo => Text -> GGHandler sub master mo () +deleteSession :: MonadIO mo => Text -> GHandlerT sub master mo () deleteSession = modify . modSession . Map.delete modSession :: (SessionMap -> SessionMap) -> GHState -> GHState modSession f x = x { ghsSession = f $ ghsSession x } -- | Internal use only, not to be confused with 'setHeader'. -addHeader :: MonadIO mo => Header -> GGHandler sub master mo () +addHeader :: MonadIO mo => Header -> GHandlerT sub master mo () addHeader = tell . Endo . (:) getStatus :: ErrorResponse -> H.Status @@ -720,18 +721,18 @@ data RedirectType = RedirectPermanent | RedirectSeeOther deriving (Show, Eq) -localNoCurrent :: Monad mo => GGHandler s m mo a -> GGHandler s m mo a +localNoCurrent :: Monad mo => GHandlerT s m mo a -> GHandlerT s m mo a localNoCurrent = local (\hd -> hd { handlerRoute = Nothing }) -- | Lookup for session data. -lookupSession :: MonadIO mo => Text -> GGHandler s m mo (Maybe Text) +lookupSession :: MonadIO mo => Text -> GHandlerT s m mo (Maybe Text) lookupSession n = do m <- liftM ghsSession get return $ Map.lookup n m -- | Get all session variables. -getSession :: MonadIO mo => GGHandler s m mo SessionMap +getSession :: MonadIO mo => GHandlerT s m mo SessionMap getSession = liftM ghsSession get handlerToYAR :: (HasReps a, HasReps b) @@ -744,7 +745,7 @@ handlerToYAR :: (HasReps a, HasReps b) -> Maybe (Route s) -> SessionMap -> GHandler s m b - -> Iteratee ByteString IO YesodAppResult + -> ResourceT IO YesodAppResult handlerToYAR y s toMasterRoute render errorHandler rr murl sessionMap h = unYesodApp ya eh' rr types sessionMap where @@ -766,8 +767,7 @@ yarToResponse renderHeaders (YARPlain s hs ct c sessionFinal) = let hs' = maybe finalHeaders finalHeaders' mlen in W.ResponseBuilder s hs' b ContentFile fp p -> W.ResponseFile s finalHeaders fp p - ContentEnum e -> - W.ResponseEnumerator $ \iter -> run_ $ e $$ iter s finalHeaders + ContentSource body -> W.ResponseSource s finalHeaders body where finalHeaders = renderHeaders hs ct sessionFinal finalHeaders' len = ("Content-Length", S8.pack $ show len) @@ -822,7 +822,7 @@ headerToPair cp _ (DeleteCookie key) = headerToPair _ _ (Header key value) = (key, value) -- | Get a unique identifier. -newIdent :: MonadIO mo => GGHandler sub master mo String -- FIXME use Text +newIdent :: MonadIO mo => GHandlerT sub master mo String -- FIXME use Text newIdent = do x <- get let i' = ghsIdent x + 1 @@ -830,8 +830,8 @@ newIdent = do return $ 'h' : show i' liftIOHandler :: MonadIO mo - => GGHandler sub master IO a - -> GGHandler sub master mo a + => GHandlerT sub master IO a + -> GHandlerT sub master mo a liftIOHandler (ReaderT m) = ReaderT $ \r -> liftIO $ m r -- | Redirect to a POST resource. @@ -840,7 +840,7 @@ liftIOHandler (ReaderT m) = ReaderT $ \r -> liftIO $ m r -- POST form, and some Javascript to automatically submit the form. This can be -- useful when you need to post a plain link somewhere that needs to cause -- changes on the server. -redirectToPost :: MonadIO mo => Route master -> GGHandler sub master mo a +redirectToPost :: MonadIO mo => Route master -> GHandlerT sub master mo a redirectToPost dest = hamletToRepHtml #if GHC7 [hamlet| @@ -862,35 +862,35 @@ redirectToPost dest = hamletToRepHtml -- | Converts the given Hamlet template into 'Content', which can be used in a -- Yesod 'Response'. hamletToContent :: Monad mo - => HtmlUrl (Route master) -> GGHandler sub master mo Content + => HtmlUrl (Route master) -> GHandlerT sub master mo Content hamletToContent h = do render <- getUrlRenderParams return $ toContent $ h render -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: Monad mo - => HtmlUrl (Route master) -> GGHandler sub master mo RepHtml + => HtmlUrl (Route master) -> GHandlerT sub master mo RepHtml hamletToRepHtml = liftM RepHtml . hamletToContent -- | Get the request\'s 'W.Request' value. -waiRequest :: Monad mo => GGHandler sub master mo W.Request +waiRequest :: Monad mo => GHandlerT sub master mo W.Request waiRequest = reqWaiRequest `liftM` getRequest -getMessageRender :: (Monad mo, RenderMessage master message) => GGHandler s master mo (message -> Text) +getMessageRender :: (Monad mo, RenderMessage master message) => GHandlerT s master mo (message -> Text) getMessageRender = do m <- getYesod l <- reqLangs `liftM` getRequest return $ renderMessage m l -cacheLookup :: MonadIO mo => CacheKey a -> GGHandler sub master mo (Maybe a) +cacheLookup :: MonadIO mo => CacheKey a -> GHandlerT sub master mo (Maybe a) cacheLookup k = do gs <- get return $ Cache.lookup k $ ghsCache gs -cacheInsert :: MonadIO mo => CacheKey a -> a -> GGHandler sub master mo () +cacheInsert :: MonadIO mo => CacheKey a -> a -> GHandlerT sub master mo () cacheInsert k v = modify $ \gs -> gs { ghsCache = Cache.insert k v $ ghsCache gs } -cacheDelete :: MonadIO mo => CacheKey a -> GGHandler sub master mo () +cacheDelete :: MonadIO mo => CacheKey a -> GHandlerT sub master mo () cacheDelete k = modify $ \gs -> gs { ghsCache = Cache.delete k $ ghsCache gs } diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index 9d468747..f61a59ef 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/yesod-core/Yesod/Internal/Core.hs @@ -281,7 +281,7 @@ class RenderRoute (Route a) => Yesod a where yepnopeJs _ = Nothing messageLoggerHandler :: (Yesod m, MonadIO mo) - => Loc -> LogLevel -> Text -> GGHandler s m mo () + => Loc -> LogLevel -> Text -> GHandlerT s m mo () messageLoggerHandler loc level msg = do y <- getYesod liftIO $ messageLogger y loc level msg diff --git a/yesod-core/Yesod/Internal/Dispatch.hs b/yesod-core/Yesod/Internal/Dispatch.hs index 5be1fc0e..5b0aa73f 100644 --- a/yesod-core/Yesod/Internal/Dispatch.hs +++ b/yesod-core/Yesod/Internal/Dispatch.hs @@ -30,7 +30,7 @@ import qualified Data.Text Alright, let's explain how routing works. We want to take a [String] and found out which route it applies to. For static pieces, we need to ensure an exact match against the segment. For a single or multi piece, we need to check the -result of fromSinglePiece/fromMultiPiece, respectively. +result of fromPathPiece/fromMultiPathPiece, respectively. We want to create a tree of case statements basically resembling: @@ -51,7 +51,7 @@ case segments of case as of [] -> Nothing b:bs -> - case fromSinglePiece b of + case fromPathPiece b of Left _ -> Nothing Right name -> case bs of @@ -59,7 +59,7 @@ case segments of case cs of [] -> Nothing d:ds -> - case fromSinglePiece d of + case fromPathPiece d of Left _ -> Nothing Right age -> case ds of @@ -219,7 +219,7 @@ mkSimpleExp segments (SinglePiece _:pieces) frontVars x = do innerExp <- mkSimpleExp (VarE srest) pieces (frontVars . (:) (VarE next')) x nothing <- [|Nothing|] next <- newName "next" - fsp <- [|fromSinglePiece|] + fsp <- [|fromPathPiece|] let exp' = CaseE (fsp `AppE` VarE next) [ Match (ConP (mkName "Nothing") []) @@ -243,7 +243,7 @@ mkSimpleExp segments [MultiPiece _] frontVars x = do srest <- [|[]|] innerExp <- mkSimpleExp srest [] (frontVars . (:) (VarE next')) x nothing <- [|Nothing|] - fmp <- [|fromMultiPiece|] + fmp <- [|fromPathMultiPiece|] let exp = CaseE (fmp `AppE` segments) [ Match (ConP (mkName "Nothing") []) @@ -301,7 +301,7 @@ mkSubsiteExp segments (SinglePiece _:pieces) frontVars x = do innerExp <- mkSubsiteExp srest pieces (frontVars . (:) (VarE next')) x nothing <- [|Nothing|] next <- newName "next" - fsp <- [|fromSinglePiece|] + fsp <- [|fromPathPiece|] let exp' = CaseE (fsp `AppE` VarE next) [ Match (ConP (mkName "Nothing") []) diff --git a/yesod-core/Yesod/Internal/RouteParsing.hs b/yesod-core/Yesod/Internal/RouteParsing.hs index dcb475c4..e1f9f734 100644 --- a/yesod-core/Yesod/Internal/RouteParsing.hs +++ b/yesod-core/Yesod/Internal/RouteParsing.hs @@ -85,7 +85,7 @@ createParse res = do mkPat' :: Exp -> [Piece] -> Exp -> Q ([Pat], Exp) mkPat' be [MultiPiece s] parse = do v <- newName $ "var" ++ s - fmp <- [|fromMultiPiece|] + fmp <- [|fromPathMultiPiece|] let parse' = InfixE (Just parse) be $ Just $ fmp `AppE` VarE v return ([VarP v], parse') mkPat' _ (MultiPiece _:_) _parse = error "MultiPiece must be last" @@ -94,7 +94,7 @@ createParse res = do let sp = LitP $ StringL s return (sp : x, parse') mkPat' be (SinglePiece s:rest) parse = do - fsp <- [|fromSinglePiece|] + fsp <- [|fromPathPiece|] v <- newName $ "var" ++ s let parse' = InfixE (Just parse) be $ Just $ fsp `AppE` VarE v (x, parse'') <- mkPat' be rest parse' @@ -137,13 +137,13 @@ createRender = mapM go return $ ConE (mkName ":") `AppE` (pack `AppE` x') `AppE` xs' mkBod ((i, SinglePiece _):xs) = do let x' = VarE $ mkName $ "var" ++ show i - tsp <- [|toSinglePiece|] + tsp <- [|toPathPiece|] let x'' = tsp `AppE` x' xs' <- mkBod xs return $ ConE (mkName ":") `AppE` x'' `AppE` xs' mkBod ((i, MultiPiece _):_) = do let x' = VarE $ mkName $ "var" ++ show i - tmp <- [|toMultiPiece|] + tmp <- [|toPathMultiPiece|] return $ tmp `AppE` x' -- | Whether the set of resources cover all possible URLs. diff --git a/yesod-core/Yesod/Internal/TestApi.hs b/yesod-core/Yesod/Internal/TestApi.hs index 8ff18528..ffb1387e 100644 --- a/yesod-core/Yesod/Internal/TestApi.hs +++ b/yesod-core/Yesod/Internal/TestApi.hs @@ -6,22 +6,6 @@ -- module Yesod.Internal.TestApi ( randomString, parseWaiRequest' - , catchIter ) where import Yesod.Internal.Request (randomString, parseWaiRequest') -import Control.Exception (Exception, catch) -import Data.Enumerator (Iteratee (..), Step (..)) -import Data.ByteString (ByteString) -import Prelude hiding (catch) - -catchIter :: Exception e - => Iteratee ByteString IO a - -> (e -> Iteratee ByteString IO a) - -> Iteratee ByteString IO a -catchIter (Iteratee mstep) f = Iteratee $ do - step <- mstep `catch` (runIteratee . f) - return $ case step of - Continue k -> Continue $ \s -> catchIter (k s) f - Yield b s -> Yield b s - Error e -> Error e diff --git a/yesod-core/Yesod/Request.hs b/yesod-core/Yesod/Request.hs index 3d42e3cb..a0559e51 100644 --- a/yesod-core/Yesod/Request.hs +++ b/yesod-core/Yesod/Request.hs @@ -52,20 +52,20 @@ import Data.Text (Text) -- * Accept-Language HTTP header. -- -- This is handled by parseWaiRequest (not exposed). -languages :: Monad mo => GGHandler s m mo [Text] +languages :: Monad mo => GHandlerT s m mo [Text] languages = reqLangs `liftM` getRequest lookup' :: Eq a => a -> [(a, b)] -> [b] lookup' a = map snd . filter (\x -> a == fst x) -- | Lookup for GET parameters. -lookupGetParams :: Monad mo => Text -> GGHandler s m mo [Text] +lookupGetParams :: Monad mo => Text -> GHandlerT s m mo [Text] lookupGetParams pn = do rr <- getRequest return $ lookup' pn $ reqGetParams rr -- | Lookup for GET parameters. -lookupGetParam :: Monad mo => Text -> GGHandler s m mo (Maybe Text) +lookupGetParam :: Monad mo => Text -> GHandlerT s m mo (Maybe Text) lookupGetParam = liftM listToMaybe . lookupGetParams -- | Lookup for POST parameters. @@ -91,11 +91,11 @@ lookupFiles pn = do return $ lookup' pn files -- | Lookup for cookie data. -lookupCookie :: Monad mo => Text -> GGHandler s m mo (Maybe Text) +lookupCookie :: Monad mo => Text -> GHandlerT s m mo (Maybe Text) lookupCookie = liftM listToMaybe . lookupCookies -- | Lookup for cookie data. -lookupCookies :: Monad mo => Text -> GGHandler s m mo [Text] +lookupCookies :: Monad mo => Text -> GHandlerT s m mo [Text] lookupCookies pn = do rr <- getRequest return $ lookup' pn $ reqCookies rr diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Widget.hs index 24918358..aa45eb30 100644 --- a/yesod-core/Yesod/Widget.hs +++ b/yesod-core/Yesod/Widget.hs @@ -64,7 +64,7 @@ import Text.Cassius import Text.Julius import Text.Coffee import Yesod.Handler - (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod + (Route, GHandler, GHandlerT, YesodSubRoute(..), toMasterHandlerMaybe, getYesod , getMessageRender, getUrlRenderParams ) import Yesod.Message (RenderMessage) @@ -189,7 +189,7 @@ setTitle x = GWidget $ tell $ GWData mempty (Last $ Just $ Title x) mempty mempt -- | Set the page title. Calling 'setTitle' multiple times overrides previously -- set values. -setTitleI :: (RenderMessage master msg, Monad m) => msg -> GGWidget master (GGHandler sub master m) () +setTitleI :: (RenderMessage master msg, Monad m) => msg -> GGWidget master (GHandlerT sub master m) () setTitleI msg = do mr <- lift getMessageRender setTitle $ toHtml $ mr msg @@ -280,7 +280,7 @@ addJuliusBody j = addHamlet $ \r -> H.script $ preEscapedLazyText $ renderJavasc -- | Add Coffesscript to the page's script tag. Requires the coffeescript -- executable to be present at runtime. -addCoffee :: MonadIO m => CoffeeUrl (Route master) -> GGWidget master (GGHandler sub master m) () +addCoffee :: MonadIO m => CoffeeUrl (Route master) -> GGWidget master (GHandlerT sub master m) () addCoffee c = do render <- lift getUrlRenderParams t <- liftIO $ renderCoffee render c @@ -288,7 +288,7 @@ addCoffee c = do -- | Add a new script tag to the body with the contents of this Coffesscript -- template. Requires the coffeescript executable to be present at runtime. -addCoffeeBody :: MonadIO m => CoffeeUrl (Route master) -> GGWidget master (GGHandler sub master m) () +addCoffeeBody :: MonadIO m => CoffeeUrl (Route master) -> GGWidget master (GHandlerT sub master m) () addCoffeeBody c = do render <- lift getUrlRenderParams t <- liftIO $ renderCoffee render c @@ -338,7 +338,7 @@ rules = do -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. ihamletToRepHtml :: (Monad mo, RenderMessage master message) => HtmlUrlI18n message (Route master) - -> GGHandler sub master mo RepHtml + -> GHandlerT sub master mo RepHtml ihamletToRepHtml ih = do urender <- getUrlRenderParams mrender <- getMessageRender diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 271469d7..16118e46 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -11,10 +11,6 @@ import Network.Wai.Test import Text.Hamlet (hamlet) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 -import Yesod.Internal.TestApi -import qualified Data.Enumerator as E -import qualified Data.Enumerator.List as EL -import Control.Exception (SomeException) data App = App @@ -61,7 +57,6 @@ errorHandlingTest = describe "Test.ErrorHandling" [ it "says not found" caseNotFound , it "says 'There was an error' before runRequestBody" caseBefore , it "says 'There was an error' after runRequestBody" caseAfter - , it "catchIter handles internal exceptions" caseCatchIter ] runner :: Session () -> IO () @@ -101,11 +96,3 @@ caseAfter = runner $ do } assertStatus 500 res assertBodyContains "bin12345" res - -caseCatchIter :: IO () -caseCatchIter = E.run_ $ E.enumList 8 (replicate 1000 "foo") E.$$ flip catchIter ignorer $ do - _ <- EL.consume - error "foo" - where - ignorer :: SomeException -> E.Iteratee a IO () - ignorer _ = return () diff --git a/yesod-core/test/YesodCoreTest/YesodTest.hs b/yesod-core/test/YesodCoreTest/YesodTest.hs index 30790f95..9150f5ad 100644 --- a/yesod-core/test/YesodCoreTest/YesodTest.hs +++ b/yesod-core/test/YesodCoreTest/YesodTest.hs @@ -6,7 +6,6 @@ module YesodCoreTest.YesodTest , module Network.Wai , module Network.Wai.Test , module Test.Hspec - , module Test.Hspec.HUnit ) where import Yesod.Core hiding (Request) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index c5df8b7f..592ac6a7 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -79,6 +79,8 @@ library , aeson >= 0.5 , fast-logger >= 0.0.1 , wai-logger >= 0.0.1 + , conduit >= 0.0 && < 0.1 + , lifted-base >= 0.1 && < 0.2 exposed-modules: Yesod.Content Yesod.Core @@ -115,7 +117,7 @@ test-suite tests main-is: test.hs cpp-options: -DTEST build-depends: hspec >= 0.8 && < 0.10 - ,wai-test >= 0.1.2 && < 0.2 + ,wai-test ,wai ,yesod-core ,bytestring