Hello community,
here is the log from the commit of package ghc-yesod-core for openSUSE:Factory checked in at 2017-06-21 13:56:42
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-yesod-core (Old)
and /work/SRC/openSUSE:Factory/.ghc-yesod-core.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-yesod-core"
Wed Jun 21 13:56:42 2017 rev:13 rq:504684 version:1.4.35
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-yesod-core/ghc-yesod-core.changes 2017-05-10 20:50:13.829277587 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-yesod-core.new/ghc-yesod-core.changes 2017-06-21 13:56:42.971394153 +0200
@@ -1,0 +2,5 @@
+Mon Jun 12 09:41:42 UTC 2017 - psimons@suse.com
+
+- Update to version 1.4.35 revision 1.
+
+-------------------------------------------------------------------
Old:
----
yesod-core-1.4.33.tar.gz
New:
----
yesod-core-1.4.35.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-yesod-core.spec ++++++
--- /var/tmp/diff_new_pack.BtkTaZ/_old 2017-06-21 13:56:45.703008836 +0200
+++ /var/tmp/diff_new_pack.BtkTaZ/_new 2017-06-21 13:56:45.707008272 +0200
@@ -19,7 +19,7 @@
%global pkg_name yesod-core
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.4.33
+Version: 1.4.35
Release: 0
Summary: Creation of type-safe, RESTful web applications
License: MIT
++++++ yesod-core-1.4.33.tar.gz -> yesod-core-1.4.35.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/ChangeLog.md new/yesod-core-1.4.35/ChangeLog.md
--- old/yesod-core-1.4.33/ChangeLog.md 2017-03-26 17:14:25.000000000 +0200
+++ new/yesod-core-1.4.35/ChangeLog.md 2017-06-05 10:33:22.000000000 +0200
@@ -1,3 +1,12 @@
+## 1.4.35
+
+* Contexts can be included in generated TH instances. [1365](https://github.com/yesodweb/yesod/issues/1365)
+* Type variables can be included in routes.
+
+## 1.4.34
+
+* Add `WaiSubsiteWithAuth`. [#1394](https://github.com/yesodweb/yesod/pull/1394)
+
## 1.4.33
* Adds curly brackets to route parser. [#1363](https://github.com/yesodweb/yesod/pull/1363)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Core/Class/Dispatch.hs new/yesod-core-1.4.35/Yesod/Core/Class/Dispatch.hs
--- old/yesod-core-1.4.33/Yesod/Core/Class/Dispatch.hs 2016-09-25 13:37:06.000000000 +0200
+++ new/yesod-core-1.4.35/Yesod/Core/Class/Dispatch.hs 2017-05-12 07:26:42.000000000 +0200
@@ -10,7 +10,7 @@
import qualified Network.Wai as W
import Yesod.Core.Types
import Yesod.Core.Content
-import Yesod.Core.Handler (stripHandlerT)
+import Yesod.Core.Handler (sendWaiApplication, stripHandlerT)
import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Handler
@@ -28,6 +28,15 @@
where
WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
+instance YesodSubDispatch WaiSubsiteWithAuth (HandlerT master IO) where
+ yesodSubDispatch YesodSubRunnerEnv {..} req =
+ ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
+ where
+ base = stripHandlerT handlert ysreGetSub ysreToParentRoute route
+ route = Just $ WaiSubsiteWithAuthRoute (W.pathInfo req) []
+ WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
+ handlert = sendWaiApplication $ set
+
-- | A helper function for creating YesodSubDispatch instances, used by the
-- internal generated code. This function has been exported since 1.4.11.
-- It promotes a subsite handler to a wai application.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Core/Dispatch.hs new/yesod-core-1.4.35/Yesod/Core/Dispatch.hs
--- old/yesod-core-1.4.33/Yesod/Core/Dispatch.hs 2016-12-07 14:51:04.000000000 +0100
+++ new/yesod-core-1.4.35/Yesod/Core/Dispatch.hs 2017-05-12 07:26:42.000000000 +0200
@@ -34,6 +34,7 @@
, defaultMiddlewaresNoLogging
-- * WAI subsites
, WaiSubsite (..)
+ , WaiSubsiteWithAuth (..)
, subHelper
) where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Core/Internal/TH.hs new/yesod-core-1.4.35/Yesod/Core/Internal/TH.hs
--- old/yesod-core-1.4.33/Yesod/Core/Internal/TH.hs 2016-09-25 13:37:06.000000000 +0200
+++ new/yesod-core-1.4.35/Yesod/Core/Internal/TH.hs 2017-06-05 10:33:22.000000000 +0200
@@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
module Yesod.Core.Internal.TH where
import Prelude hiding (exp)
@@ -15,12 +16,18 @@
import qualified Network.Wai as W
import Data.ByteString.Lazy.Char8 ()
+#if MIN_VERSION_base(4,8,0)
+import Data.List (foldl', uncons)
+#else
import Data.List (foldl')
+#endif
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad (replicateM, void)
import Data.Either (partitionEithers)
+import Text.Parsec (parse, many1, many, eof, try, option, sepBy1)
+import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)
import Yesod.Routes.TH
import Yesod.Routes.Parse
@@ -55,8 +62,40 @@
mkYesodDataGeneral :: String -> Bool -> [ResourceTree String] -> Q [Dec]
mkYesodDataGeneral name isSub res = do
- let (name':rest) = words name
- fst <$> mkYesodGeneral name' (fmap Left rest) isSub return res
+ let (name', rest, cxt) = case parse parseName "" name of
+ Left err -> error $ show err
+ Right a -> a
+ fst <$> mkYesodGeneral' cxt name' (fmap Left rest) isSub return res
+
+ where
+ parseName = do
+ cxt <- option [] parseContext
+ name' <- parseWord
+ args <- many parseWord
+ spaces
+ eof
+ return ( name', args, cxt)
+
+ parseWord = do
+ spaces
+ many1 alphaNum
+
+ parseContext = try $ do
+ cxts <- parseParen parseContexts
+ spaces
+ _ <- string "=>"
+ return cxts
+
+ parseParen p = do
+ spaces
+ _ <- char '('
+ r <- p
+ spaces
+ _ <- char ')'
+ return r
+
+ parseContexts =
+ sepBy1 (many1 parseWord) (spaces >> char ',' >> return ())
-- | See 'mkYesodData'.
mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
@@ -80,7 +119,23 @@
-> (Exp -> Q Exp) -- ^ unwrap handler
-> [ResourceTree String]
-> Q([Dec],[Dec])
-mkYesodGeneral namestr args isSub f resS = do
+mkYesodGeneral = mkYesodGeneral' []
+
+mkYesodGeneral' :: [[String]] -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
+ -> String -- ^ foundation type
+ -> [Either String [String]] -- ^ arguments for the type
+ -> Bool -- ^ is this a subsite
+ -> (Exp -> Q Exp) -- ^ unwrap handler
+ -> [ResourceTree String]
+ -> Q([Dec],[Dec])
+mkYesodGeneral' appCxt' namestr args isSub f resS = do
+ let appCxt = fmap (\(c:rest) ->
+#if MIN_VERSION_template_haskell(2,10,0)
+ foldl' (\acc v -> acc `AppT` nameToType v) (ConT $ mkName c) rest
+#else
+ ClassP (mkName c) $ fmap nameToType rest
+#endif
+ ) appCxt'
mname <- lookupTypeName namestr
arity <- case mname of
Just name -> do
@@ -105,10 +160,13 @@
vns <- replicateM (arity - length mtys) $ newName "t"
-- Base type (site type with variables)
let (argtypes,cxt) = (\(ns,r,cs) -> (ns ++ fmap VarT r, cs)) $
- foldr (\arg (xs,n:ns,cs) ->
+ foldr (\arg (xs,vns',cs) ->
case arg of
- Left t -> ( ConT (mkName t):xs, n:ns, cs )
- Right ts -> ( VarT n :xs, ns
+ Left t ->
+ ( nameToType t:xs, vns', cs )
+ Right ts ->
+ let (n, ns) = maybe (error "mkYesodGeneral: Should be unreachable.") id $ uncons vns' in
+ ( VarT n : xs, ns
, fmap (\t ->
#if MIN_VERSION_template_haskell(2,10,0)
AppT (ConT $ mkName t) (VarT n)
@@ -118,11 +176,11 @@
) ts ++ cs )
) ([],vns,[]) args
site = foldl' AppT (ConT name) argtypes
- res = map (fmap parseType) resS
- renderRouteDec <- mkRenderRouteInstance site res
- routeAttrsDec <- mkRouteAttrsInstance site res
+ res = map (fmap (parseType . dropBracket)) resS
+ renderRouteDec <- mkRenderRouteInstance' appCxt site res
+ routeAttrsDec <- mkRouteAttrsInstance' appCxt site res
dispatchDec <- mkDispatchInstance site cxt f res
- parse <- mkParseRouteInstance site res
+ parseRoute <- mkParseRouteInstance' appCxt site res
let rname = mkName $ "resources" ++ namestr
eres <- lift resS
let resourcesDec =
@@ -130,7 +188,7 @@
, FunD rname [Clause [] (NormalB eres) []]
]
let dataDec = concat
- [ [parse]
+ [ [parseRoute]
, renderRouteDec
, [routeAttrsDec]
, resourcesDec
@@ -138,6 +196,12 @@
]
return (dataDec, dispatchDec)
+#if !MIN_VERSION_base(4,8,0)
+ where
+ uncons (h:t) = Just (h,t)
+ uncons _ = Nothing
+#endif
+
mkMDS :: (Exp -> Q Exp) -> Q Exp -> MkDispatchSettings a site b
mkMDS f rh = MkDispatchSettings
{ mdsRunHandler = rh
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Core/Types.hs new/yesod-core-1.4.35/Yesod/Core/Types.hs
--- old/yesod-core-1.4.33/Yesod/Core/Types.hs 2017-02-05 13:38:01.000000000 +0100
+++ new/yesod-core-1.4.35/Yesod/Core/Types.hs 2017-05-12 07:26:42.000000000 +0200
@@ -175,9 +175,14 @@
type Texts = [Text]
--- | Wrap up a normal WAI application as a Yesod subsite.
+-- | Wrap up a normal WAI application as a Yesod subsite. Ignore parent site's middleware and isAuthorized.
newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
+-- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized.
+--
+-- @since 1.4.34
+newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
+
data RunHandlerEnv site = RunHandlerEnv
{ rheRender :: !(Route site -> [(Text, Text)] -> Text)
, rheRoute :: !(Maybe (Route site))
@@ -560,6 +565,14 @@
instance ParseRoute WaiSubsite where
parseRoute (x, y) = Just $ WaiSubsiteRoute x y
+instance RenderRoute WaiSubsiteWithAuth where
+ data Route WaiSubsiteWithAuth = WaiSubsiteWithAuthRoute [Text] [(Text,Text)]
+ deriving (Show, Eq, Read, Ord)
+ renderRoute (WaiSubsiteWithAuthRoute ps qs) = (ps,qs)
+
+instance ParseRoute WaiSubsiteWithAuth where
+ parseRoute (x, y) = Just $ WaiSubsiteWithAuthRoute x y
+
data Logger = Logger
{ loggerSet :: !LoggerSet
, loggerDate :: !DateCacheGetter
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Routes/Parse.hs new/yesod-core-1.4.35/Yesod/Routes/Parse.hs
--- old/yesod-core-1.4.33/Yesod/Routes/Parse.hs 2017-03-26 17:13:58.000000000 +0200
+++ new/yesod-core-1.4.35/Yesod/Routes/Parse.hs 2017-06-05 10:33:22.000000000 +0200
@@ -10,10 +10,12 @@
, parseType
, parseTypeTree
, TypeTree (..)
+ , dropBracket
+ , nameToType
) where
import Language.Haskell.TH.Syntax
-import Data.Char (isUpper, isSpace)
+import Data.Char (isUpper, isLower, isSpace)
import Language.Haskell.TH.Quote
import qualified System.IO as SIO
import Yesod.Routes.TH
@@ -252,14 +254,18 @@
gos' (front . (t:)) xs'
ttToType :: TypeTree -> Type
-ttToType (TTTerm s) = ConT $ mkName s
+ttToType (TTTerm s) = nameToType s
ttToType (TTApp x y) = ttToType x `AppT` ttToType y
ttToType (TTList t) = ListT `AppT` ttToType t
+nameToType :: String -> Type
+nameToType t@(h:_) | isLower h = VarT $ mkName t
+nameToType t = ConT $ mkName t
+
pieceFromString :: String -> Either (CheckOverlap, String) (CheckOverlap, Piece String)
-pieceFromString ('#':'!':x) = Right $ (False, dynamicPieceFromString x)
-pieceFromString ('!':'#':x) = Right $ (False, dynamicPieceFromString x) -- https://github.com/yesodweb/yesod/issues/652
-pieceFromString ('#':x) = Right $ (True, dynamicPieceFromString x)
+pieceFromString ('#':'!':x) = Right $ (False, Dynamic $ dropBracket x)
+pieceFromString ('!':'#':x) = Right $ (False, Dynamic $ dropBracket x) -- https://github.com/yesodweb/yesod/issues/652
+pieceFromString ('#':x) = Right $ (True, Dynamic $ dropBracket x)
pieceFromString ('*':'!':x) = Left (False, x)
pieceFromString ('+':'!':x) = Left (False, x)
@@ -273,9 +279,9 @@
pieceFromString ('!':x) = Right $ (False, Static x)
pieceFromString x = Right $ (True, Static x)
-dynamicPieceFromString :: String -> Piece String
-dynamicPieceFromString str@('{':x) = case break (== '}') x of
- (s, "}") -> Dynamic s
- _ -> error $ "Invalid path piece: " ++ str
-dynamicPieceFromString x = Dynamic x
--- JP: Should we check if there are curly brackets or other invalid characters?
+dropBracket :: String -> String
+dropBracket str@('{':x) = case break (== '}') x of
+ (s, "}") -> s
+ _ -> error $ "Unclosed bracket ('{'): " ++ str
+dropBracket x = x
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Routes/TH/ParseRoute.hs new/yesod-core-1.4.35/Yesod/Routes/TH/ParseRoute.hs
--- old/yesod-core-1.4.33/Yesod/Routes/TH/ParseRoute.hs 2016-09-25 13:37:06.000000000 +0200
+++ new/yesod-core-1.4.35/Yesod/Routes/TH/ParseRoute.hs 2017-06-05 10:33:22.000000000 +0200
@@ -3,6 +3,7 @@
module Yesod.Routes.TH.ParseRoute
( -- ** ParseRoute
mkParseRouteInstance
+ , mkParseRouteInstance'
) where
import Yesod.Routes.TH.Types
@@ -12,7 +13,10 @@
import Yesod.Routes.TH.Dispatch
mkParseRouteInstance :: Type -> [ResourceTree a] -> Q Dec
-mkParseRouteInstance typ ress = do
+mkParseRouteInstance = mkParseRouteInstance' []
+
+mkParseRouteInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec
+mkParseRouteInstance' cxt typ ress = do
cls <- mkDispatchClause
MkDispatchSettings
{ mdsRunHandler = [|\_ _ x _ -> x|]
@@ -28,7 +32,7 @@
(map removeMethods ress)
helper <- newName "helper"
fixer <- [|(\f x -> f () x) :: (() -> ([Text], [(Text, Text)]) -> Maybe (Route a)) -> ([Text], [(Text, Text)]) -> Maybe (Route a)|]
- return $ instanceD [] (ConT ''ParseRoute `AppT` typ)
+ return $ instanceD cxt (ConT ''ParseRoute `AppT` typ)
[ FunD 'parseRoute $ return $ Clause
[]
(NormalB $ fixer `AppE` VarE helper)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Routes/TH/RenderRoute.hs new/yesod-core-1.4.35/Yesod/Routes/TH/RenderRoute.hs
--- old/yesod-core-1.4.33/Yesod/Routes/TH/RenderRoute.hs 2017-02-07 14:12:25.000000000 +0100
+++ new/yesod-core-1.4.35/Yesod/Routes/TH/RenderRoute.hs 2017-06-05 10:33:22.000000000 +0200
@@ -12,6 +12,9 @@
import Language.Haskell.TH (conT)
#endif
import Language.Haskell.TH.Syntax
+#if MIN_VERSION_template_haskell(2,11,0)
+import Data.Bits (xor)
+#endif
import Data.Maybe (maybeToList)
import Control.Monad (replicateM)
import Data.Text (pack)
@@ -156,18 +159,28 @@
cls <- mkRenderRouteClauses ress
(cons, decs) <- mkRouteCons ress
#if MIN_VERSION_template_haskell(2,12,0)
- did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT clazzes)
+ did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT (clazzes False))
+ let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True)
#elif MIN_VERSION_template_haskell(2,11,0)
- did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes
+ did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT (clazzes False)
+ let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True)
#else
- let did = DataInstD [] ''Route [typ] cons clazzes
+ let did = DataInstD [] ''Route [typ] cons clazzes'
+ let sds = []
#endif
return $ instanceD cxt (ConT ''RenderRoute `AppT` typ)
[ did
, FunD (mkName "renderRoute") cls
- ] : decs
+ ]
+ : sds ++ decs
where
- clazzes = [''Show, ''Eq, ''Read]
+#if MIN_VERSION_template_haskell(2,11,0)
+ clazzes standalone = if standalone `xor` null cxt then
+ clazzes'
+ else
+ []
+#endif
+ clazzes' = [''Show, ''Eq, ''Read]
#if MIN_VERSION_template_haskell(2,11,0)
notStrict :: Bang
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/Yesod/Routes/TH/RouteAttrs.hs new/yesod-core-1.4.35/Yesod/Routes/TH/RouteAttrs.hs
--- old/yesod-core-1.4.33/Yesod/Routes/TH/RouteAttrs.hs 2016-09-25 13:37:06.000000000 +0200
+++ new/yesod-core-1.4.35/Yesod/Routes/TH/RouteAttrs.hs 2017-06-05 10:33:22.000000000 +0200
@@ -3,6 +3,7 @@
{-# LANGUAGE RecordWildCards #-}
module Yesod.Routes.TH.RouteAttrs
( mkRouteAttrsInstance
+ , mkRouteAttrsInstance'
) where
import Yesod.Routes.TH.Types
@@ -15,9 +16,12 @@
#endif
mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec
-mkRouteAttrsInstance typ ress = do
+mkRouteAttrsInstance = mkRouteAttrsInstance' []
+
+mkRouteAttrsInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec
+mkRouteAttrsInstance' cxt typ ress = do
clauses <- mapM (goTree id) ress
- return $ instanceD [] (ConT ''RouteAttrs `AppT` typ)
+ return $ instanceD cxt (ConT ''RouteAttrs `AppT` typ)
[ FunD 'routeAttrs $ concat clauses
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.33/yesod-core.cabal new/yesod-core-1.4.35/yesod-core.cabal
--- old/yesod-core-1.4.33/yesod-core.cabal 2017-03-26 17:14:30.000000000 +0200
+++ new/yesod-core-1.4.35/yesod-core.cabal 2017-06-05 10:33:22.000000000 +0200
@@ -1,5 +1,5 @@
name: yesod-core
-version: 1.4.33
+version: 1.4.35
license: MIT
license-file: LICENSE
author: Michael Snoyman