Commit 1530228b authored by Ryan Scott's avatar Ryan Scott

GHC 8.9-related patches for barbies, inspection-testing, shakespeare, yesod-core

* `barbies` must adapt to GHC proposal 103
  (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0103-no-kind-vars.rst),
  which has been implemented in 8.9.
* `inspection-testing` must adapt to changes in the GHC API.
* `shakespeare` and `yesod-core` must adapt to the type of `TupE`
  changing in `template-haskell-2.16.0.0`.
parent 673821b9
Pipeline #9700 passed with stages
in 52 minutes and 2 seconds
commit 69d6cb742b2210f231620b90ee729a195a0f55ad
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Aug 28 07:08:30 2019 -0400
Allow building with GHC 8.8
diff --git a/src/Data/Barbie/Internal/Constraints.hs b/src/Data/Barbie/Internal/Constraints.hs
index d1da2f2..7087ed2 100644
--- a/src/Data/Barbie/Internal/Constraints.hs
+++ b/src/Data/Barbie/Internal/Constraints.hs
@@ -179,7 +179,7 @@ gbaddDictsDefault
class GAllBC (repbf :: * -> *) where
type GAllB (c :: k -> Constraint) repbf :: Constraint
-class GAllBC repbx => GConstraintsB c (f :: k -> *) repbx repbf repbdf where
+class GAllBC repbx => GConstraintsB c f repbx repbf repbdf where
gbaddDicts :: GAllB c repbx => repbf x -> repbdf x
diff --git a/src/Data/Barbie/Internal/Product.hs b/src/Data/Barbie/Internal/Product.hs
index 31abc4b..6fef250 100644
--- a/src/Data/Barbie/Internal/Product.hs
+++ b/src/Data/Barbie/Internal/Product.hs
@@ -168,7 +168,7 @@ gbuniqDefault x
= toN (gbuniq @f @f @_ @(RepN (b f)) @(RepN (b (f `Product` f))) x)
{-# INLINE gbuniqDefault #-}
-class GProductB (f :: k -> *) (g :: k -> *) repbf repbg repbfg where
+class GProductB f g repbf repbg repbfg where
gbprod :: repbf x -> repbg x -> repbfg x
gbuniq :: (forall a . f a) -> repbf x
commit 241ff789d849a55cd23ea6825cf887aa8dbdbaac
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Aug 28 06:50:40 2019 -0400
Allow building with GHC 8.9
diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs
index f34f301..d310ce1 100644
--- a/src/Test/Inspection/Core.hs
+++ b/src/Test/Inspection/Core.hs
@@ -231,7 +231,11 @@ allTyCons predicate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
-- ↑ This is the crucial bit
goT (ForAllTy _ t) = goT t
#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
- goT (FunTy t1 t2) = goT t1 && goT t2
+ goT (FunTy
+# if MIN_VERSION_GLASGOW_HASKELL(8,9,0,0)
+ _
+# endif
+ t1 t2) = goT t1 && goT t2
#endif
goT (LitTy _) = True
goT (CastTy t _) = goT t
diff --git a/src/Test/Inspection/Plugin.hs b/src/Test/Inspection/Plugin.hs
index 49ecf98..8574ce8 100644
--- a/src/Test/Inspection/Plugin.hs
+++ b/src/Test/Inspection/Plugin.hs
@@ -292,7 +292,11 @@ proofPass upon_failure report guts = do
dflags <- getDynFlags
let noopt = optLevel dflags < 1
when noopt $
- warnMsg $ fsep $ map text $ words "Test.Inspection: Compilation without -O detected. Expect optimizations to fail."
+ warnMsg
+#if MIN_VERSION_GLASGOW_HASKELL(8,9,0,0)
+ NoReason
+#endif
+ $ fsep $ map text $ words "Test.Inspection: Compilation without -O detected. Expect optimizations to fail."
let (guts', obligations) = extractObligations guts
(toStore, stats) <- (concat `bimap` M.unionsWith (+)) . unzip <$>
commit a265023518932249e2324bf4ba9947a71e7b44f9
commit 75a8f2dc33924128ec68674a80be679c705c052e
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sat Mar 16 07:50:28 2019 -0400
Date: Wed Aug 28 07:00:25 2019 -0400
Adapt to base-4.13.0.0
Adapt to base-4.13.* / template-haskell-2.16.*
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
index c8e4e78..8d56a3f 100644
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -231,7 +232,11 @@ docToExp env hr scope (DocCond conds final) = do
go (d, docs) = do
let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d
docs' <- docsToExp env hr scope docs
- return $ TupE [d', docs']
+ return $ TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [d', docs']
docToExp env hr scope (DocCase deref cases) = do
let exp_ = derefToExp scope deref
matches <- mapM toMatch cases
@@ -538,7 +543,11 @@ hamletFileReloadWithSettings hrr settings fp = do
vtToExp (d, vt) = do
d' <- lift d
c' <- toExp vt
- return $ TupE [d', c' `AppE` derefToExp [] d]
+ return $ TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [d', c' `AppE` derefToExp [] d]
where
toExp = c
where
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
index 2f0642b..6eb8e49 100644
--- a/Text/Hamlet/Parse.hs
......@@ -33,10 +68,31 @@ index 2f0642b..6eb8e49 100644
instance Functor Result where
fmap = liftM
diff --git a/Text/Internal/Css.hs b/Text/Internal/Css.hs
index 05e915c..1bedbac 100644
index 05e915c..96a6113 100644
--- a/Text/Internal/Css.hs
+++ b/Text/Internal/Css.hs
@@ -298,15 +298,15 @@ getVars scope (ContentVar d) =
@@ -1,6 +1,7 @@
{-# OPTIONS_HADDOCK hide #-}
-- | This module is only being exposed to work around a GHC bug, its API is not stable
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -281,7 +282,11 @@ vtToExp :: (Deref, VarType) -> Q Exp
vtToExp (d, vt) = do
d' <- lift d
c' <- c vt
- return $ TupE [d', c' `AppE` derefToExp [] d]
+ return $ TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [d', c' `AppE` derefToExp [] d]
where
c :: VarType -> Q Exp
c VTPlain = [|CDPlain . toCss|]
@@ -298,15 +303,15 @@ getVars scope (ContentVar d) =
getVars scope (ContentUrl d) =
case lookupD d scope of
Nothing -> return [(d, VTUrl)]
......@@ -55,3 +111,37 @@ index 05e915c..1bedbac 100644
lookupD :: Deref -> [(String, b)] -> Maybe String
lookupD (DerefIdent (Ident s)) scope =
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
index 68baf51..55f19ab 100644
--- a/Text/Shakespeare.hs
+++ b/Text/Shakespeare.hs
@@ -426,7 +426,11 @@ shakespeareFileReload settings fp = do
vtToExp (d, vt) = do
d' <- lift d
c' <- c vt
- return $ TupE [d', c' `AppE` derefToExp [] d]
+ return $ TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [d', c' `AppE` derefToExp [] d]
where
c :: VarType -> Q Exp
c VTPlain = [|EPlain . $(return $
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
index 3379ed3..b106632 100644
--- a/Text/Shakespeare/Base.hs
+++ b/Text/Shakespeare/Base.hs
@@ -198,7 +198,11 @@ derefToExp _ (DerefIntegral i) = LitE $ IntegerL i
derefToExp _ (DerefRational r) = LitE $ RationalL r
derefToExp _ (DerefString s) = LitE $ StringL s
derefToExp s (DerefList ds) = ListE $ map (derefToExp s) ds
-derefToExp s (DerefTuple ds) = TupE $ map (derefToExp s) ds
+derefToExp s (DerefTuple ds) = TupE
+#if MIN_VERSION_template_haskell(2,16,0)
+ $ map Just
+#endif
+ $ map (derefToExp s) ds
-- FIXME shouldn't we use something besides a list here?
flattenDeref :: Deref -> Maybe [String]
diff -ru yesod-core-1.6.15.orig/src/Yesod/Routes/TH/RenderRoute.hs yesod-core-1.6.15/src/Yesod/Routes/TH/RenderRoute.hs
--- yesod-core-1.6.15.orig/src/Yesod/Routes/TH/RenderRoute.hs 2019-07-18 07:55:12.000000000 -0400
+++ yesod-core-1.6.15/src/Yesod/Routes/TH/RenderRoute.hs 2019-08-27 18:58:11.864247519 -0400
@@ -142,7 +142,11 @@
+++ yesod-core-1.6.15/src/Yesod/Routes/TH/RenderRoute.hs 2019-08-28 07:23:41.653975261 -0400
@@ -84,7 +84,13 @@
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 [pieces', VarE b]) `AppE` (rr `AppE` VarE child)
+ let body = LamE [TupP [VarP a, VarP b]]
+ (TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [pieces', VarE b])
+ `AppE` (rr `AppE` VarE child)
return $ Clause [pat] (NormalB body) [FunD childRender childClauses]
@@ -119,11 +125,21 @@
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 [pieces, VarE b]) `AppE` (rr `AppE` VarE x)
+ return $ LamE [TupP [VarP a, VarP b]]
+ (TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [pieces, VarE b])
+ `AppE` (rr `AppE` VarE x)
_ -> do
colon <- [|(:)|]
let cons a b = InfixE (Just a) colon (Just b)
- return $ TupE [foldr cons piecesMulti piecesSingle, ListE []]
+ return $ TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [foldr cons piecesMulti piecesSingle, ListE []]
return $ Clause [pat] (NormalB body) []
@@ -142,7 +158,11 @@
cls <- mkRenderRouteClauses ress
(cons, decs) <- mkRouteCons ress
#if MIN_VERSION_template_haskell(2,12,0)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment