diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 7ee382e4..6ee1fdda 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,8 @@ +## 1.4.34 + +* 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.32 * Fix warnings diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs index 565466bb..8ee5b4e0 100644 --- a/yesod-core/Yesod/Core/Internal/TH.hs +++ b/yesod-core/Yesod/Core/Internal/TH.hs @@ -16,7 +16,11 @@ import Language.Haskell.TH.Syntax 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 @@ -125,7 +129,13 @@ mkYesodGeneral' :: [[String]] -- ^ Appliction context. Used in Ren -> [ResourceTree String] -> Q([Dec],[Dec]) mkYesodGeneral' appCxt' namestr args isSub f resS = do - let appCxt = fmap (\(c:rest) -> foldl' (\acc v -> acc `AppT` nameToType v) (ConT $ mkName c) rest) appCxt' + 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 @@ -186,6 +196,12 @@ mkYesodGeneral' appCxt' namestr args isSub f resS = do ] 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 --git a/yesod-core/Yesod/Routes/TH/RenderRoute.hs b/yesod-core/Yesod/Routes/TH/RenderRoute.hs index 3e703757..594c4617 100644 --- a/yesod-core/Yesod/Routes/TH/RenderRoute.hs +++ b/yesod-core/Yesod/Routes/TH/RenderRoute.hs @@ -12,7 +12,9 @@ import Yesod.Routes.TH.Types 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) @@ -158,22 +160,27 @@ mkRenderRouteInstance' cxt typ ress = do (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 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 False) -#else - let did = DataInstD [] ''Route [typ] cons (clazzes False) -#endif let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) +#else + let did = DataInstD [] ''Route [typ] cons clazzes' + let sds = [] +#endif return $ instanceD cxt (ConT ''RenderRoute `AppT` typ) [ did , FunD (mkName "renderRoute") cls ] : sds ++ decs where +#if MIN_VERSION_template_haskell(2,11,0) clazzes standalone = if standalone `xor` null cxt then - [''Show, ''Eq, ''Read] + clazzes' else [] +#endif + clazzes' = [''Show, ''Eq, ''Read] #if MIN_VERSION_template_haskell(2,11,0) notStrict :: Bang diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 8fda2795..ed364acc 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.32 +version: 1.4.34 license: MIT license-file: LICENSE author: Michael Snoyman