Skip to content
Snippets Groups Projects
Commit 7652bc53 authored by Ryan Scott's avatar Ryan Scott
Browse files

Migrate some patches to latest Hackage versions

parent cff0eb9c
No related branches found
No related tags found
No related merge requests found
diff --git a/QuickCheck.cabal b/QuickCheck.cabal diff --git a/src/Test/QuickCheck/All.hs b/src/Test/QuickCheck/All.hs
index 0958f44..d9e5bdc 100644 index 8230495..1d9cab6 100644
--- a/QuickCheck.cabal --- a/src/Test/QuickCheck/All.hs
+++ b/QuickCheck.cabal +++ b/src/Test/QuickCheck/All.hs
@@ -120,7 +120,7 @@ library
-- Use splitmix on newer GHCs.
if impl(ghc >= 7.0)
- Build-depends: splitmix >= 0.0.4
+ Build-depends: splitmix >= 0.0.4 && < 0.1
else
cpp-options: -DNO_SPLITMIX
diff --git a/Test/QuickCheck/All.hs b/Test/QuickCheck/All.hs
index 8230495..33d1db5 100644
--- a/Test/QuickCheck/All.hs
+++ b/Test/QuickCheck/All.hs
@@ -99,17 +99,33 @@ infoType (VarI _ ty _ _) = ty @@ -99,17 +99,33 @@ infoType (VarI _ ty _ _) = ty
deconstructType :: Error -> Type -> Q ([Name], Cxt, Type) deconstructType :: Error -> Type -> Q ([Name], Cxt, Type)
...@@ -38,7 +25,7 @@ index 8230495..33d1db5 100644 ...@@ -38,7 +25,7 @@ index 8230495..33d1db5 100644
+elimTV :: (Name -> r) -> (Name -> Kind -> r) +elimTV :: (Name -> r) -> (Name -> Kind -> r)
+#if MIN_VERSION_template_haskell(2,17,0) +#if MIN_VERSION_template_haskell(2,17,0)
+ -> TyVarBndr spec + -> TyVarBndr flag
+#else +#else
+ -> TyVarBndr + -> TyVarBndr
+#endif +#endif
......
...@@ -25,10 +25,10 @@ index 355700a..7c8c5a2 100644 ...@@ -25,10 +25,10 @@ index 355700a..7c8c5a2 100644
instance Each (Quaternion a) (Quaternion b) a b where instance Each (Quaternion a) (Quaternion b) a b where
diff --git a/src/Linear/V0.hs b/src/Linear/V0.hs diff --git a/src/Linear/V0.hs b/src/Linear/V0.hs
index 1c77791..10100e2 100644 index d8bdf89..fb4f855 100644
--- a/src/Linear/V0.hs --- a/src/Linear/V0.hs
+++ b/src/Linear/V0.hs +++ b/src/Linear/V0.hs
@@ -326,7 +326,7 @@ type instance Index (V0 a) = E V0 @@ -324,7 +324,7 @@ type instance Index (V0 a) = E V0
type instance IxValue (V0 a) = a type instance IxValue (V0 a) = a
instance Ixed (V0 a) where instance Ixed (V0 a) where
...@@ -38,7 +38,7 @@ index 1c77791..10100e2 100644 ...@@ -38,7 +38,7 @@ index 1c77791..10100e2 100644
instance Each (V0 a) (V0 b) a b where instance Each (V0 a) (V0 b) a b where
diff --git a/src/Linear/V1.hs b/src/Linear/V1.hs diff --git a/src/Linear/V1.hs b/src/Linear/V1.hs
index 4d332f7..18e2985 100644 index 73cd2bf..9cf3124 100644
--- a/src/Linear/V1.hs --- a/src/Linear/V1.hs
+++ b/src/Linear/V1.hs +++ b/src/Linear/V1.hs
@@ -329,7 +329,7 @@ type instance Index (V1 a) = E V1 @@ -329,7 +329,7 @@ type instance Index (V1 a) = E V1
......
diff --git a/src/Control/Scheduler.hs b/src/Control/Scheduler.hs diff --git a/src/Control/Scheduler.hs b/src/Control/Scheduler.hs
index 092d222..bf03492 100644 index 0782d73..5942489 100644
--- a/src/Control/Scheduler.hs --- a/src/Control/Scheduler.hs
+++ b/src/Control/Scheduler.hs +++ b/src/Control/Scheduler.hs
@@ -563,9 +563,9 @@ withSchedulerInternal comp submitWork collect adjust onScheduler = do @@ -541,9 +541,9 @@ withSchedulerInternal comp submitWork collect adjust onScheduler = do
case comp of case comp of
Seq -> return [] Seq -> return []
-- \ no need to fork threads for a sequential computation -- \ no need to fork threads for a sequential computation
......
diff --git a/Text/Internal/Css.hs b/Text/Internal/Css.hs diff --git a/Text/Internal/Css.hs b/Text/Internal/Css.hs
index 66ed0b6..5b67d6e 100644 index c932d84..66acb9e 100644
--- a/Text/Internal/Css.hs --- a/Text/Internal/Css.hs
+++ b/Text/Internal/Css.hs +++ b/Text/Internal/Css.hs
@@ -267,7 +267,7 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do @@ -270,7 +270,7 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do
where where
cs = either error mconcat $ mapM (contentToBuilderRT cd render') cs' cs = either error mconcat $ mapM (contentToBuilderRT cd render') cs'
goTop scope (TopBlock b:rest) = goTop scope (TopBlock b:rest) =
...@@ -11,9 +11,9 @@ index 66ed0b6..5b67d6e 100644 ...@@ -11,9 +11,9 @@ index 66ed0b6..5b67d6e 100644
goTop scope rest goTop scope rest
goTop scope (TopAtBlock name s' b:rest) = goTop scope (TopAtBlock name s' b:rest) =
TopAtBlock name s (foldr (either error id . blockRuntime (addScope scope) render') [] b) : TopAtBlock name s (foldr (either error id . blockRuntime (addScope scope) render') [] b) :
@@ -517,7 +517,11 @@ instance Lift (Attr Unresolved) where @@ -520,7 +520,11 @@ instance Lift (Attr Resolved) where
instance Lift (Attr Resolved) where liftTyped = unsafeTExpCoerce . lift
lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |] #endif
+#if MIN_VERSION_template_haskell(2,17,0) +#if MIN_VERSION_template_haskell(2,17,0)
+liftBuilder :: Quote m => Builder -> m Exp +liftBuilder :: Quote m => Builder -> m Exp
...@@ -22,7 +22,7 @@ index 66ed0b6..5b67d6e 100644 ...@@ -22,7 +22,7 @@ index 66ed0b6..5b67d6e 100644
+#endif +#endif
liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|] liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]
instance Lift Content where deriving instance Lift (Block Unresolved)
diff --git a/Text/Lucius.hs b/Text/Lucius.hs diff --git a/Text/Lucius.hs b/Text/Lucius.hs
index f814263..83d4e6a 100644 index f814263..83d4e6a 100644
--- a/Text/Lucius.hs --- a/Text/Lucius.hs
......
File moved
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment