Commit c0d50865 authored by Ryan Scott's avatar Ryan Scott Committed by Herbert Valerio Riedel

Add/migrate some GHC 8.8-related patches

* Add patches for `OpenGL`, `streaming`, and `data-dword`. This PR
  subsumes #101, an earlier attempt at providing a `data-dword`
  patch.
* Migrate the `shake` patch to its most recent Hackage version,
  0.17.9.
parent 8a085d53
commit 43567905fcdebcaf781a194ad0a006a8053dec82
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Thu May 2 10:59:53 2019 -0400
Adapt to base-4.13.0.0
diff --git a/src/Graphics/Rendering/OpenGL/GL/IOState.hs b/src/Graphics/Rendering/OpenGL/GL/IOState.hs
index c81c4c0..3ec5cee 100644
--- a/src/Graphics/Rendering/OpenGL/GL/IOState.hs
+++ b/src/Graphics/Rendering/OpenGL/GL/IOState.hs
@@ -40,7 +40,9 @@ instance Functor (IOState s) where
instance Monad (IOState s) where
return a = IOState $ \s -> return (a, s)
m >>= k = IOState $ \s -> do (a, s') <- runIOState m s ; runIOState (k a) s'
+#if !(MIN_VERSION_base(4,13,0))
fail str = IOState $ \_ -> fail str
+#endif
getIOState :: IOState s (Ptr s)
getIOState = IOState $ \s -> return (s, s)
diff -ru data-dword-0.3.1.2.orig/src/Data/DoubleWord/TH.hs data-dword-0.3.1.2/src/Data/DoubleWord/TH.hs
--- data-dword-0.3.1.2.orig/src/Data/DoubleWord/TH.hs 2018-01-13 13:49:48.000000000 -0500
+++ data-dword-0.3.1.2/src/Data/DoubleWord/TH.hs 2019-05-02 16:32:16.395011833 -0400
@@ -25,6 +25,9 @@
import Language.Haskell.TH hiding (unpacked, match)
import Data.BinaryWord (BinaryWord(..))
import Data.DoubleWord.Base
+#if MIN_VERSION_template_haskell(2,15,0)
+import Data.List (foldl')
+#endif
-- | Declare signed and unsigned binary word types built from
-- the specified low and high halves. The high halves /must/ have
@@ -1378,8 +1381,12 @@
hi' = mkName "hi'"
lo' = mkName "lo'"
tpT = ConT tp
+
+ tySynInst :: Name -> [Type] -> Type -> Dec
tySynInst n ps t =
-#if MIN_VERSION_template_haskell(2,9,0)
+#if MIN_VERSION_template_haskell(2,15,0)
+ TySynInstD (TySynEqn Nothing (foldl' AppT (ConT n) ps) t)
+#elif MIN_VERSION_template_haskell(2,9,0)
TySynInstD n (TySynEqn ps t)
#else
TySynInstD n ps t
@@ -1448,11 +1455,19 @@
#endif
singE e = appC '(:) [e, ConE '[]]
mkRules = do
- let idRule = RuleP ("fromIntegral/" ++ show tp ++ "->" ++ show tp) []
+ let idRule = RuleP ("fromIntegral/" ++ show tp ++ "->" ++ show tp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
+ []
(VarE 'fromIntegral)
(SigE (VarE 'id) (AppT (AppT ArrowT tpT) tpT))
AllPhases
- signRule = RuleP ("fromIntegral/" ++ show tp ++ "->" ++ show otp) []
+ signRule = RuleP ("fromIntegral/" ++ show tp ++ "->" ++ show otp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
+ []
(VarE 'fromIntegral)
(SigE (VarE (if signed then 'unsignedWord
else 'signedWord))
@@ -1464,11 +1479,17 @@
(VarE 'signExtendLo)
mkRules' rules t narrowE extE signExtE = do
let narrowRule = RuleP ("fromIntegral/" ++ show tp ++ "->" ++ showT t)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE narrowE (AppT (AppT ArrowT tpT) t))
AllPhases
extRule = RuleP ("fromIntegral/" ++ showT t ++ "->" ++ show tp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE extE (AppT (AppT ArrowT t) tpT))
@@ -1476,18 +1497,26 @@
signedRules ← do
insts ← reifyInstances ''SignedWord [t]
case insts of
-#if MIN_VERSION_template_haskell(2,9,0)
+#if MIN_VERSION_template_haskell(2,15,0)
+ [TySynInstD (TySynEqn _ _ signT)] -> return $
+#elif MIN_VERSION_template_haskell(2,9,0)
[TySynInstD _ (TySynEqn _ signT)] → return $
#else
[TySynInstD _ _ signT] → return $
#endif
[ RuleP ("fromIntegral/" ++ show tp ++ "->" ++ showT signT)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE (AppE (appVN '(.) ['signedWord]) narrowE)
(AppT (AppT ArrowT tpT) signT))
AllPhases
, RuleP ("fromIntegral/" ++ showT signT ++ "->" ++ show tp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE signExtE (AppT (AppT ArrowT signT) tpT))
@@ -1501,6 +1530,9 @@
sSmallT = ConT sSmallName in
[ RuleP ("fromIntegral/" ++
show tp ++ "->" ++ show uSmallName)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE (appV '(.) [VarE 'fromIntegral, narrowE])
@@ -1508,6 +1540,9 @@
AllPhases
, RuleP ("fromIntegral/" ++
show uSmallName ++ "->" ++ show tp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE (appV '(.) [extE, VarE 'fromIntegral])
@@ -1515,6 +1550,9 @@
AllPhases
, RuleP ("fromIntegral/" ++
show tp ++ "->" ++ show sSmallName)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE (appV '(.) [VarE 'fromIntegral, narrowE])
@@ -1522,6 +1560,9 @@
AllPhases
, RuleP ("fromIntegral/" ++
show sSmallName ++ "->" ++ show tp)
+#if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+#endif
[]
(VarE 'fromIntegral)
(SigE (appV '(.) [signExtE, VarE 'fromIntegral])
@@ -1532,7 +1573,9 @@
_ → do
insts ← reifyInstances ''LoWord [t]
case insts of
-#if MIN_VERSION_template_haskell(2,9,0)
+#if MIN_VERSION_template_haskell(2,15,0)
+ [TySynInstD (TySynEqn _ _ t')] ->
+#elif MIN_VERSION_template_haskell(2,9,0)
[TySynInstD _ (TySynEqn _ t')] →
#else
[TySynInstD _ _ t'] →
diff -ru streaming-0.2.2.0.orig/src/Streaming/Internal.hs streaming-0.2.2.0/src/Streaming/Internal.hs
--- streaming-0.2.2.0.orig/src/Streaming/Internal.hs 1969-12-31 19:00:00.000000000 -0500
+++ streaming-0.2.2.0/src/Streaming/Internal.hs 2019-05-02 15:48:52.108061100 -0400
@@ -91,6 +91,7 @@
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Error.Class
+import qualified Control.Monad.Fail as Fail
import Control.Applicative
import Data.Function ( on )
import Control.Monad.Morph
@@ -244,9 +245,14 @@
Return r -> f r
{-# INLINABLE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
fail = lift . fail
{-#INLINE fail #-}
+#endif
+instance (Functor f, MonadFail m) => MonadFail (Stream f m) where
+ fail = lift . Fail.fail
+ {-# INLINE fail #-}
-- _bind
-- :: (Functor f, Monad m)
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