Merge branch 'ghc-9.2-compat' of https://github.com/TeofilC/yesod

yesod-bin/AddHandler.hs

@@ -16,6 +16,9 @@ import Distribution.PackageDescription.Parse (readGenericPackageDescription)
 #else
 import Distribution.PackageDescription.Parse (readPackageDescription)
 #endif
+#if MIN_VERSION_Cabal(3, 6, 0)
+import Distribution.Utils.Path
+#endif
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 import Distribution.PackageDescription (allBuildInfo, hsSourceDirs)
 import Distribution.Verbosity (normal)
@@ -247,4 +250,8 @@ getSrcDir cabal = do
 #endif
     let buildInfo = allBuildInfo pd
         srcDirs = concatMap hsSourceDirs buildInfo
+#if MIN_VERSION_Cabal(3, 6, 0)
+    return $ maybe "." getSymbolicPath $ listToMaybe srcDirs
+#else
     return $ fromMaybe "." $ listToMaybe srcDirs
+#endif

yesod-bin/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-bin
 
+## 1.6.2.1
+
+* Support Cabal 3.6 [#1754](https://github.com/yesodweb/yesod/pull/1754)
+
 ## 1.6.2
 
 * aeson 2.0

yesod-bin/yesod-bin.cabal

@@ -1,5 +1,5 @@
 name:            yesod-bin
-version:         1.6.2
+version:         1.6.2.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-core/ChangeLog.md

@@ -5,6 +5,7 @@
 * Add missing list to documentation for ``Yesod.Core.Dispatch.warp``. [#1745](https://github.com/yesodweb/yesod/pull/1745)
 * Add instances for `ToContent Void`, `ToTypedContent Void`. [#1752](https://github.com/yesodweb/yesod/pull/1752)
 * Handle async exceptions within yesod rather then warp. [#1753](https://github.com/yesodweb/yesod/pull/1753)
+* Support template-haskell 2.18 [#1754](https://github.com/yesodweb/yesod/pull/1754)
 
 ## 1.6.21.0
 

yesod-core/src/Yesod/Routes/TH/Dispatch.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards, TemplateHaskell, ViewPatterns #-}
 module Yesod.Routes.TH.Dispatch
     ( MkDispatchSettings (..)
@@ -73,7 +74,7 @@ mkDispatchClause MkDispatchSettings {..} resources = do
     handlePiece (Static str) = return (LitP $ StringL str, Nothing)
     handlePiece (Dynamic _) = do
         x <- newName "dyn"
-        let pat = ViewP (VarE 'fromPathPiece) (ConP 'Just [VarP x])
+        let pat = ViewP (VarE 'fromPathPiece) (conPCompat 'Just [VarP x])
         return (pat, Just $ VarE x)
 
     handlePieces :: [Piece a] -> Q ([Pat], [Exp])
@@ -86,7 +87,7 @@ mkDispatchClause MkDispatchSettings {..} resources = do
     mkPathPat final =
         foldr addPat final
       where
-        addPat x y = ConP '(:) [x, y]
+        addPat x y = conPCompat '(:) [x, y]
 
     go :: SDC -> ResourceTree a -> Q Clause
     go sdc (ResourceParent name _check pieces children) = do
@@ -124,11 +125,11 @@ mkDispatchClause MkDispatchSettings {..} resources = do
                 Methods multi methods -> do
                     (finalPat, mfinalE) <-
                         case multi of
-                            Nothing -> return (ConP '[] [], Nothing)
+                            Nothing -> return (conPCompat '[] [], Nothing)
                             Just _ -> do
                                 multiName <- newName "multi"
                                 let pat = ViewP (VarE 'fromPathMultiPiece)
-                                                (ConP 'Just [VarP multiName])
+                                                (conPCompat 'Just [VarP multiName])
                                 return (pat, Just $ VarE multiName)
 
                     let dynsMulti =
@@ -200,3 +201,10 @@ mkDispatchClause MkDispatchSettings {..} resources = do
 defaultGetHandler :: Maybe String -> String -> Q Exp
 defaultGetHandler Nothing s = return $ VarE $ mkName $ "handle" ++ s
 defaultGetHandler (Just method) s = return $ VarE $ mkName $ map toLower method ++ s
+
+conPCompat :: Name -> [Pat] -> Pat
+conPCompat n pats = ConP n
+#if MIN_VERSION_template_haskell(2,18,0)
+                         []
+#endif
+                         pats

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

@@ -67,7 +67,7 @@ mkRenderRouteClauses =
         let cnt = length $ filter isDynamic pieces
         dyns <- replicateM cnt $ newName "dyn"
         child <- newName "child"
-        let pat = ConP (mkName name) $ map VarP $ dyns ++ [child]
+        let pat = conPCompat (mkName name) $ map VarP $ dyns ++ [child]
 
         pack' <- [|pack|]
         tsp <- [|toPathPiece|]
@@ -100,7 +100,7 @@ mkRenderRouteClauses =
             case resourceDispatch res of
                 Subsite{} -> return <$> newName "sub"
                 _ -> return []
-        let pat = ConP (mkName $ resourceName res) $ map VarP $ dyns ++ sub
+        let pat = conPCompat (mkName $ resourceName res) $ map VarP $ dyns ++ sub
 
         pack' <- [|pack|]
         tsp <- [|toPathPiece|]
@@ -182,3 +182,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
 
 instanceD :: Cxt -> Type -> [Dec] -> Dec
 instanceD = InstanceD Nothing
+
+conPCompat :: Name -> [Pat] -> Pat
+conPCompat n pats = ConP n
+#if MIN_VERSION_template_haskell(2,18,0)
+                         []
+#endif
+                         pats

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE RecordWildCards #-}
 module Yesod.Routes.TH.RouteAttrs
@@ -26,7 +27,11 @@ goTree front (ResourceParent name _check pieces trees) =
     toIgnore = length $ filter isDynamic pieces
     isDynamic Dynamic{} = True
     isDynamic Static{} = False
-    front' = front . ConP (mkName name) . ignored
+    front' = front . ConP (mkName name)
+#if MIN_VERSION_template_haskell(2,18,0)
+                          []
+#endif
+                   . ignored
 
 goRes :: (Pat -> Pat) -> Resource a -> Q Clause
 goRes front Resource {..} =