diff --git a/patches/constraints-0.13.patch b/patches/constraints-0.13.patch
index e921b47d86fb5d4e9d78e198d890fa0f93b28375..54e5e9a38c2bf32d092dc67396a2374db7d9e4ef 100644
--- a/patches/constraints-0.13.patch
+++ b/patches/constraints-0.13.patch
@@ -1,10 +1,15 @@
 diff --git a/src/Data/Constraint/Nat.hs b/src/Data/Constraint/Nat.hs
-index ac1a78f..a49320b 100644
+index ac1a78f..1dcece0 100644
 --- a/src/Data/Constraint/Nat.hs
 +++ b/src/Data/Constraint/Nat.hs
-@@ -77,10 +77,10 @@ magic f = Sub $ unsafeCoerce (Magic Dict) (natVal (Proxy :: Proxy n) `f` natVal
- axiom :: forall a b. Dict (a ~ b)
- axiom = unsafeCoerce (Dict :: Dict (a ~ a))
+@@ -74,13 +74,13 @@ newtype Magic n = Magic (KnownNat n => Dict (KnownNat n))
+ magic :: forall n m o. (Integer -> Integer -> Integer) -> (KnownNat n, KnownNat m) :- KnownNat o
+ magic f = Sub $ unsafeCoerce (Magic Dict) (natVal (Proxy :: Proxy n) `f` natVal (Proxy :: Proxy m))
+ 
+-axiom :: forall a b. Dict (a ~ b)
+-axiom = unsafeCoerce (Dict :: Dict (a ~ a))
++axiom :: Dict c
++axiom = unsafeCoerce (Dict :: Dict ())
  
 -axiomLe :: forall a b. Dict (a <= b)
 +axiomLe :: forall (a :: Nat) (b :: Nat). Dict (a <= b)
@@ -54,3 +59,18 @@ index ac1a78f..a49320b 100644
 -leTrans :: forall a b c. (b <= c, a <= b) :- (a <= c)
 +leTrans :: forall (a :: Nat) (b :: Nat) (c :: Nat). (b <= c, a <= b) :- (a <= c)
  leTrans = Sub (axiomLe @a @c)
+diff --git a/src/Data/Constraint/Symbol.hs b/src/Data/Constraint/Symbol.hs
+index 0b360ff..5e0256c 100644
+--- a/src/Data/Constraint/Symbol.hs
++++ b/src/Data/Constraint/Symbol.hs
+@@ -68,8 +68,8 @@ magicSSS f = Sub $ unsafeCoerce (Magic Dict) (symbolVal (Proxy :: Proxy n) `f` s
+ magicSN :: forall a n. (String -> Int) -> KnownSymbol a :- KnownNat n
+ magicSN f = Sub $ unsafeCoerce (Magic Dict) (toInteger (f (symbolVal (Proxy :: Proxy a))))
+ 
+-axiom :: forall a b. Dict (a ~ b)
+-axiom = unsafeCoerce (Dict :: Dict (a ~ a))
++axiom :: Dict c
++axiom = unsafeCoerce (Dict :: Dict ())
+ 
+ -- axioms and operations
+ 
diff --git a/patches/hgeometry-0.12.0.4.patch b/patches/hgeometry-0.12.0.4.patch
index 2a70728e743a8572eec31e18e0f12f7c745da4c6..44927bc10b187f35a770adffdb749639009b8b70 100644
--- a/patches/hgeometry-0.12.0.4.patch
+++ b/patches/hgeometry-0.12.0.4.patch
@@ -57,6 +57,16 @@ index a7bc078..02a03e8 100644
  import           Data.Vinyl
  import           Data.Vinyl.CoRec
  import           Prelude                        hiding (max, min)
+diff --git a/src/Data/Geometry/RangeTree.hs b/src/Data/Geometry/RangeTree.hs
+index e08b39d..d6ec9b6 100644
+--- a/src/Data/Geometry/RangeTree.hs
++++ b/src/Data/Geometry/RangeTree.hs
+@@ -1,4 +1,5 @@
+ {-# LANGUAGE UndecidableInstances #-}
++{-# LANGUAGE UndecidableSuperClasses #-}
+ --------------------------------------------------------------------------------
+ -- |
+ -- Module      :  Data.Geometry.RangeTree
 diff --git a/src/Data/Geometry/RangeTree/Measure.hs b/src/Data/Geometry/RangeTree/Measure.hs
 index ed61048..d33ef27 100644
 --- a/src/Data/Geometry/RangeTree/Measure.hs
diff --git a/patches/hgeometry-combinatorial-0.12.0.3.patch b/patches/hgeometry-combinatorial-0.12.0.3.patch
new file mode 100644
index 0000000000000000000000000000000000000000..acd87a25c7d71cd23d9fa65b0e11d05e775b858f
--- /dev/null
+++ b/patches/hgeometry-combinatorial-0.12.0.3.patch
@@ -0,0 +1,11 @@
+diff --git a/src/Data/LSeq.hs b/src/Data/LSeq.hs
+index d7d7426..8e10c34 100644
+--- a/src/Data/LSeq.hs
++++ b/src/Data/LSeq.hs
+@@ -1,5 +1,6 @@
+ {-# LANGUAGE ScopedTypeVariables #-}
+ {-# LANGUAGE BangPatterns #-}
++{-# LANGUAGE UndecidableInstances #-}
+ --------------------------------------------------------------------------------
+ -- |
+ -- Module      :  Data.LSeq