Merge pull request #1223 from erikd/master

yesod-core: Fix for a *very* late change in ghc-8.0 TH api

yesod-core/Yesod/Core/Internal/TH.hs

@@ -9,7 +9,7 @@ module Yesod.Core.Internal.TH where
 import Prelude hiding (exp)
 import Yesod.Core.Handler
 
-import Language.Haskell.TH hiding (cxt)
+import Language.Haskell.TH hiding (cxt, instanceD)
 import Language.Haskell.TH.Syntax
 
 import qualified Network.Wai as W
@@ -106,7 +106,7 @@ mkYesodGeneral namestr args isSub f resS = do
                    case arg of
                      Left  t  -> ( ConT (mkName t):xs, n:ns, cs )
                      Right ts -> ( VarT n         :xs,   ns
-                                 , fmap (\t -> 
+                                 , fmap (\t ->
 #if MIN_VERSION_template_haskell(2,10,0)
                                                AppT (ConT $ mkName t) (VarT n)
 #else
@@ -169,7 +169,7 @@ mkDispatchInstance :: Type                      -- ^ The master site type
 mkDispatchInstance master cxt f res = do
     clause' <- mkDispatchClause (mkMDS f [|yesodRunner|]) res
     let thisDispatch = FunD 'yesodDispatch [clause']
-    return [InstanceD cxt yDispatch [thisDispatch]]
+    return [instanceD cxt yDispatch [thisDispatch]]
   where
     yDispatch = ConT ''YesodDispatch `AppT` master
 
@@ -186,3 +186,10 @@ mkYesodSubDispatch res = do
                     [innerFun]
                 ]
     return $ LetE [fun] (VarE helper)
+
+instanceD :: Cxt -> Type -> [Dec] -> Dec
+#if MIN_VERSION_template_haskell(2,11,0)
+instanceD = InstanceD Nothing
+#else
+instanceD = InstanceD
+#endif

yesod-core/Yesod/Routes/TH/ParseRoute.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Yesod.Routes.TH.ParseRoute
     ( -- ** ParseRoute
@@ -27,7 +28,7 @@ mkParseRouteInstance typ ress = do
         (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 [] (ConT ''ParseRoute `AppT` typ)
         [ FunD 'parseRoute $ return $ Clause
             []
             (NormalB $ fixer `AppE` VarE helper)
@@ -42,3 +43,10 @@ mkParseRouteInstance typ ress = do
 
     fixDispatch (Methods x _) = Methods x []
     fixDispatch x = x
+
+instanceD :: Cxt -> Type -> [Dec] -> Dec
+#if MIN_VERSION_template_haskell(2,11,0)
+instanceD = InstanceD Nothing
+#else
+instanceD = InstanceD
+#endif

yesod-core/Yesod/Routes/TH/RenderRoute.hs

@@ -158,7 +158,7 @@ mkRenderRouteInstance' cxt typ ress = do
 #else
     let did = DataInstD [] ''Route [typ] cons clazzes
 #endif
-    return $ InstanceD cxt (ConT ''RenderRoute `AppT` typ)
+    return $ instanceD cxt (ConT ''RenderRoute `AppT` typ)
         [ did
         , FunD (mkName "renderRoute") cls
         ] : decs
@@ -172,3 +172,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
 notStrict :: Strict
 notStrict = NotStrict
 #endif
+
+instanceD :: Cxt -> Type -> [Dec] -> Dec
+#if MIN_VERSION_template_haskell(2,11,0)
+instanceD = InstanceD Nothing
+#else
+instanceD = InstanceD
+#endif

yesod-core/Yesod/Routes/TH/RouteAttrs.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE RecordWildCards #-}
 module Yesod.Routes.TH.RouteAttrs
@@ -13,7 +14,7 @@ import Data.Text (pack)
 mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec
 mkRouteAttrsInstance typ ress = do
     clauses <- mapM (goTree id) ress
-    return $ InstanceD [] (ConT ''RouteAttrs `AppT` typ)
+    return $ instanceD [] (ConT ''RouteAttrs `AppT` typ)
         [ FunD 'routeAttrs $ concat clauses
         ]
 
@@ -36,3 +37,10 @@ goRes front Resource {..} =
         []
   where
     toText s = VarE 'pack `AppE` LitE (StringL s)
+
+instanceD :: Cxt -> Type -> [Dec] -> Dec
+#if MIN_VERSION_template_haskell(2,11,0)
+instanceD = InstanceD Nothing
+#else
+instanceD = InstanceD
+#endif

yesod-core/test/Hierarchy.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
 module Hierarchy
     ( hierarchy
     , Dispatcher (..)
@@ -124,7 +125,11 @@ do
         , mdsUnwrapper = return
         } resources
     return
+#if MIN_VERSION_template_haskell(2,11,0)
+        $ InstanceD Nothing
+#else
         $ InstanceD
+#endif
             []
             (ConT ''Dispatcher
                 `AppT` ConT ''Hierarchy

yesod-core/test/RouteSpec.hs

@@ -95,7 +95,11 @@ do
         , mdsUnwrapper = return
         } ress
     return
+#if MIN_VERSION_template_haskell(2,11,0)
+        $ InstanceD Nothing
+#else
         $ InstanceD
+#endif
             []
             (ConT ''Dispatcher
                 `AppT` ConT ''MyApp