yesod-core 0.9.3.4 → 0.9.3.5
raw patch · 6 files changed
+217/−124 lines, 6 filesdep +transformers-basedep ~basedep ~monad-control
Dependencies added: transformers-base
Dependency ranges changed: base, monad-control
Files
- Yesod/Handler.hs +94/−118
- Yesod/Internal/Cache.hs +38/−0
- Yesod/Internal/Core.hs +3/−3
- Yesod/Widget.hs +27/−1
- test/YesodCoreTest/Cache.hs +50/−0
- yesod-core.cabal +5/−2
Yesod/Handler.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE DeriveDataTypeable #-} --------------------------------------------------------- -- -- Module : Yesod.Handler@@ -97,6 +98,12 @@ , liftIOHandler -- * i18n , getMessageRender+ -- * Per-request caching+ , CacheKey+ , mkCacheKey+ , cacheLookup+ , cacheInsert+ , cacheDelete -- * Internal Yesod , runHandler , YesodApp (..)@@ -121,14 +128,11 @@ import Control.Exception hiding (Handler, catch, finally) import Control.Applicative -import Control.Monad (liftM, join, MonadPlus)+import Control.Monad (liftM) import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.Trans.Writer-import Control.Monad.Trans.Reader-import Control.Monad.Trans.State-import Control.Monad.Trans.Error (throwError, ErrorT (..), Error (..))+import Control.Monad.Trans.RWS import System.IO import qualified Network.Wai as W@@ -142,8 +146,6 @@ import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as TL -import Control.Monad.IO.Control (MonadControlIO)-import Control.Monad.Trans.Control (MonadTransControl, liftControl) import qualified Data.Map as Map import qualified Data.ByteString as S import Data.ByteString (ByteString)@@ -153,7 +155,7 @@ import Yesod.Content import Data.Maybe (fromMaybe) import Web.Cookie (SetCookie (..), renderSetCookie)-import Control.Arrow (second, (***))+import Control.Arrow ((***)) import qualified Network.Wai.Parse as NWP import Data.Monoid (mappend, mempty, Endo (..)) import qualified Data.ByteString.Char8 as S8@@ -165,6 +167,10 @@ 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)+ -- | The type-safe URLs associated with a site argument. type family Route a @@ -198,6 +204,11 @@ , handlerRoute = route } +withReaderT :: (HandlerData s m -> HandlerData s' m)+ -> GGHandler s' m mo a+ -> GGHandler s m mo a+withReaderT f = withRWST (\r s -> (f r, s))+ -- | Used internally for promoting subsite handler functions to master site -- handler functions. Should not be needed by users. toMasterHandler :: (Route sub -> Route master)@@ -205,8 +216,7 @@ -> Route sub -> GGHandler sub master mo a -> GGHandler sub' master mo a-toMasterHandler tm ts route (GHandler h) =- GHandler $ withReaderT (handlerSubData tm ts route) h+toMasterHandler tm ts route = withReaderT (handlerSubData tm ts route) toMasterHandlerDyn :: Monad mo => (Route sub -> Route master)@@ -214,9 +224,9 @@ -> Route sub -> GGHandler sub master mo a -> GGHandler sub' master mo a-toMasterHandlerDyn tm getSub route (GHandler h) = do+toMasterHandlerDyn tm getSub route h = do sub <- getSub- GHandler $ withReaderT (handlerSubData tm (const sub) route) h+ withReaderT (handlerSubData tm (const sub) route) h class SubsiteGetter g m s | g -> s where runSubsiteGetter :: g -> m s@@ -235,22 +245,14 @@ -> Maybe (Route sub) -> GGHandler sub master mo a -> GGHandler sub' master mo a-toMasterHandlerMaybe tm ts route (GHandler h) =- GHandler $ withReaderT (handlerSubDataMaybe tm ts route) h+toMasterHandlerMaybe tm ts route = withReaderT (handlerSubDataMaybe tm ts route) -- | A generic handler monad, which can have a different subsite and master -- site. This monad is a combination of 'ReaderT' for basic arguments, a -- '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.-newtype GGHandler sub master m a =- GHandler- { unGHandler :: GHInner sub master m a- }- deriving (Functor, Applicative, Monad, MonadIO, MonadControlIO, MonadPlus)--instance MonadTrans (GGHandler s m) where- lift = GHandler . lift . lift . lift . lift+type GGHandler sub master = RWST (HandlerData sub master) (Endo [Header]) GHState type GHandler sub master = GGHandler sub master (Iteratee ByteString IO) @@ -258,16 +260,9 @@ { ghsSession :: SessionMap , ghsRBC :: Maybe RequestBodyContents , ghsIdent :: Int+ , ghsCache :: Cache.Cache } -type GHInner s m monad = -- FIXME collapse the stack- ReaderT (HandlerData s m) (- ErrorT HandlerContents (- WriterT (Endo [Header]) (- StateT GHState (- monad- ))))- type SessionMap = Map.Map Text Text -- | An extension of the basic WAI 'W.Application' datatype to provide extra@@ -293,25 +288,27 @@ | HCRedirect RedirectType Text | HCCreated Text | HCWai W.Response+ deriving Typeable -instance Error HandlerContents where- strMsg = HCError . InternalError . T.pack+instance Show HandlerContents where+ show _ = "Cannot show a HandlerContents"+instance Exception HandlerContents getRequest :: Monad mo => GGHandler s m mo Request-getRequest = handlerRequest `liftM` GHandler ask+getRequest = handlerRequest `liftM` ask -instance Monad monad => Failure ErrorResponse (GGHandler sub master monad) where- failure = GHandler . lift . throwError . HCError+instance MonadIO monad => Failure ErrorResponse (GGHandler sub master monad) where+ failure = liftIO . throwIO . HCError runRequestBody :: GHandler s m RequestBodyContents runRequestBody = do- x <- GHandler $ lift $ lift $ lift get+ x <- get case ghsRBC x of Just rbc -> return rbc Nothing -> do rr <- waiRequest rbc <- lift $ rbHelper rr- GHandler $ lift $ lift $ lift $ put x { ghsRBC = Just rbc }+ put x { ghsRBC = Just rbc } return rbc rbHelper :: W.Request -> Iteratee ByteString IO RequestBodyContents@@ -326,33 +323,33 @@ -- | Get the sub application argument. getYesodSub :: Monad m => GGHandler sub master m sub-getYesodSub = handlerSub `liftM` GHandler ask+getYesodSub = handlerSub `liftM` ask -- | Get the master site appliation argument. getYesod :: Monad m => GGHandler sub master m master-getYesod = handlerMaster `liftM` GHandler ask+getYesod = handlerMaster `liftM` ask -- | Get the URL rendering function. getUrlRender :: Monad m => GGHandler sub master m (Route master -> Text) getUrlRender = do- x <- handlerRender `liftM` GHandler ask+ x <- handlerRender `liftM` ask return $ flip x [] -- | The URL rendering function with query-string parameters. getUrlRenderParams :: Monad m => GGHandler sub master m (Route master -> [(Text, Text)] -> Text)-getUrlRenderParams = handlerRender `liftM` GHandler ask+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 = handlerRoute `liftM` GHandler ask+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 = handlerToMaster `liftM` GHandler ask+getRouteToMaster = handlerToMaster `liftM` ask -- | Function used internally by Yesod in the process of converting a -- 'GHandler' into an 'W.Application'. Should not be needed by users.@@ -378,15 +375,15 @@ , handlerRender = mrender , handlerToMaster = tomr }- let initSession' = GHState initSession Nothing 1- ((contents', headers), finalSession) <- catchIter (- fmap (second ghsSession)- $ flip runStateT initSession'- $ runWriterT- $ runErrorT- $ flip runReaderT hd- $ unGHandler handler- ) (\e -> return ((Left $ HCError $ toErrorHandler e, mempty), initSession))+ let initSession' = GHState initSession Nothing 1 mempty+ (contents', finalSession, headers) <- catchIter (+ fmap (\(a, b, c) -> (Right a, ghsSession b, c))+ $ runRWST handler hd initSession'+ ) (\e -> return (+ case fromException e of+ Just x -> Left x+ Nothing -> Left $ HCError $ toErrorHandler e+ , initSession, mempty)) let contents = either id (HCContent H.status200 . chooseRep) contents' let handleError e = do yar <- unYesodApp (eh e) safeEh rr cts finalSession@@ -431,11 +428,11 @@ session -- | Redirect to the given route.-redirect :: Monad mo => RedirectType -> Route master -> GGHandler sub master mo a+redirect :: MonadIO mo => RedirectType -> Route master -> GGHandler sub master mo a redirect rt url = redirectParams rt url [] -- | Redirects to the given route with the associated query-string parameters.-redirectParams :: Monad mo+redirectParams :: MonadIO mo => RedirectType -> Route master -> [(Text, Text)] -> GGHandler sub master mo a redirectParams rt url params = do@@ -443,8 +440,8 @@ redirectString rt $ r url params -- | Redirect to the given URL.-redirectString, redirectText :: Monad mo => RedirectType -> Text -> GGHandler sub master mo a-redirectText rt = GHandler . lift . throwError . HCRedirect rt+redirectString, redirectText :: MonadIO mo => RedirectType -> Text -> GGHandler sub master mo a+redirectText rt = liftIO . throwIO . HCRedirect rt redirectString = redirectText {-# DEPRECATED redirectString "Use redirectText instead" #-} @@ -479,7 +476,7 @@ Nothing -> return () Just r -> do tm <- getRouteToMaster- gets' <- reqGetParams `liftM` handlerRequest `liftM` GHandler ask+ gets' <- reqGetParams `liftM` handlerRequest `liftM` ask render <- getUrlRenderParams setUltDestString $ render (tm r) gets' @@ -500,7 +497,7 @@ -- value from the session. -- -- The ultimate destination is set with 'setUltDest'.-redirectUltDest :: Monad mo+redirectUltDest :: MonadIO mo => RedirectType -> Route master -- ^ default destination if nothing in session -> GGHandler sub master mo a@@ -544,52 +541,52 @@ -- -- 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 :: Monad mo => ContentType -> FilePath -> GGHandler sub master mo a-sendFile ct fp = GHandler . lift . throwError $ HCSendFile ct fp Nothing+sendFile :: MonadIO mo => ContentType -> FilePath -> GGHandler sub master mo a+sendFile ct fp = liftIO . throwIO $ HCSendFile ct fp Nothing -- | Same as 'sendFile', but only sends part of a file.-sendFilePart :: Monad mo+sendFilePart :: MonadIO mo => ContentType -> FilePath -> Integer -- ^ offset -> Integer -- ^ count -> GGHandler sub master mo a sendFilePart ct fp off count =- GHandler . lift . throwError $ HCSendFile ct fp $ Just $ W.FilePart 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 :: (Monad mo, HasReps c) => c -> GGHandler sub master mo a-sendResponse = GHandler . lift . throwError . HCContent H.status200+sendResponse :: (MonadIO mo, HasReps c) => c -> GGHandler 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 :: (Monad mo, HasReps c) => H.Status -> c -> GGHandler s m mo a-sendResponseStatus s = GHandler . lift . throwError . HCContent s+sendResponseStatus :: (MonadIO mo, HasReps c) => H.Status -> c -> GGHandler 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 :: Monad mo => Route m -> GGHandler s m mo a+sendResponseCreated :: MonadIO mo => Route m -> GGHandler s m mo a sendResponseCreated url = do r <- getUrlRender- GHandler $ lift $ throwError $ HCCreated $ r url+ liftIO . throwIO $ HCCreated $ r url -- | Send a 'W.Response'. Please note: this function is rarely -- necessary, and will /disregard/ any changes to response headers and session -- 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 :: Monad mo => W.Response -> GGHandler s m mo b-sendWaiResponse = GHandler . lift . throwError . HCWai+sendWaiResponse :: MonadIO mo => W.Response -> GGHandler s m mo b+sendWaiResponse = liftIO . throwIO . HCWai -- | Return a 404 not found page. Also denotes no handler available. notFound :: Failure ErrorResponse m => m a notFound = failure NotFound -- | Return a 405 method not supported page.-badMethod :: Monad mo => GGHandler s m mo a+badMethod :: MonadIO mo => GGHandler s m mo a badMethod = do w <- waiRequest failure $ BadMethod $ W.requestMethod w@@ -599,7 +596,7 @@ permissionDenied = failure . PermissionDenied -- | Return a 403 permission denied page.-permissionDeniedI :: (RenderMessage y msg, Monad mo) => msg -> GGHandler s y mo a+permissionDeniedI :: (RenderMessage y msg, MonadIO mo) => msg -> GGHandler s y mo a permissionDeniedI msg = do mr <- getMessageRender permissionDenied $ mr msg@@ -609,7 +606,7 @@ invalidArgs = failure . InvalidArgs -- | Return a 400 invalid arguments page.-invalidArgsI :: (RenderMessage y msg, Monad mo) => [msg] -> GGHandler s y mo a+invalidArgsI :: (RenderMessage y msg, MonadIO mo) => [msg] -> GGHandler s y mo a invalidArgsI msg = do mr <- getMessageRender invalidArgs $ map mr msg@@ -669,18 +666,18 @@ => Text -- ^ key -> Text -- ^ value -> GGHandler sub master mo ()-setSession k = GHandler . lift . lift . lift . modify . modSession . Map.insert k+setSession k = modify . modSession . Map.insert k -- | Unsets a session variable. See 'setSession'. deleteSession :: Monad mo => Text -> GGHandler sub master mo ()-deleteSession = GHandler . lift . lift . lift . modify . modSession . Map.delete+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 :: Monad mo => Header -> GGHandler sub master mo ()-addHeader = GHandler . lift . lift . tell . Endo . (:)+addHeader = tell . Endo . (:) getStatus :: ErrorResponse -> H.Status getStatus NotFound = H.status404@@ -702,17 +699,17 @@ localNoCurrent :: Monad mo => GGHandler s m mo a -> GGHandler s m mo a localNoCurrent =- GHandler . local (\hd -> hd { handlerRoute = Nothing }) . unGHandler+ local (\hd -> hd { handlerRoute = Nothing }) -- | Lookup for session data. lookupSession :: Monad mo => Text -> GGHandler s m mo (Maybe Text)-lookupSession n = GHandler $ do- m <- liftM ghsSession $ lift $ lift $ lift get+lookupSession n = do+ m <- liftM ghsSession get return $ Map.lookup n m -- | Get all session variables. getSession :: Monad mo => GGHandler s m mo SessionMap-getSession = liftM ghsSession $ GHandler $ lift $ lift $ lift get+getSession = liftM ghsSession get handlerToYAR :: (HasReps a, HasReps b) => m -- ^ master site foundation@@ -803,7 +800,7 @@ -- | Get a unique identifier. newIdent :: Monad mo => GGHandler sub master mo String -- FIXME use Text-newIdent = GHandler $ lift $ lift $ lift $ do+newIdent = do x <- get let i' = ghsIdent x + 1 put x { ghsIdent = i' }@@ -812,42 +809,8 @@ liftIOHandler :: MonadIO mo => GGHandler sub master IO a -> GGHandler sub master mo a-liftIOHandler m = GHandler $- ReaderT $ \r ->- ErrorT $- WriterT $- StateT $ \s ->- liftIO $ runGGHandler m r s--runGGHandler :: GGHandler sub master m a- -> HandlerData sub master- -> GHState- -> m ( ( Either HandlerContents a- , Endo [Header]- )- , GHState- )-runGGHandler m r s = runStateT- (runWriterT- (runErrorT- (runReaderT- (unGHandler m) r))) s--instance MonadTransControl (GGHandler s m) where- liftControl f =- GHandler $- liftControl $ \runRdr ->- liftControl $ \runErr ->- liftControl $ \runWrt ->- liftControl $ \runSt ->- f ( liftM ( GHandler- . join . lift- . join . lift- . join . lift- )- . runSt . runWrt . runErr . runRdr- . unGHandler- )+liftIOHandler (RWST m) = RWST $ \r s ->+ liftIO (m r s) -- | Redirect to a POST resource. --@@ -855,7 +818,7 @@ -- 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 :: Monad mo => Route master -> GGHandler sub master mo a+redirectToPost :: MonadIO mo => Route master -> GGHandler sub master mo a redirectToPost dest = hamletToRepHtml #if GHC7 [hamlet|@@ -896,3 +859,16 @@ m <- getYesod l <- reqLangs `liftM` getRequest return $ renderMessage m l++cacheLookup :: Monad mo => CacheKey a -> GGHandler sub master mo (Maybe a)+cacheLookup k = do+ gs <- get+ return $ Cache.lookup k $ ghsCache gs++cacheInsert :: Monad mo => CacheKey a -> a -> GGHandler sub master mo ()+cacheInsert k v = modify $ \gs ->+ gs { ghsCache = Cache.insert k v $ ghsCache gs }++cacheDelete :: Monad mo => CacheKey a -> GGHandler sub master mo ()+cacheDelete k = modify $ \gs ->+ gs { ghsCache = Cache.delete k $ ghsCache gs }
+ Yesod/Internal/Cache.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+module Yesod.Internal.Cache+ ( Cache+ , CacheKey+ , mkCacheKey+ , lookup+ , insert+ , delete+ ) where++import Prelude hiding (lookup)+import qualified Data.IntMap as Map+import Language.Haskell.TH.Syntax (Q, Exp, runIO, Exp (LitE), Lit (IntegerL))+import Language.Haskell.TH (appE)+import Data.Unique (hashUnique, newUnique)+import GHC.Exts (Any)+import Unsafe.Coerce (unsafeCoerce)+import Data.Monoid (Monoid)+import Control.Applicative ((<$>))++newtype Cache = Cache (Map.IntMap Any)+ deriving Monoid++newtype CacheKey a = CacheKey Int++-- | Generate a new 'CacheKey'. Be sure to give a full type signature.+mkCacheKey :: Q Exp+mkCacheKey = [|CacheKey|] `appE` (LitE . IntegerL . fromIntegral . hashUnique <$> runIO newUnique)++lookup :: CacheKey a -> Cache -> Maybe a+lookup (CacheKey i) (Cache m) = unsafeCoerce <$> Map.lookup i m++insert :: CacheKey a -> a -> Cache -> Cache+insert (CacheKey k) v (Cache m) = Cache (Map.insert k (unsafeCoerce v) m)++delete :: CacheKey a -> Cache -> Cache+delete (CacheKey k) (Cache m) = Cache (Map.delete k m)
Yesod/Internal/Core.hs view
@@ -170,9 +170,9 @@ -- | Determine if a request is authorized or not. --- -- Return 'Nothing' is the request is authorized, 'Just' a message if- -- unauthorized. If authentication is required, you should use a redirect;- -- the Auth helper provides this functionality automatically.+ -- Return 'Authorized' if the request is authorized,+ -- 'Unauthorized' a message if unauthorized.+ -- If authentication is required, return 'AuthenticationRequired'. isAuthorized :: Route a -> Bool -- ^ is this a write request? -> GHandler s a AuthResult
Yesod/Widget.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} -- | Widgets combine HTML with JS and CSS dependencies with a unique identifier -- generator, allowing you to create truly modular HTML components. module Yesod.Widget@@ -78,16 +79,41 @@ import Language.Haskell.TH.Quote (QuasiQuoter) import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE), Pat (VarP), newName) +#if MIN_VERSION_monad_control(0, 3, 0)+import Control.Monad.Trans.Control (MonadTransControl (..), MonadBaseControl (..), defaultLiftBaseWith, defaultRestoreM, ComposeSt)+#else import Control.Monad.IO.Control (MonadControlIO)+#endif import qualified Text.Hamlet as NP import Data.Text.Lazy.Builder (fromLazyText) import Text.Blaze (toHtml, preEscapedLazyText)+import Control.Monad.Base (MonadBase (liftBase)) -- | A generic widget, allowing specification of both the subsite and master -- site datatypes. This is basically a large 'WriterT' stack keeping track of -- dependencies along with a 'StateT' to track unique identifiers. newtype GGWidget m monad a = GWidget { unGWidget :: GWInner m monad a }- deriving (Functor, Applicative, Monad, MonadIO, MonadControlIO)+ deriving (Functor, Applicative, Monad, MonadIO+#if !MIN_VERSION_monad_control(0, 3, 0)+ , MonadControlIO+#endif+ )++instance MonadBase b m => MonadBase b (GGWidget master m) where+ liftBase = lift . liftBase+#if MIN_VERSION_monad_control(0, 3, 0)+instance MonadTransControl (GGWidget master) where+ newtype StT (GGWidget master) a = StRWS {unStRWS :: (a, Int, GWData (Route master))}+ liftWith f = GWidget $ RWST $ \r s -> liftM (\x -> (x, s, mempty))+ (f $ \t -> liftM StRWS $ runRWST (unGWidget t) r s)+ restoreT mSt = GWidget $ RWST $ \_ _ -> liftM unStRWS mSt+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-}+instance MonadBaseControl b m => MonadBaseControl b (GGWidget master m) where+ newtype StM (GGWidget master m) a = StMT {unStMT :: ComposeSt (GGWidget master) m a}+ liftBaseWith = defaultLiftBaseWith StMT+ restoreM = defaultRestoreM unStMT+#endif instance MonadTrans (GGWidget m) where lift = GWidget . lift
+ test/YesodCoreTest/Cache.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.Cache (cacheTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit()++import Network.Wai+import Network.Wai.Test++import Yesod.Core++data C = C++key :: CacheKey Int+key = $(mkCacheKey)++key2 :: CacheKey Int+key2 = $(mkCacheKey)++mkYesod "C" [parseRoutes|/ RootR GET|]++instance Yesod C where approot _ = ""++getRootR :: Handler ()+getRootR = do+ Nothing <- cacheLookup key+ cacheInsert key 5+ Just 5 <- cacheLookup key+ cacheInsert key 7+ Just 7 <- cacheLookup key+ Nothing <- cacheLookup key2+ cacheDelete key+ Nothing <- cacheLookup key+ return ()++cacheTest :: [Spec]+cacheTest =+ describe "Test.Cache"+ [ it "works" works+ ]++runner :: Session () -> IO ()+runner f = toWaiApp C >>= runSession f++works :: IO ()+works = runner $ do+ res <- request defaultRequest { pathInfo = [] }+ assertStatus 200 res
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 0.9.3.4+version: 0.9.3.5 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -24,6 +24,7 @@ test/YesodCoreTest/Links.hs test/YesodCoreTest/InternalRequest.hs test/YesodCoreTest/ErrorHandling.hs+ test/YesodCoreTest/Cache.hs test.hs flag test@@ -63,7 +64,8 @@ , old-locale >= 1.0.0.2 && < 1.1 , failure >= 0.1 && < 0.2 , containers >= 0.2 && < 0.5- , monad-control >= 0.2 && < 0.3+ , monad-control >= 0.2 && < 0.4+ , transformers-base >= 0.4 , enumerator >= 0.4.8 && < 0.5 , cookie >= 0.3 && < 0.4 , blaze-html >= 0.4.1.3 && < 0.5@@ -89,6 +91,7 @@ Yesod.Config Yesod.Internal.TestApi other-modules: Yesod.Internal+ Yesod.Internal.Cache Yesod.Internal.Core Yesod.Internal.Session Yesod.Internal.Request