diff --git a/patches/bifunctors-5.6.1.patch b/patches/bifunctors-5.6.1.patch deleted file mode 100644 index a95533532d7e4b0a506af42a9e8c2b1e1393ec4a..0000000000000000000000000000000000000000 --- a/patches/bifunctors-5.6.1.patch +++ /dev/null @@ -1,47 +0,0 @@ -diff --git a/bifunctors.cabal b/bifunctors.cabal -index c9a7b92..d535902 100644 ---- a/bifunctors.cabal -+++ b/bifunctors.cabal -@@ -2,6 +2,7 @@ cabal-version: 1.24 - name: bifunctors - category: Data, Functors - version: 5.6.1 -+x-revision: 2 - license: BSD3 - license-file: LICENSE - author: Edward A. Kmett -@@ -45,9 +46,9 @@ library - base >= 4.9 && < 5, - assoc >= 1.1 && < 1.2, - comonad >= 5.0.7 && < 6, -- containers >= 0.5.7.1 && < 0.7, -- template-haskell >= 2.11 && < 2.21, -- th-abstraction >= 0.4.2.0 && < 0.6, -+ containers >= 0.5.7.1 && < 0.8, -+ template-haskell >= 2.11 && < 2.22, -+ th-abstraction >= 0.4.2.0 && < 0.7, - transformers >= 0.5 && < 0.7 - - if !impl(ghc >= 8.2) -diff --git a/src/Data/Bifunctor/TH.hs b/src/Data/Bifunctor/TH.hs -index 04ec9f1..29c0d65 100644 ---- a/src/Data/Bifunctor/TH.hs -+++ b/src/Data/Bifunctor/TH.hs -@@ -1201,7 +1201,7 @@ mkSimpleLam lam = do - -- Without the underscore, that code would trigger -Wunused-matches warnings. - n <- newName "_n" - body <- lam (VarE n) -- return $ LamE [VarP n] body -+ lamE [varP n] (pure body) - - -- Make a 'LamE' using two fresh variables. - mkSimpleLam2 :: (Exp -> Exp -> Q Exp) -> Q Exp -@@ -1217,7 +1217,7 @@ mkSimpleLam2 lam = do - n1 <- newName "_n1" - n2 <- newName "n2" - body <- lam (VarE n1) (VarE n2) -- return $ LamE [VarP n1, VarP n2] body -+ lamE [varP n1, varP n2] (pure body) - - -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" - -- diff --git a/patches/derive-lifted-instances-0.2.2.patch b/patches/derive-lifted-instances-0.2.2.patch deleted file mode 100644 index ea6cbb18daba85fcea63cafdb2297af778d04850..0000000000000000000000000000000000000000 --- a/patches/derive-lifted-instances-0.2.2.patch +++ /dev/null @@ -1,15 +0,0 @@ -diff --git a/Data/DeriveLiftedInstances/Internal.hs b/Data/DeriveLiftedInstances/Internal.hs -index 7816a59..f415b72 100644 ---- a/Data/DeriveLiftedInstances/Internal.hs -+++ b/Data/DeriveLiftedInstances/Internal.hs -@@ -104,8 +104,8 @@ deriveInstance' deriv ctx clsName typ = do - case dec of - ClassOpI{} -> do - (argNames, body) <- buildOperation deriv tvn tp (op deriv nm (varExp nm)) -- args <- traverse (\argName -> if contains argName body then (if nameBase argName == "var" then inp deriv else id) . pure . VarP $ argName else pure WildP) argNames -- pure $ Just $ FunD nm [Clause args (NormalB body) []] -+ let args = map (\argName -> if contains argName body then (if nameBase argName == "var" then inp deriv else id) . pure . VarP $ argName else pure WildP) argNames -+ Just <$> funD nm [clause args (pure $ NormalB body) []] - _ -> fail $ "No support for declaration: " ++ show dec - _ -> pure Nothing - pure [InstanceD Nothing ctx typ $ catMaybes impl] diff --git a/patches/deriving-compat-0.6.5.patch b/patches/deriving-compat-0.6.5.patch deleted file mode 100644 index 0f28f1ec5555bba2875d96091210bc957c84fd57..0000000000000000000000000000000000000000 --- a/patches/deriving-compat-0.6.5.patch +++ /dev/null @@ -1,42 +0,0 @@ -diff --git a/deriving-compat.cabal b/deriving-compat.cabal -index f9c2df6..9264391 100644 ---- a/deriving-compat.cabal -+++ b/deriving-compat.cabal -@@ -1,5 +1,6 @@ - name: deriving-compat - version: 0.6.5 -+x-revision: 1 - synopsis: Backports of GHC deriving extensions - description: @deriving-compat@ provides Template Haskell functions that - mimic @deriving@ extensions that were introduced or modified -@@ -139,7 +140,7 @@ library - Text.Read.Deriving.Internal - Text.Show.Deriving - Text.Show.Deriving.Internal -- build-depends: containers >= 0.1 && < 0.7 -+ build-depends: containers >= 0.1 && < 0.8 - , ghc-prim - , th-abstraction >= 0.4 && < 0.7 - -diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs -index d409da1..cd97b8e 100644 ---- a/src/Data/Functor/Deriving/Internal.hs -+++ b/src/Data/Functor/Deriving/Internal.hs -@@ -838,7 +838,7 @@ mkSimpleLam :: (Exp -> Q Exp) -> Q Exp - mkSimpleLam lam = do - n <- newName "n" - body <- lam (VarE n) -- return $ LamE [VarP n] body -+ lamE [varP n] (pure body) - - -- Make a 'LamE' using two fresh variables. - mkSimpleLam2 :: (Exp -> Exp -> Q Exp) -> Q Exp -@@ -846,7 +846,7 @@ mkSimpleLam2 lam = do - n1 <- newName "n1" - n2 <- newName "n2" - body <- lam (VarE n1) (VarE n2) -- return $ LamE [VarP n1, VarP n2] body -+ lamE [varP n1, varP n2] (pure body) - - -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" - -- diff --git a/patches/invariant-0.6.2.patch b/patches/invariant-0.6.2.patch deleted file mode 100644 index b1f1caad27a1eeb98653c9e9f192273572e714fd..0000000000000000000000000000000000000000 --- a/patches/invariant-0.6.2.patch +++ /dev/null @@ -1,33 +0,0 @@ -diff --git a/invariant.cabal b/invariant.cabal -index 66d7bc7..f242724 100644 ---- a/invariant.cabal -+++ b/invariant.cabal -@@ -1,5 +1,6 @@ - name: invariant - version: 0.6.2 -+x-revision: 1 - synopsis: Haskell98 invariant functors - description: Haskell98 invariant functors (also known as exponential functors). - . -@@ -49,7 +50,7 @@ library - , base >= 4 && < 5 - , bifunctors >= 5.2 && < 6 - , comonad >= 5 && < 6 -- , containers >= 0.1 && < 0.7 -+ , containers >= 0.1 && < 0.8 - , contravariant >= 0.5 && < 2 - , ghc-prim - , profunctors >= 5.2.1 && < 6 -diff --git a/src/Data/Functor/Invariant/TH.hs b/src/Data/Functor/Invariant/TH.hs -index babc5d4..813e75e 100644 ---- a/src/Data/Functor/Invariant/TH.hs -+++ b/src/Data/Functor/Invariant/TH.hs -@@ -865,7 +865,7 @@ mkSimpleLam :: (Exp -> Q Exp) -> Q Exp - mkSimpleLam lam = do - n <- newName "n" - body <- lam (VarE n) -- return $ LamE [VarP n] body -+ lamE [varP n] (pure body) - - -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" - -- diff --git a/patches/persistent-2.14.6.1.patch b/patches/persistent-2.14.6.1.patch deleted file mode 100644 index b4a578ce2a0bd36b63ad0eeaa2b32dc28cfbe861..0000000000000000000000000000000000000000 --- a/patches/persistent-2.14.6.1.patch +++ /dev/null @@ -1,50 +0,0 @@ -diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs -index f4b0bde..fd77c41 100644 ---- a/Database/Persist/TH.hs -+++ b/Database/Persist/TH.hs -@@ -122,7 +122,7 @@ import Instances.TH.Lift () - import Data.Foldable (asum, toList) - import qualified Data.Set as Set - import Language.Haskell.TH.Lib -- (appT, conE, conK, conT, litT, strTyLit, varE, varP, varT) -+ (appT, appE, conE, conK, conT, litT, strTyLit, varE, varP, varT, clause, lamE) - #if MIN_VERSION_template_haskell(2,21,0) - import Language.Haskell.TH.Lib (defaultBndrFlag) - #endif -@@ -1915,6 +1915,7 @@ mkKeyToValues mps entDef = do - normalClause :: [Pat] -> Exp -> Clause - normalClause p e = Clause p (NormalB e) [] - -+ - -- needs: - -- - -- * entityPrimary -@@ -2062,14 +2063,14 @@ mkEntity embedEntityMap entityMap mps preDef = do - let keyCon = keyConName entDef - constr = - foldl' -- AppE -- (ConE keyCon) -- (VarE . snd <$> keyFieldNames') -+ appE -+ (conE keyCon) -+ (varE . snd <$> keyFieldNames') - keyFromRec = varP 'keyFromRecordM - fieldPat = [(fieldName, VarP fieldVarName) | (fieldName, fieldVarName) <- toList keyFieldNames'] -- lam = LamE [RecP name fieldPat ] constr -+ lam = lamE [pure $ RecP name fieldPat] constr - [d| -- $(keyFromRec) = Just $(pure lam) -+ $(keyFromRec) = Just $lam - |] - - _ -> -@@ -2122,7 +2123,7 @@ mkEntity embedEntityMap entityMap mps preDef = do - - pure $ - FunD 'tabulateEntityA -- [ Clause [VarP fromFieldName] (NormalB body) [] -+ [ normalClause [VarP fromFieldName] body - ] - - return $ addSyn $ diff --git a/patches/shakespeare-2.1.0.1.patch b/patches/shakespeare-2.1.0.1.patch deleted file mode 100644 index 71583d44f5735c3d83c837e6ab9281dca7b5b966..0000000000000000000000000000000000000000 --- a/patches/shakespeare-2.1.0.1.patch +++ /dev/null @@ -1,151 +0,0 @@ -diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs -index 6a5fc62..eb2e518 100644 ---- a/Text/Hamlet.hs -+++ b/Text/Hamlet.hs -@@ -51,6 +51,7 @@ module Text.Hamlet - import Text.Shakespeare.Base - import Text.Hamlet.Parse - import Language.Haskell.TH.Syntax hiding (Module) -+import Language.Haskell.TH.Lib (lamE, appE, varP) - import Language.Haskell.TH.Quote - import Data.Char (isUpper, isDigit) - import Data.Maybe (fromMaybe) -@@ -200,10 +201,9 @@ docToExp env hr scope (DocForall list idents inside) = do - let list' = derefToExp scope list - (pat, extraScope) <- bindingPattern idents - let scope' = extraScope ++ scope -- mh <- [|F.mapM_|] -- inside' <- docsToExp env hr scope' inside -- let lam = LamE [pat] inside' -- return $ mh `AppE` lam `AppE` list' -+ let inside' = docsToExp env hr scope' inside -+ let lam = lamE [pure pat] inside' -+ [|F.mapM_|] `appE` lam `appE` pure list' - docToExp env hr scope (DocWith [] inside) = do - inside' <- docsToExp env hr scope inside - return $ inside' -@@ -212,22 +212,21 @@ docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do - (pat, extraScope) <- bindingPattern idents - let scope' = extraScope ++ scope - inside' <- docToExp env hr scope' (DocWith dis inside) -- let lam = LamE [pat] inside' -- return $ lam `AppE` deref' -+ let lam = lamE [pure pat] (pure inside') -+ lam `appE` pure deref' - docToExp env hr scope (DocMaybe val idents inside mno) = do - let val' = derefToExp scope val - (pat, extraScope) <- bindingPattern idents - let scope' = extraScope ++ scope -- inside' <- docsToExp env hr scope' inside -- let inside'' = LamE [pat] inside' -- ninside' <- case mno of -+ let inside' = docsToExp env hr scope' inside -+ let inside'' = lamE [pure pat] inside' -+ let ninside' = case mno of - Nothing -> [|Nothing|] - Just no -> do - no' <- docsToExp env hr scope no - j <- [|Just|] - return $ j `AppE` no' -- mh <- [|maybeH|] -- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside' -+ [|maybeH|] `appE` (pure val') `appE` inside'' `appE` ninside' - docToExp env hr scope (DocCond conds final) = do - conds' <- mapM go conds - final' <- case final of -@@ -343,7 +342,7 @@ hamletRules = do - , msgRender = Nothing - } - h <- f env -- return $ LamE [VarP r] h -+ lamE [varP r] (pure h) - return $ HamletRules i ur em - where - em (Env (Just urender) Nothing) e = do -@@ -386,7 +385,7 @@ ihamletRules = do - , msgRender = Just ($ (VarE m)) - } - h <- f env -- return $ LamE [VarP m, VarP u] h -+ lamE [varP m, varP u] (pure h) - return $ HamletRules i ur em - where - em (Env (Just urender) (Just mrender)) e = -diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index a3c33f7..e9c311d 100644 ---- a/Text/Shakespeare.hs -+++ b/Text/Shakespeare.hs -@@ -40,7 +40,7 @@ import Data.Char (isAlphaNum, isSpace) - import Text.ParserCombinators.Parsec hiding (Line, parse, Parser) - import Text.Parsec.Prim (modifyState, Parsec) - import Language.Haskell.TH.Quote (QuasiQuoter (..)) --import Language.Haskell.TH (appE) -+import Language.Haskell.TH (appE, lamE, varP) - import Language.Haskell.TH.Lift () -- Import orphan Lift Name instance - import Language.Haskell.TH.Syntax - import Data.Text.Lazy.Builder (Builder, fromText) -@@ -329,10 +329,10 @@ contentsToShakespeare rs a = do - _ -> do - mc <- [|mconcat|] - return $ mc `AppE` ListE c -- fmap (maybe id AppE $ modifyFinalValue rs) $ return $ -+ fmap (maybe id AppE $ modifyFinalValue rs) $ - if justVarInterpolation rs -- then compiledTemplate -- else LamE [VarP r] compiledTemplate -+ then return compiledTemplate -+ else lamE [varP r] (pure compiledTemplate) - where - contentToBuilder :: Name -> Content -> Q Exp - contentToBuilder _ (ContentRaw s') = do -diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs -index 1081ead..0971e55 100644 ---- a/Text/Shakespeare/I18N.hs -+++ b/Text/Shakespeare/I18N.hs -@@ -62,6 +62,7 @@ module Text.Shakespeare.I18N - ) where - - import Language.Haskell.TH.Syntax hiding (makeRelativeToProject) -+import Language.Haskell.TH.Lib (clause, varP, wildP) - import Control.Applicative ((<$>)) - import Control.Monad (filterM, forM) - import Data.Text (Text, pack, unpack) -@@ -188,9 +189,9 @@ toClauses prefix dt (lang, defs) = - a <- newName "lang" - (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def) - guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] -- return $ Clause -- [WildP, conP (mkName ":") [VarP a, WildP], pat] -- (GuardedB [(guard, bod)]) -+ clause -+ [wildP, pure $ conP (mkName ":") [VarP a, WildP], pure pat] -+ (pure $ GuardedB [(guard, bod)]) - [] - - mkBody :: String -- ^ datatype -@@ -232,9 +233,9 @@ mkBody dt cs vs ct = do - sToClause :: String -> String -> SDef -> Q Clause - sToClause prefix dt sdef = do - (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) -- return $ Clause -- [WildP, conP (mkName "[]") [], pat] -- (NormalB bod) -+ clause -+ [wildP, pure $ conP (mkName "[]") [], pure pat] -+ (pure $ NormalB bod) - [] - - defClause :: Q Clause -@@ -243,9 +244,9 @@ defClause = do - c <- newName "langs" - d <- newName "msg" - rm <- [|renderMessage|] -- return $ Clause -- [VarP a, conP (mkName ":") [WildP, VarP c], VarP d] -- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) -+ clause -+ [varP a, pure $ conP (mkName ":") [WildP, VarP c], varP d] -+ (pure $ NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) - [] - - conP :: Name -> [Pat] -> Pat diff --git a/patches/singletons-3.0.2.patch b/patches/singletons-3.0.2.patch index cc7c72328ba3f6a54382f5ab4eb9a3db30ac2c03..6378c54ef24e0b6a1e4bbdf9fdeb006aa1741041 100644 --- a/patches/singletons-3.0.2.patch +++ b/patches/singletons-3.0.2.patch @@ -1,5 +1,5 @@ diff --git a/src/Data/Singletons.hs b/src/Data/Singletons.hs -index 67e0a63..b18638f 100644 +index 67e0a63..e260621 100644 --- a/src/Data/Singletons.hs +++ b/src/Data/Singletons.hs @@ -27,6 +27,15 @@ @@ -35,7 +35,7 @@ index 67e0a63..b18638f 100644 type ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun) #endif +#if __GLASGOW_HASKELL__ >= 909 -+type family ApplyTyCon @k1 @k2 @k3 :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where ++type family ApplyTyCon @k1 @k2 @unmatchable_fun :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where +#else type family ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where +#endif diff --git a/patches/yesod-core-1.6.25.1.patch b/patches/yesod-core-1.6.25.1.patch deleted file mode 100644 index 71ab7356ac23edbe47c125e563220c2694f96e32..0000000000000000000000000000000000000000 --- a/patches/yesod-core-1.6.25.1.patch +++ /dev/null @@ -1,198 +0,0 @@ -diff --git a/src/Yesod/Core/Widget.hs b/src/Yesod/Core/Widget.hs -index f20a998..1882872 100644 ---- a/src/Yesod/Core/Widget.hs -+++ b/src/Yesod/Core/Widget.hs -@@ -69,6 +69,7 @@ import Data.Text (Text) - import Data.Kind (Type) - import qualified Data.Map as Map - import Language.Haskell.TH.Quote (QuasiQuoter) -+import Language.Haskell.TH (lamE, varP) - import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP), newName) - - import qualified Text.Hamlet as NP -@@ -358,8 +359,8 @@ rules = do - ah <- [|asWidgetT . toWidget|] - let helper qg f = do - x <- newName "urender" -- e <- f $ VarE x -- let e' = LamE [VarP x] e -+ let e = f $ VarE x -+ e' <- lamE [varP x] e - g <- qg - bind <- [|(>>=)|] - return $ InfixE (Just g) bind (Just e') -diff --git a/src/Yesod/Routes/TH/Dispatch.hs b/src/Yesod/Routes/TH/Dispatch.hs -index 1d12c9d..9c23dae 100644 ---- a/src/Yesod/Routes/TH/Dispatch.hs -+++ b/src/Yesod/Routes/TH/Dispatch.hs -@@ -8,6 +8,7 @@ module Yesod.Routes.TH.Dispatch - - import Prelude hiding (exp) - import Language.Haskell.TH.Syntax -+import Language.Haskell.TH.Lib (clause, wildP, varP, lamE, appE) - import Web.PathPieces - import Data.Maybe (catMaybes) - import Control.Monad (forM) -@@ -65,10 +66,10 @@ mkDispatchClause MkDispatchSettings {..} resources = do - } - clauses <- mapM (go sdc) resources - -- return $ Clause -- [VarP envName, VarP reqName] -- (NormalB $ helperE `AppE` pathInfo) -- [FunD helperName $ clauses ++ [clause404']] -+ clause -+ [varP envName, varP reqName] -+ (pure $ NormalB $ helperE `AppE` pathInfo) -+ [pure $ FunD helperName $ clauses ++ [clause404']] - where - handlePiece :: Piece a -> Q (Pat, Maybe Exp) - handlePiece (Static str) = return (LitP $ StringL str, Nothing) -@@ -105,18 +106,18 @@ mkDispatchClause MkDispatchSettings {..} resources = do - helperName <- newName $ "helper" ++ name - let helperE = VarE helperName - -- return $ Clause -- [mkPathPat restP pats] -- (NormalB $ helperE `AppE` restE) -- [FunD helperName $ childClauses ++ [clause404 sdc]] -+ clause -+ [pure $ mkPathPat restP pats] -+ (pure $ NormalB $ helperE `AppE` restE) -+ [pure $ FunD helperName $ childClauses ++ [clause404 sdc]] - go SDC {..} (ResourceLeaf (Resource name pieces dispatch _ _check)) = do - (pats, dyns) <- handlePieces pieces - - (chooseMethod, finalPat) <- handleDispatch dispatch dyns - -- return $ Clause -- [mkPathPat finalPat pats] -- (NormalB chooseMethod) -+ clause -+ [pure $ mkPathPat finalPat pats] -+ (pure $ NormalB chooseMethod) - [] - where - handleDispatch :: Dispatch a -> [Exp] -> Q (Exp, Pat) -@@ -174,29 +175,29 @@ mkDispatchClause MkDispatchSettings {..} resources = do - Subsite _ getSub -> do - restPath <- newName "restPath" - setPathInfoE <- mdsSetPathInfo -- subDispatcherE <- mdsSubDispatcher -- runHandlerE <- mdsRunHandler -+ let subDispatcherE = mdsSubDispatcher -+ let runHandlerE = mdsRunHandler - sub <- newName "sub" - let allDyns = extraParams ++ dyns - sroute <- newName "sroute" -- let sub2 = LamE [VarP sub] -- (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) allDyns) -+ let sub2 = lamE [varP sub] -+ $ pure (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) allDyns) - let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp - route' = foldl' AppE (ConE (mkName name)) dyns -- route = LamE [VarP sroute] $ foldr AppE (AppE route' $ VarE sroute) extraCons -+ route = lamE [varP sroute] $ pure $ foldr AppE (AppE route' $ VarE sroute) extraCons - exp = subDispatcherE -- `AppE` runHandlerE -- `AppE` sub2 -- `AppE` route -- `AppE` envExp -- `AppE` reqExp' -- return (exp, VarP restPath) -+ `appE` runHandlerE -+ `appE` sub2 -+ `appE` route -+ `appE` pure envExp -+ `appE` pure reqExp' -+ (,) <$> exp <*> varP restPath - - mkClause404 envE reqE = do - handler <- mds404 - runHandler <- mdsRunHandler - let exp = runHandler `AppE` handler `AppE` envE `AppE` ConE 'Nothing `AppE` reqE -- return $ Clause [WildP] (NormalB exp) [] -+ clause [wildP] (pure $ NormalB exp) [] - - defaultGetHandler :: Maybe String -> String -> Q Exp - defaultGetHandler Nothing s = return $ VarE $ mkName $ "handle" ++ s -diff --git a/src/Yesod/Routes/TH/RenderRoute.hs b/src/Yesod/Routes/TH/RenderRoute.hs -index 9f7fb7d..88b0fe0 100644 ---- a/src/Yesod/Routes/TH/RenderRoute.hs -+++ b/src/Yesod/Routes/TH/RenderRoute.hs -@@ -18,7 +18,7 @@ module Yesod.Routes.TH.RenderRoute - ) where - - import Yesod.Routes.TH.Types --import Language.Haskell.TH (conT) -+import Language.Haskell.TH (conT, clause, tupP, varP, lamE, appE) - import Language.Haskell.TH.Syntax - import Data.Bits (xor) - import Data.Maybe (maybeToList) -@@ -147,14 +147,14 @@ mkRenderRouteClauses = - let cons y ys = InfixE (Just y) colon (Just ys) - let pieces' = foldr cons (VarE a) piecesSingle - -- let body = LamE [TupP [VarP a, VarP b]] (TupE -+ body <- lamE [tupP [varP a, varP b]] (pure $ TupE - #if MIN_VERSION_template_haskell(2,16,0) - $ map Just - #endif - [pieces', VarE b] -- ) `AppE` (rr `AppE` VarE child) -+ ) `appE` (pure $ rr `AppE` VarE child) - -- return $ Clause [pat] (NormalB body) [FunD childRender childClauses] -+ clause [pure pat] (pure $ NormalB body) [pure $ FunD childRender childClauses] - - go (ResourceLeaf res) = do - let cnt = length (filter isDynamic $ resourcePieces res) + maybe 0 (const 1) (resourceMulti res) -@@ -187,12 +187,12 @@ mkRenderRouteClauses = - let cons y ys = InfixE (Just y) colon (Just ys) - let pieces = foldr cons (VarE a) piecesSingle - -- return $ LamE [TupP [VarP a, VarP b]] (TupE -+ lamE [tupP [varP a, varP b]] (pure $ TupE - #if MIN_VERSION_template_haskell(2,16,0) - $ map Just - #endif - [pieces, VarE b] -- ) `AppE` (rr `AppE` VarE x) -+ ) `appE` (pure $ rr `AppE` VarE x) - _ -> do - colon <- [|(:)|] - let cons a b = InfixE (Just a) colon (Just b) -@@ -202,7 +202,7 @@ mkRenderRouteClauses = - #endif - [foldr cons piecesMulti piecesSingle, ListE []] - -- return $ Clause [pat] (NormalB body) [] -+ clause [pure pat] (pure $ NormalB body) [] - - mkPieces _ _ [] _ = [] - mkPieces toText tsp (Static s:ps) dyns = toText s : mkPieces toText tsp ps dyns -diff --git a/src/Yesod/Routes/TH/RouteAttrs.hs b/src/Yesod/Routes/TH/RouteAttrs.hs -index 72b24b4..4d35dee 100644 ---- a/src/Yesod/Routes/TH/RouteAttrs.hs -+++ b/src/Yesod/Routes/TH/RouteAttrs.hs -@@ -8,6 +8,7 @@ module Yesod.Routes.TH.RouteAttrs - import Yesod.Routes.TH.Types - import Yesod.Routes.Class - import Language.Haskell.TH.Syntax -+import Language.Haskell.TH (clause) - import Data.Set (fromList) - import Data.Text (pack) - -@@ -35,9 +36,9 @@ goTree front (ResourceParent name _check pieces trees) = - - goRes :: (Pat -> Pat) -> Resource a -> Q Clause - goRes front Resource {..} = -- return $ Clause -- [front $ RecP (mkName resourceName) []] -- (NormalB $ VarE 'fromList `AppE` ListE (map toText resourceAttrs)) -+ clause -+ [pure $ front $ RecP (mkName resourceName) []] -+ (pure $ NormalB $ VarE 'fromList `AppE` ListE (map toText resourceAttrs)) - [] - where - toText s = VarE 'pack `AppE` LitE (StringL s)