packages feed

yesod-core 1.1.3.1 → 1.1.4

raw patch · 13 files changed

+61/−53 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Yesod.Dispatch: mkDispatchInstance :: CxtQ -> TypeQ -> TypeQ -> [ResourceTree a] -> DecsQ
- Yesod.Core: class RenderRoute a => Yesod a where approot = ApprootRelative errorHandler = defaultErrorHandler defaultLayout w = do { p <- widgetToPageContent w; mmsg <- getMessage; hamletToRepHtml (\ _render_aIvP -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\ \<html><head><style type="text/css">#synopsis details:not([open]) > ul { visibility: hidden; }</style><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_aIvP; id ((preEscapedText . pack) "</head><body>"); maybeH mmsg (\ msg_aIvQ -> do { id ((preEscapedText . pack) "<p class=\"message\">"); id (toHtml msg_aIvQ); id ((preEscapedText . pack) "</p>") }) Nothing; asHtmlUrl (pageBody p) _render_aIvP; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ requestMethod wai `notElem` ["GET", "HEAD", "OPTIONS", "TRACE"] } authRoute _ = Nothing cleanPath _ s = if corrected == s then Right $ map dropDash s else Left corrected where corrected = filter (not . null) s dropDash t | all (== '-') t = drop 1 t | otherwise = t joinPath _ ar pieces' qs' = fromText ar `mappend` encodePath pieces qs where pieces = if null pieces' then [""] else map addDash pieces' qs = map (encodeUtf8 *** go) qs' go "" = Nothing go x = Just $ encodeUtf8 x addDash t | all (== '-') t = cons '-' t | otherwise = t addStaticContent _ _ _ = return Nothing cookiePath _ = "/" cookieDomain _ = Nothing maximumContentLength _ _ = 2 * 1024 * 1024 getLogger _ = mkLogger True stdout messageLogger a logger loc = messageLoggerSource a logger loc "" messageLoggerSource a logger loc source level msg = if shouldLog a source level then formatLogMessage (loggerDate logger) loc source level msg >>= loggerPutStr logger else return () logLevel _ = LevelInfo gzipSettings _ = def jsLoader _ = BottomOfBody makeSessionBackend _ = do { key <- getKey defaultKeyFile; return $ Just $ clientSessionBackend key 120 } fileUpload _ size | size > 50000 = FileUploadDisk tempFileBackEnd | otherwise = FileUploadMemory lbsBackEnd shouldLog a _ level = level >= logLevel a
+ Yesod.Core: class RenderRoute a => Yesod a where approot = ApprootRelative errorHandler = defaultErrorHandler defaultLayout w = do { p <- widgetToPageContent w; mmsg <- getMessage; hamletToRepHtml (\ _render_aIsI -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\ \<html><head><style type="text/css">#synopsis details:not([open]) > ul { visibility: hidden; }</style><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_aIsI; id ((preEscapedText . pack) "</head><body>"); maybeH mmsg (\ msg_aIsJ -> do { id ((preEscapedText . pack) "<p class=\"message\">"); id (toHtml msg_aIsJ); id ((preEscapedText . pack) "</p>") }) Nothing; asHtmlUrl (pageBody p) _render_aIsI; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ requestMethod wai `notElem` ["GET", "HEAD", "OPTIONS", "TRACE"] } authRoute _ = Nothing cleanPath _ s = if corrected == s then Right $ map dropDash s else Left corrected where corrected = filter (not . null) s dropDash t | all (== '-') t = drop 1 t | otherwise = t joinPath _ ar pieces' qs' = fromText ar `mappend` encodePath pieces qs where pieces = if null pieces' then [""] else map addDash pieces' qs = map (encodeUtf8 *** go) qs' go "" = Nothing go x = Just $ encodeUtf8 x addDash t | all (== '-') t = cons '-' t | otherwise = t addStaticContent _ _ _ = return Nothing cookiePath _ = "/" cookieDomain _ = Nothing maximumContentLength _ _ = 2 * 1024 * 1024 getLogger _ = mkLogger True stdout messageLogger a logger loc = messageLoggerSource a logger loc "" messageLoggerSource a logger loc source level msg = if shouldLog a source level then formatLogMessage (loggerDate logger) loc source level msg >>= loggerPutStr logger else return () logLevel _ = LevelInfo gzipSettings _ = def jsLoader _ = BottomOfBody makeSessionBackend _ = do { key <- getKey defaultKeyFile; return $ Just $ clientSessionBackend key 120 } fileUpload _ size | size > 50000 = FileUploadDisk tempFileBackEnd | otherwise = FileUploadMemory lbsBackEnd shouldLog a _ level = level >= logLevel a

Files

Yesod/Dispatch.hs view
@@ -17,6 +17,7 @@     , mkYesodSubData     , mkYesodDispatch     , mkYesodSubDispatch+    , mkDispatchInstance       -- ** Path pieces     , PathPiece (..)     , PathMultiPiece (..)@@ -35,6 +36,7 @@ import Yesod.Widget (GWidget)  import Web.PathPieces+import Language.Haskell.TH import Language.Haskell.TH.Syntax  import qualified Network.Wai as W@@ -108,50 +110,58 @@ mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True    where (name':rest) = words name -mkYesodGeneral :: String -- ^ foundation type-               -> [String]-               -> Cxt -- ^ classes-               -> Bool -- ^ is subsite?+mkYesodGeneral :: String                   -- ^ foundation type+               -> [String]                 -- ^ arguments for the type+               -> Cxt                      -- ^ the type constraints+               -> Bool                     -- ^ it this a subsite                -> [ResourceTree String]-               -> Q ([Dec], [Dec])+               -> Q([Dec],[Dec]) mkYesodGeneral name args clazzes isSub resS = do-    let args' = map mkName args-        arg = foldl AppT (ConT name') $ map VarT args'-    let res = map (fmap parseType) resS-    renderRouteDec <- mkRenderRouteInstance arg res--    let logger = mkName "logger"-    Clause pat body decs <- mkDispatchClause-        [|yesodRunner $(return $ VarE logger)|]-        [|yesodDispatch $(return $ VarE logger)|]-        [|fmap chooseRep|]-        res-    let disp = Clause (VarP logger : pat) body decs-    let master = mkName "master"-    let ctx = if isSub-                then ClassP (mkName "Yesod") [VarT master] : clazzes-                else []-    let ytyp = if isSub-                then ConT ''YesodDispatch `AppT` arg `AppT` VarT master-                else ConT ''YesodDispatch `AppT` arg `AppT` arg-    let yesodDispatch' =-            InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [disp]]--    return (renderRouteDec ++ masterTypSyns, [yesodDispatch'])-  where-    name' = mkName name-    masterTypSyns-        | isSub = []-        | otherwise =-            [ TySynD-                (mkName "Handler")-                []-                (ConT ''GHandler `AppT` ConT name' `AppT` ConT name')-            , TySynD-                (mkName "Widget")-                []-                (ConT ''GWidget `AppT` ConT name' `AppT` ConT name' `AppT` TupleT 0)-            ]+     subsite        <- sub+     masterTypeSyns <- if isSub then return   [] +                                else sequence [handler, widget]+     renderRouteDec <- mkRenderRouteInstance subsite res+     dispatchDec    <- mkDispatchInstance context sub master res+     return (renderRouteDec ++ masterTypeSyns, dispatchDec)+  where sub     = foldl appT subCons subArgs+        master  = if isSub then (varT $ mkName "master") else sub+        context = if isSub then cxt $ yesod : map return clazzes+                           else return []+        yesod   = classP ''Yesod [master]+        handler = tySynD (mkName "Handler") [] [t| GHandler $master $master    |]+        widget  = tySynD (mkName "Widget")  [] [t| GWidget  $master $master () |]+        res     = map (fmap parseType) resS+        subCons = conT $ mkName name+        subArgs = map (varT. mkName) args+        +-- | If the generation of @'YesodDispatch'@ instance require finer+-- control of the types, contexts etc. using this combinator. You will+-- hardly need this generality. However, in certain situations, like+-- when writing library/plugin for yesod, this combinator becomes+-- handy.+mkDispatchInstance :: CxtQ                -- ^ The context+                   -> TypeQ               -- ^ The subsite type+                   -> TypeQ               -- ^ The master site type+                   -> [ResourceTree a]    -- ^ The resource+                   -> DecsQ+mkDispatchInstance context sub master res = do+  logger <- newName "logger"+  let loggerE = varE logger+      loggerP = VarP logger+      yDispatch = conT ''YesodDispatch `appT` sub `appT` master+      thisDispatch = do+            Clause pat body decs <- mkDispatchClause+                                    [|yesodRunner   $loggerE |]+                                    [|yesodDispatch $loggerE |]+                                    [|fmap chooseRep|]+                                    res+            return $ FunD 'yesodDispatch+                         [ Clause (loggerP:pat)+                                  body+                                  decs+                         ]+      in sequence [instanceD context yDispatch [thisDispatch]]+          -- | Convert the given argument into a WAI application, executable with any WAI -- handler. This is the same as 'toWaiAppPlain', except it includes two
Yesod/Handler.hs view
@@ -1034,6 +1034,14 @@     liftIO = GHandler . const . lift instance MonadBase IO (GHandler sub master) where     liftBase = GHandler . const . lift+-- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s+-- @fork@ function is incompatible with the underlying @ResourceT@ system.+-- Instead, if you must fork a separate thread, you should use+-- @resourceForkIO@.+--+-- Using fork usually leads to an exception that says+-- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed+-- after cleanup. Please contact the maintainers.\" instance MonadBaseControl IO (GHandler sub master) where     data StM (GHandler sub master) a = StH (StM (ResourceT IO) a)     liftBaseWith f = GHandler $ \reader ->
test/YesodCoreTest/Cache.hs view
@@ -4,7 +4,6 @@ module YesodCoreTest.Cache (cacheTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit()  import Network.Wai import Network.Wai.Test
test/YesodCoreTest/CleanPath.hs view
@@ -4,7 +4,6 @@ module YesodCoreTest.CleanPath (cleanPathTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit()  import Yesod.Core hiding (Request)
test/YesodCoreTest/ErrorHandling.hs view
@@ -6,7 +6,6 @@     ) where import Yesod.Core import Test.Hspec-import Test.Hspec.HUnit() import Network.Wai import Network.Wai.Test import Text.Hamlet (hamlet)
test/YesodCoreTest/Exceptions.hs view
@@ -4,7 +4,6 @@ module YesodCoreTest.Exceptions (exceptionsTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit ()  import Yesod.Core hiding (Request) import Network.Wai
test/YesodCoreTest/JsLoader.hs view
@@ -7,7 +7,6 @@ import YesodCoreTest.JsLoaderSites.Bottom (B(..))  import Test.Hspec-import Test.Hspec.HUnit ()  import Yesod.Core hiding (Request) import Network.Wai.Test
test/YesodCoreTest/Links.hs view
@@ -4,7 +4,6 @@ module YesodCoreTest.Links (linksTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit ()  import Yesod.Core hiding (Request) import Text.Hamlet
test/YesodCoreTest/Media.hs view
@@ -5,7 +5,6 @@ module YesodCoreTest.Media (mediaTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit () import Yesod.Core hiding (Request) import Network.Wai import Network.Wai.Test
test/YesodCoreTest/NoOverloadedStrings.hs view
@@ -3,7 +3,6 @@ module YesodCoreTest.NoOverloadedStrings (noOverloadedTest, Widget) where  import Test.Hspec-import Test.Hspec.HUnit ()  import Yesod.Core hiding (Request) import Network.Wai.Test
test/YesodCoreTest/Widget.hs view
@@ -4,7 +4,6 @@ module YesodCoreTest.Widget (widgetTest) where  import Test.Hspec-import Test.Hspec.HUnit ()  import Yesod.Core hiding (Request) import Text.Julius
test/YesodCoreTest/YesodTest.hs view
@@ -13,7 +13,6 @@ import Network.Wai.Test import Network.Wai import Test.Hspec-import Test.Hspec.HUnit()  yesod :: (YesodDispatch y y, Yesod y) => y -> Session a -> IO a yesod app f = toWaiApp app >>= runSession f
yesod-core.cabal view
@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.1.3.1+version:         1.1.4 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>