yesod-core 1.6.18 → 1.6.18.4

raw patch · 15 files changed

+201/−44 lines, 15 files

Files

• ChangeLog.md +16/−0
• src/Yesod/Core/Class/Yesod.hs +2/−2
• src/Yesod/Core/Handler.hs +15/−14
• src/Yesod/Core/Internal/Request.hs +1/−1
• src/Yesod/Core/Internal/TH.hs +6/−3
• src/Yesod/Routes/Parse.hs +14/−2
• test/RouteSpec.hs +1/−1
• test/YesodCoreTest.hs +2/−0
• test/YesodCoreTest/ParameterizedSite.hs +37/−0
• test/YesodCoreTest/ParameterizedSite/Compat.hs +27/−0
• test/YesodCoreTest/ParameterizedSite/PolyAny.hs +26/−0
• test/YesodCoreTest/ParameterizedSite/PolyShow.hs +28/−0
• test/fixtures/routes_with_line_continuations +0/−11
• test/fixtures/routes_with_line_continuations.yesodroutes +11/−0
• yesod-core.cabal +15/−10

@@ -1,5 +1,21 @@ # ChangeLog for yesod-core +## 1.6.18.4++* Fixed a bug where `mkYesod` and other TH functions didn't work for datatypes with explicitly stated type variables, including the case with typeclass constraints. [https://github.com/yesodweb/yesod/pull/1697](#1697)++## 1.6.18.3++* Remove mention of an oudated Yesod type (`GHandler`) from the docs for `handlerToIO`. [https://github.com/yesodweb/yesod/pull/1695](#1695)++## 1.6.18.2++* Recommends `.yesodroutes` as the file extension for Yesod routes files. [#1686](https://github.com/yesodweb/yesod/pull/1686)++## 1.6.18.1++* Increase the size of CSRF token+ ## 1.6.18  * Add functions for setting description and OG meta [#1663](https://github.com/yesodweb/yesod/pull/1663)

@@ -531,8 +531,8 @@                     => WidgetFor site ()                     -> HandlerFor site (PageContent (Route site)) widgetToPageContent w = do-  jsAttrs <- jsAttributesHandler-  HandlerFor $ \hd -> do+ jsAttrs <- jsAttributesHandler+ HandlerFor $ \hd -> do   master <- unHandlerFor getYesod hd   ref <- newIORef mempty   unWidgetFor w WidgetData

@@ -9,6 +9,7 @@ {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-} --------------------------------------------------------- -- -- Module        : Yesod.Handler@@ -369,10 +370,10 @@ getCurrentRoute :: MonadHandler m => m (Maybe (Route (HandlerSite m))) getCurrentRoute = rheRoute <$> askHandlerEnv --- | Returns a function that runs 'HandlerT' actions inside @IO@.+-- | Returns a function that runs 'HandlerFor' actions inside @IO@. ----- Sometimes you want to run an inner 'HandlerT' action outside--- the control flow of an HTTP request (on the outer 'HandlerT'+-- Sometimes you want to run an inner 'HandlerFor' action outside+-- the control flow of an HTTP request (on the outer 'HandlerFor' -- action).  For example, you may want to spawn a new thread: -- -- @@@ -380,30 +381,30 @@ -- getFooR = do --   runInnerHandler <- handlerToIO --   liftIO $ forkIO $ runInnerHandler $ do---     /Code here runs inside GHandler but on a new thread./---     /This is the inner GHandler./+--     /Code here runs inside HandlerFor but on a new thread./+--     /This is the inner HandlerFor./ --     ... --   /Code here runs inside the request's control flow./---   /This is the outer GHandler./+--   /This is the outer HandlerFor./ --   ... -- @ -- -- Another use case for this function is creating a stream of--- server-sent events using 'GHandler' actions (see+-- server-sent events using 'HandlerFor' actions (see -- @yesod-eventsource@). ----- Most of the environment from the outer 'GHandler' is preserved--- on the inner 'GHandler', however:+-- Most of the environment from the outer 'HandlerFor' is preserved+-- on the inner 'HandlerFor', however: -- --  * The request body is cleared (otherwise it would be very --  difficult to prevent huge memory leaks). -----  * The cache is cleared (see 'CacheKey').+--  * The cache is cleared (see 'cached'). ----- Changes to the response made inside the inner 'GHandler' are+-- Changes to the response made inside the inner 'HandlerFor' are -- ignored (e.g., session variables, cookies, response headers).--- This allows the inner 'GHandler' to outlive the outer--- 'GHandler' (e.g., on the @forkIO@ example above, a response+-- This allows the inner 'HandlerFor' to outlive the outer+-- 'HandlerFor' (e.g., on the @forkIO@ example above, a response -- may be sent to the client without killing the new thread). handlerToIO :: MonadIO m => HandlerFor site (HandlerFor site a -> m a) handlerToIO =@@ -428,7 +429,7 @@     -- xx From this point onwards, no references to oldHandlerData xx     liftIO $ evaluate (newReq `seq` oldEnv `seq` newState `seq` ()) -    -- Return GHandler running function.+    -- Return HandlerFor running function.     return $ \(HandlerFor f) ->       liftIO $       runResourceT $ withInternalState $ \resState -> do

@@ -129,7 +129,7 @@                 -- Already have a token, use it.                 Just bs -> Left $ Just $ decodeUtf8With lenientDecode bs                 -- Don't have a token, get a random generator and make a new one.-                Nothing -> Right $ fmap Just . randomString 10+                Nothing -> Right $ fmap Just . randomString 40         | otherwise = Left Nothing  textQueryString :: W.Request -> [(Text, Text)]

@@ -141,9 +141,12 @@     let name = mkName namestr     -- Generate as many variable names as the arity indicates     vns <- replicateM (arity - length mtys) $ newName "t"-        -- Base type (site type with variables)+    -- types that you apply to get a concrete site name     let argtypes = fmap nameToType mtys ++ fmap VarT vns-        site = foldl' AppT (ConT name) argtypes+    -- typevars that should appear in synonym head+    let argvars = (fmap mkName . filter isTvar) mtys ++ vns+        -- Base type (site type with variables)+    let site = foldl' AppT (ConT name) argtypes         res = map (fmap (parseType . dropBracket)) resS     renderRouteDec <- mkRenderRouteInstance appCxt site res     routeAttrsDec  <- mkRouteAttrsInstance appCxt site res@@ -160,7 +163,7 @@             , renderRouteDec             , [routeAttrsDec]             , resourcesDec-            , if isSub then [] else masterTypeSyns vns site+            , if isSub then [] else masterTypeSyns argvars site             ]     return (dataDec, dispatchDec) 

@@ -11,6 +11,7 @@     , TypeTree (..)     , dropBracket     , nameToType+    , isTvar     ) where  import Language.Haskell.TH.Syntax@@ -35,9 +36,15 @@             [] -> lift res             z -> error $ unlines $ "Overlapping routes: " : map show z +-- | Same as 'parseRoutes', but uses an external file instead of quasiquotation.+--+-- The recommended file extension is @.yesodroutes@. parseRoutesFile :: FilePath -> Q Exp parseRoutesFile = parseRoutesFileWith parseRoutes +-- | Same as 'parseRoutesNoCheck', but uses an external file instead of quasiquotation.+--+-- The recommended file extension is @.yesodroutes@. parseRoutesFileNoCheck :: FilePath -> Q Exp parseRoutesFileNoCheck = parseRoutesFileWith parseRoutesNoCheck @@ -258,8 +265,13 @@ ttToType (TTList t) = ListT `AppT` ttToType t  nameToType :: String -> Type-nameToType t@(h:_) | isLower h = VarT $ mkName t-nameToType t = ConT $ mkName t+nameToType t = if isTvar t+               then VarT $ mkName t+               else ConT $ mkName t++isTvar :: String -> Bool+isTvar (h:_) = isLower h+isTvar _     = False  pieceFromString :: String -> Either (CheckOverlap, String) (CheckOverlap, Piece String) pieceFromString ('#':'!':x) = Right $ (False, Dynamic $ dropBracket x)

@@ -227,7 +227,7 @@     describe "routing table parsing" $ do         it "recognizes trailing backslashes as line continuation directives" $ do             let routes :: [ResourceTree String]-                routes = $(parseRoutesFile "test/fixtures/routes_with_line_continuations")+                routes = $(parseRoutesFile "test/fixtures/routes_with_line_continuations.yesodroutes")             length routes @?= 3      describe "overlap checking" $ do

@@ -11,6 +11,7 @@ import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling import YesodCoreTest.Cache+import YesodCoreTest.ParameterizedSite import qualified YesodCoreTest.WaiSubsite as WaiSubsite import qualified YesodCoreTest.Redirect as Redirect import qualified YesodCoreTest.JsLoader as JsLoader@@ -43,6 +44,7 @@       internalRequestTest       errorHandlingTest       cacheTest+      parameterizedSiteTest       WaiSubsite.specs       Redirect.specs       JsLoader.specs

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module YesodCoreTest.ParameterizedSite+    ( parameterizedSiteTest+    ) where++import Data.ByteString.Lazy (ByteString)+import Network.Wai.Test (runSession, request, defaultRequest, assertBodyContains)+import Test.Hspec (Spec, describe, it)+import Yesod.Core (YesodDispatch)+import Yesod.Core.Dispatch (toWaiApp)++import YesodCoreTest.ParameterizedSite.PolyAny (PolyAny (..))+import YesodCoreTest.ParameterizedSite.PolyShow (PolyShow (..))+import YesodCoreTest.ParameterizedSite.Compat (Compat (..))++-- These are actually tests for template haskell. So if it compiles, it works+parameterizedSiteTest :: Spec+parameterizedSiteTest = describe "Polymorphic Yesod sites" $ do+    it "Polymorphic unconstrained stub" $ runStub (PolyAny ())+    it "Polymorphic stub with Show" $ runStub' "1337" (PolyShow 1337)+    it "Polymorphic unconstrained stub, old-style" $ runStub (Compat () ())++runStub :: YesodDispatch a => a -> IO ()+runStub stub =+    let actions = do+            res <- request defaultRequest+            assertBodyContains "Stub" res+    in toWaiApp stub >>= runSession actions+++runStub' :: YesodDispatch a => ByteString -> a -> IO ()+runStub' body stub =+    let actions = do+            res <- request defaultRequest+            assertBodyContains "Stub" res+            assertBodyContains body res+    in toWaiApp stub >>= runSession actions

@@ -0,0 +1,27 @@+{-# LANGUAGE+    TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses+  , OverloadedStrings, StandaloneDeriving, FlexibleInstances+  #-}+module YesodCoreTest.ParameterizedSite.Compat+    ( Compat (..)+    ) where++import Yesod.Core++-- | Parameterized without constraints, and we call mkYesod without type vars,+-- like people used to do before the last 3 commits+data Compat a b = Compat a b++mkYesod "Compat" [parseRoutes|+/ HomeR GET+|]++instance Yesod (Compat a b)++getHomeR :: Handler a b Html+getHomeR = defaultLayout+    [whamlet|+        <p>+            Stub+    |]+

@@ -0,0 +1,26 @@+{-# LANGUAGE+    TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses+  , OverloadedStrings, StandaloneDeriving, FlexibleInstances+  #-}+module YesodCoreTest.ParameterizedSite.PolyAny+    ( PolyAny (..)+    ) where++import Yesod.Core++-- | Parameterized without constraints+data PolyAny a = PolyAny a++mkYesod "PolyAny a" [parseRoutes|+/ HomeR GET+|]++instance Yesod (PolyAny a)++getHomeR :: Handler a Html+getHomeR = defaultLayout+    [whamlet|+        <p>+            Stub+    |]+

@@ -0,0 +1,28 @@+{-# LANGUAGE+    TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses+  , OverloadedStrings, StandaloneDeriving, FlexibleInstances+  #-}+module YesodCoreTest.ParameterizedSite.PolyShow+    ( PolyShow (..)+    ) where++import Yesod.Core++-- | Parameterized with 'Show' constraint+data PolyShow a = PolyShow a++mkYesod "(Show a) => PolyShow a" [parseRoutes|+/ HomeR GET+|]++instance Show a => Yesod (PolyShow a)++getHomeR :: Show a => Handler a Html+getHomeR = do+    PolyShow x <- getYesod+    defaultLayout+        [whamlet|+            <p>+                Stub #{show x}+        |]+

@@ -1,11 +0,0 @@--- This fixture to test line continuations is in a separate file--- because when I put it in an in-line quasi-quotation, the compiler--- performed the line continuations processing itself.--/foo1 \-    Foo1-/foo2 Foo2-/foo3 \-    Foo3 \-    GET POST \-    !foo

@@ -0,0 +1,11 @@+-- This fixture to test line continuations is in a separate file+-- because when I put it in an in-line quasi-quotation, the compiler+-- performed the line continuations processing itself.++/foo1 \+    Foo1+/foo2 Foo2+/foo3 \+    Foo3 \+    GET POST \+    !foo

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.6.18+version:         1.6.18.4 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -8,7 +8,7 @@ description:     API docs and the README are available at <http://www.stackage.org/package/yesod-core> category:        Web, Yesod stability:       Stable-cabal-version:   >= 1.8+cabal-version:   >= 1.10 build-type:      Simple homepage:        http://www.yesodweb.com/ extra-source-files:@@ -17,11 +17,12 @@   test/YesodCoreTest/JsLoaderSites/Bottom.hs   test/en.msg   test/test.hs-  test/fixtures/routes_with_line_continuations+  test/fixtures/routes_with_line_continuations.yesodroutes   ChangeLog.md   README.md  library+    default-language: Haskell2010     hs-source-dirs: src      build-depends:   base                  >= 4.10     && < 5@@ -46,7 +47,7 @@                    , parsec                >= 2        && < 3.2                    , path-pieces           >= 0.1.2    && < 0.3                    , primitive             >= 0.6-                   , random                >= 1.0.0.2  && < 1.2+                   , random                >= 1.0.0.2  && < 1.3                    , resourcet             >= 1.2                    , shakespeare           >= 2.0                    , template-haskell      >= 2.11@@ -97,14 +98,12 @@                      Yesod.Routes.TH.RouteAttrs      ghc-options:     -Wall-    -- Following line added due to: https://github.com/yesodweb/yesod/issues/545-    -- This looks like a GHC bug-    extensions:      MultiParamTypeClasses      -- Workaround for: http://ghc.haskell.org/trac/ghc/ticket/8443-    extensions:      TemplateHaskell+    other-extensions:      TemplateHaskell  test-suite test-routes+    default-language: Haskell2010     type: exitcode-stdio-1.0     main-is: RouteSpec.hs     hs-source-dirs: test, src@@ -121,7 +120,7 @@                    Yesod.Routes.TH.Types      -- Workaround for: http://ghc.haskell.org/trac/ghc/ticket/8443-    extensions:      TemplateHaskell+    other-extensions:      TemplateHaskell      build-depends: base                  , hspec@@ -134,6 +133,7 @@                  , HUnit  test-suite tests+    default-language: Haskell2010     type: exitcode-stdio-1.0     main-is: test.hs     hs-source-dirs: test@@ -156,6 +156,10 @@                    YesodCoreTest.MediaData                    YesodCoreTest.NoOverloadedStrings                    YesodCoreTest.NoOverloadedStringsSub+                   YesodCoreTest.ParameterizedSite+                   YesodCoreTest.ParameterizedSite.Compat+                   YesodCoreTest.ParameterizedSite.PolyAny+                   YesodCoreTest.ParameterizedSite.PolyShow                    YesodCoreTest.RawResponse                    YesodCoreTest.Redirect                    YesodCoreTest.Reps@@ -197,9 +201,10 @@                   , warp                   , yesod-core     ghc-options:     -Wall -threaded-    extensions: TemplateHaskell+    other-extensions: TemplateHaskell  benchmark widgets+    default-language: Haskell2010     type: exitcode-stdio-1.0     hs-source-dirs: bench     build-depends:  base