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 - [email protected] + +- 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 <[email protected]> @@ -21,7 +21,7 @@ README.md library - build-depends: base >= 4.6 && < 5 + build-depends: base >= 4.7 && < 5 , time >= 1.1.4 , wai >= 3.0 , wai-extra >= 3.0.7 ++++++ yesod-core.cabal ++++++ --- /var/tmp/diff_new_pack.BtkTaZ/_old 2017-06-21 13:56:45.874984577 +0200 +++ /var/tmp/diff_new_pack.BtkTaZ/_new 2017-06-21 13:56:45.878984013 +0200 @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.33 +version: 1.4.35 x-revision: 1 license: MIT license-file: LICENSE @@ -28,7 +28,7 @@ , wai-extra >= 3.0.7 , bytestring >= 0.10 , text >= 0.7 - , template-haskell + , template-haskell < 2.12 , path-pieces >= 0.1.2 && < 0.3 , shakespeare >= 2.0 , blaze-builder >= 0.2.1.4 && < 0.5
