diff --git a/ci/build-deps.nix b/ci/build-deps.nix
index dd3539721acd95841e6a1d01150a81816fe47fd3..64ba6e46e34072903935105d3ea32860d97be2be 100644
--- a/ci/build-deps.nix
+++ b/ci/build-deps.nix
@@ -8,4 +8,5 @@ with pkgs;
digest = [ zlib ];
regex-pcre = [ pcre ];
bzlib = [ bzip2 ];
+ hmatrix = [ blas liblapack ];
}
diff --git a/patches/doctest-0.16.2.patch b/patches/doctest-0.16.2.patch
index cac1adf91b85e5328d632c5ff050eb89bece49c4..2415f64b5e0992a29247a78f5c770a5fddeabc90 100644
--- a/patches/doctest-0.16.2.patch
+++ b/patches/doctest-0.16.2.patch
@@ -1,8 +1,19 @@
diff --git a/src/Extract.hs b/src/Extract.hs
-index a5604b4..81ed5a9 100644
+index a5604b4..925fdb4 100644
--- a/src/Extract.hs
+++ b/src/Extract.hs
-@@ -118,9 +118,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -47,7 +47,9 @@ import Location hiding (unLoc)
+ import Util (convertDosLineEndings)
+ import PackageDBs (getPackageDBArgs)
+
+-#if __GLASGOW_HASKELL__ >= 806
++#if __GLASGOW_HASKELL__ >= 811
++import GHC.Runtime.Loader (initializePlugins)
++#elif __GLASGOW_HASKELL__ >= 806
+ import DynamicLoading (initializePlugins)
+ #endif
+
+@@ -118,9 +120,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
enableCompilation modGraph = do
#if __GLASGOW_HASKELL__ < 707
let enableComp d = d { hscTarget = defaultObjectTarget }
diff --git a/patches/ghc-typelits-knownnat-0.7.1.patch b/patches/ghc-typelits-knownnat-0.7.1.patch
deleted file mode 100644
index 58e0aa1ea19684fd7bc67928114a4b0374c29341..0000000000000000000000000000000000000000
--- a/patches/ghc-typelits-knownnat-0.7.1.patch
+++ /dev/null
@@ -1,61 +0,0 @@
-diff --git a/src/GHC/TypeLits/KnownNat.hs b/src/GHC/TypeLits/KnownNat.hs
-index f6ab0bf..c53d062 100644
---- a/src/GHC/TypeLits/KnownNat.hs
-+++ b/src/GHC/TypeLits/KnownNat.hs
-@@ -191,8 +191,8 @@ instance (KnownNat a, KnownNat b) => KnownNat2 $(nameToSymbol ''(*)) a b where
-
- -- | 'KnownNat2' instance for "GHC.TypeLits"' 'GHC.TypeLits.^'
- instance (KnownNat a, KnownNat b) => KnownNat2 $(nameToSymbol ''(^)) a b where
-- natSing2 = let x = natVal (Proxy @ a)
-- y = natVal (Proxy @ b)
-+ natSing2 = let x = natVal (Proxy @a)
-+ y = natVal (Proxy @b)
- z = case x of
- 2 -> shiftL 1 (fromIntegral y)
- _ -> x ^ y
-diff --git a/src/GHC/TypeLits/KnownNat/Solver.hs b/src/GHC/TypeLits/KnownNat/Solver.hs
-index 028ae22..66f5524 100644
---- a/src/GHC/TypeLits/KnownNat/Solver.hs
-+++ b/src/GHC/TypeLits/KnownNat/Solver.hs
-@@ -142,21 +142,37 @@ import TcPluginM (unsafeTcPluginTcM)
- import TcPluginM (zonkCt)
- #endif
- import TcPluginM (TcPluginM, tcLookupClass, getInstEnvs)
--import TcRnTypes (Ct, TcPlugin(..), TcPluginResult (..), ctEvidence, ctEvLoc,
-+import TcRnTypes (TcPlugin(..), TcPluginResult(..))
-+#if MIN_VERSION_ghc(8,9,0)
-+import Constraint (Ct, ctEvidence, ctEvLoc, ctEvPred, ctEvExpr, ctLoc,
-+ ctLocSpan, isWanted, setCtLoc, setCtLocSpan, mkNonCanonical)
-+#else
-+import TcRnTypes (Ct, ctEvidence, ctEvLoc, ctEvPred, ctEvExpr, ctLoc,
-+ ctLocSpan, isWanted, setCtLoc, setCtLocSpan)
-+import TcRnTypes (mkNonCanonical)
- #if MIN_VERSION_ghc(8,5,0)
-- ctEvPred, ctEvExpr, ctLoc, ctLocSpan, isWanted,
-+import TcRnTypes (ctEvExpr)
- #else
-- ctEvPred, ctEvTerm, ctLoc, ctLocSpan, isWanted,
-+import TcRnTypes (ctEvTerm)
-+#endif
- #endif
-- mkNonCanonical, setCtLoc, setCtLocSpan)
- import TcTypeNats (typeNatAddTyCon, typeNatSubTyCon)
- #if MIN_VERSION_ghc(8,4,0)
- import TcTypeNats (typeNatDivTyCon)
- #endif
-+#if MIN_VERSION_ghc(8,9,0)
-+import Predicate
-+ (EqRel (NomEq), Pred (ClassPred,EqPred), classifyPredType)
-+import Type
-+ (dropForAlls, eqType, funResultTy, mkNumLitTy, mkStrLitTy, mkTyConApp,
-+ piResultTys, splitFunTys, splitTyConApp_maybe, tyConAppTyCon_maybe, typeKind,
-+ PredType)
-+#else
- import Type
- (EqRel (NomEq), PredTree (ClassPred,EqPred), PredType, classifyPredType,
- dropForAlls, eqType, funResultTy, mkNumLitTy, mkStrLitTy, mkTyConApp,
- piResultTys, splitFunTys, splitTyConApp_maybe, tyConAppTyCon_maybe, typeKind)
-+#endif
- import TyCon (tyConName)
- import TyCoRep (Type (..), TyLit (..))
- #if MIN_VERSION_ghc(8,6,0)
diff --git a/patches/ghc-typelits-natnormalise-0.7.patch b/patches/ghc-typelits-natnormalise-0.7.patch
deleted file mode 100644
index fc22bf760e9aaa8b8d967f2e9f79365780fbe899..0000000000000000000000000000000000000000
--- a/patches/ghc-typelits-natnormalise-0.7.patch
+++ /dev/null
@@ -1,77 +0,0 @@
-diff --git a/src/GHC/TypeLits/Normalise.hs b/src/GHC/TypeLits/Normalise.hs
-index 5dd94ba..0a38706 100644
---- a/src/GHC/TypeLits/Normalise.hs
-+++ b/src/GHC/TypeLits/Normalise.hs
-@@ -189,24 +189,34 @@ import TcEvidence (EvTerm (..))
- import TcPluginM (zonkCt)
- #endif
- import TcPluginM (TcPluginM, tcPluginTrace)
--import TcRnTypes (Ct, TcPlugin (..), TcPluginResult(..), ctEvidence, ctEvPred,
-- isWanted, mkNonCanonical)
-+#if MIN_VERSION_ghc(8,9,0)
-+import Predicate (mkClassPred, mkPrimEqPred, classifyPredType, getEqPredTys,
-+ Pred (EqPred), EqRel (NomEq))
-+import Constraint (Ct, ctEvidence, isWanted, ctEvPred, ctEvLoc, ctLoc, ctLocSpan,
-+ CtEvidence (..), CtLoc, TcEvDest (..), isGiven,
-+ mkNonCanonical, setCtLoc, setCtLocSpan)
-+import Type (Kind, typeKind, eqType, mkTyVarTy, PredType)
-+#else
-+import TcRnTypes (Ct, ctEvidence, ctEvPred, isWanted, mkNonCanonical,
-+ CtEvidence (..), CtLoc, TcEvDest (..), ctEvLoc, ctLoc,
-+ ctLocSpan, isGiven,
-+ setCtLoc, setCtLocSpan)
- import Type (EqRel (NomEq), Kind, PredTree (EqPred), PredType,
-- classifyPredType, eqType, getEqPredTys, mkTyVarTy)
-+ classifyPredType, eqType, getEqPredTys, mkTyVarTy, mkClassPred,
-+ typeKind, mkPrimEqPred)
-+#endif
-+import TcRnTypes (TcPlugin(..), TcPluginResult(..))
- import TysWiredIn (typeNatKind)
-
- import Coercion (CoercionHole, Role (..), mkForAllCos, mkHoleCo, mkInstCo,
- mkNomReflCo, mkUnivCo)
- import TcPluginM (newCoercionHole, newFlexiTyVar, tcLookupClass)
--import TcRnTypes
-- (CtEvidence (..), CtLoc, TcEvDest (..), ctEvLoc, ctLoc, ctLocSpan, isGiven,
-- setCtLoc, setCtLocSpan)
--#if MIN_VERSION_ghc(8,2,0)
-+#if MIN_VERSION_ghc(8,9,0)
-+import Constraint (ShadowInfo (WDeriv))
-+#elif MIN_VERSION_ghc(8,2,0)
- import TcRnTypes (ShadowInfo (WDeriv))
- #endif
- import TyCoRep (UnivCoProvenance (..))
--import Type (mkClassPred, mkPrimEqPred)
--import TcType (typeKind)
- import TyCoRep (Type (..))
- import TcTypeNats (typeNatAddTyCon, typeNatExpTyCon, typeNatMulTyCon,
- typeNatSubTyCon)
-diff --git a/src/GHC/TypeLits/Normalise/Unify.hs b/src/GHC/TypeLits/Normalise/Unify.hs
-index 3183bfb..9d1471f 100644
---- a/src/GHC/TypeLits/Normalise/Unify.hs
-+++ b/src/GHC/TypeLits/Normalise/Unify.hs
-@@ -60,13 +60,21 @@ import GHC.Integer.Logarithms (integerLogBase#)
- -- GHC API
- import Outputable (Outputable (..), (<+>), ($$), text)
- import TcPluginM (TcPluginM, tcPluginTrace)
-+#if MIN_VERSION_ghc(8,9,0)
-+import Constraint (Ct, ctEvidence, isGiven, ctEvPred)
-+import Predicate (EqRel (NomEq), Pred (EqPred), mkPrimEqPred, classifyPredType)
-+import Type (TyVar,
-+ coreView, eqType, mkNumLitTy, mkTyConApp, mkTyVarTy,
-+ nonDetCmpType, PredType)
-+#else
- import TcRnMonad (Ct, ctEvidence, isGiven)
--import TcRnTypes (ctEvPred)
--import TcTypeNats (typeNatAddTyCon, typeNatExpTyCon, typeNatMulTyCon,
-- typeNatSubTyCon, typeNatLeqTyCon)
- import Type (EqRel (NomEq), PredTree (EqPred), TyVar, classifyPredType,
- coreView, eqType, mkNumLitTy, mkTyConApp, mkTyVarTy,
- nonDetCmpType, PredType, mkPrimEqPred)
-+import TcRnTypes (ctEvPred)
-+#endif
-+import TcTypeNats (typeNatAddTyCon, typeNatExpTyCon, typeNatMulTyCon,
-+ typeNatSubTyCon, typeNatLeqTyCon)
- import TyCoRep (Kind, Type (..), TyLit (..))
- import TysWiredIn (boolTy, promotedTrueDataCon)
- import UniqSet (UniqSet, unionManyUniqSets, emptyUniqSet, unionUniqSets,
diff --git a/patches/hmatrix-0.20.0.0.patch b/patches/hmatrix-0.20.0.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..b37af7145fe936a1da9886fdc86b6ad1ff8a486e
--- /dev/null
+++ b/patches/hmatrix-0.20.0.0.patch
@@ -0,0 +1,39 @@
+diff --git a/src/Internal/Sparse.hs b/src/Internal/Sparse.hs
+index fbea11a..b390e7f 100644
+--- a/src/Internal/Sparse.hs
++++ b/src/Internal/Sparse.hs
+@@ -124,7 +124,7 @@ mkSparse = fromCSR . mkCSR
+ fromCSR :: CSR -> GMatrix
+ fromCSR csr = SparseR {..}
+ where
+- gmCSR @ CSR {..} = csr
++ gmCSR@CSR {..} = csr
+ nRows = csrNRows
+ nCols = csrNCols
+
+diff --git a/src/Internal/Util.hs b/src/Internal/Util.hs
+index f642e8d..a6401f5 100644
+--- a/src/Internal/Util.hs
++++ b/src/Internal/Util.hs
+@@ -632,7 +632,7 @@ pivotDown t n xs
+ y:ys = redu (pivot n xs)
+
+ pivot k = (const k &&& id)
+- . sortBy (flip compare `on` (abs. (!k)))
++ . sortBy (flip compare `on` (abs. (! k)))
+
+ redu :: (Int, [Vector t]) -> [Vector t]
+ redu (k,x:zs)
+diff --git a/src/Numeric/LinearAlgebra/Static.hs b/src/Numeric/LinearAlgebra/Static.hs
+index e5ce4e2..119d13c 100644
+--- a/src/Numeric/LinearAlgebra/Static.hs
++++ b/src/Numeric/LinearAlgebra/Static.hs
+@@ -383,7 +383,7 @@ split (extract -> v) = ( mkR (subVector 0 p' v) ,
+
+
+ headTail :: (KnownNat n, 1<=n) => R n -> (ℝ, R (n-1))
+-headTail = ((!0) . extract *** id) . split
++headTail = ((! 0) . extract *** id) . split
+
+
+ splitRows :: forall p m n . (KnownNat p, KnownNat m, KnownNat n, p<=m) => L m n -> (L p n, L (m-p) n)
diff --git a/patches/network-uri-2.6.3.0.patch b/patches/network-uri-2.6.3.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..25e55c390da1378cab814f9ef21701aea9ff4f5d
--- /dev/null
+++ b/patches/network-uri-2.6.3.0.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/URI.hs b/Network/URI.hs
+index df7af36..b26a09f 100644
+--- a/Network/URI.hs
++++ b/Network/URI.hs
+@@ -1415,7 +1415,7 @@ scheme = orNull init . uriScheme
+
+ {-# DEPRECATED authority "use uriAuthority, and note changed functionality" #-}
+ authority :: URI -> String
+-authority = dropss . ($"") . uriAuthToString id . uriAuthority
++authority = dropss . ($ "") . uriAuthToString id . uriAuthority
+ where
+ -- Old-style authority component does not include leading '//'
+ dropss ('/':'/':s) = s
diff --git a/patches/pandoc-2.9.1.1.patch b/patches/pandoc-2.9.2.patch
similarity index 84%
rename from patches/pandoc-2.9.1.1.patch
rename to patches/pandoc-2.9.2.patch
index a309498a3a8c581f56e0fd6dea7b2e65162f6e08..bbfa9ef95e19654f20008b9c16ed3f01642bad24 100644
--- a/patches/pandoc-2.9.1.1.patch
+++ b/patches/pandoc-2.9.2.patch
@@ -1,8 +1,8 @@
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
-index 0fe80be..2f320fb 100644
+index 736daac..ccc7f5e 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
-@@ -316,6 +316,10 @@ defaultMathJaxURL = "https://cdn.jsdelivr.net/npm/mathjax@3/es5/"
+@@ -315,6 +315,10 @@ defaultMathJaxURL = "https://cdn.jsdelivr.net/npm/mathjax@3/es5/"
defaultKaTeXURL :: Text
defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.11.1/"
@@ -13,7 +13,7 @@ index 0fe80be..2f320fb 100644
$(deriveJSON defaultOptions ''ReaderOptions)
$(deriveJSON defaultOptions{
-@@ -339,10 +343,6 @@ $(deriveJSON defaultOptions{ constructorTagModifier =
+@@ -338,10 +342,6 @@ $(deriveJSON defaultOptions{ constructorTagModifier =
$(deriveJSON defaultOptions ''HTMLSlideVariant)
diff --git a/patches/parameterized-utils-2.0.1.0.patch b/patches/parameterized-utils-2.0.2.patch
similarity index 86%
rename from patches/parameterized-utils-2.0.1.0.patch
rename to patches/parameterized-utils-2.0.2.patch
index 2d18a4df7a28f7aa3ce3425394a205b7c1fa6d16..5b53161defa3a4275f645bb98ec5c87252586fa9 100644
--- a/patches/parameterized-utils-2.0.1.0.patch
+++ b/patches/parameterized-utils-2.0.2.patch
@@ -30,18 +30,10 @@ index 94a22f3..c1de1aa 100644
-> Compose f g x
-> Compose f g y
diff --git a/src/Data/Parameterized/Compose.hs b/src/Data/Parameterized/Compose.hs
-index 807ea72..b6b641c 100644
+index a82e76e..73994ac 100644
--- a/src/Data/Parameterized/Compose.hs
+++ b/src/Data/Parameterized/Compose.hs
-@@ -10,6 +10,7 @@ see https://gitlab.haskell.org/ghc/ghc/merge_requests/273 and also
- https://github.com/haskell-compat/base-orphans/issues/49.
- -}
-
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE GADTs #-}
- {-# LANGUAGE PolyKinds #-}
- {-# LANGUAGE RankNTypes #-}
-@@ -27,7 +28,7 @@ import Data.Type.Equality
+@@ -27,7 +27,7 @@ import Data.Type.Equality
-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y@.
--
-- See https://gitlab.haskell.org/ghc/ghc/merge_requests/273.
@@ -50,21 +42,6 @@ index 807ea72..b6b641c 100644
(forall w z. f w -> f z -> Maybe (w :~: z))
-> Compose f g x
-> Compose f g y
-@@ -37,11 +38,13 @@ testEqualityComposeBare testEquality_ (Compose x) (Compose y) =
- Just Refl -> Just (Refl :: x :~: y)
- Nothing -> Nothing
-
--testEqualityCompose :: forall (f :: k -> *) (g :: l -> k) x y. (TestEquality f)
-+testEqualityCompose :: forall k l (f :: k -> *) (g :: l -> k) x y. (TestEquality f)
- => Compose f g x
- -> Compose f g y
- -> Maybe (x :~: y)
- testEqualityCompose = testEqualityComposeBare testEquality
-
-+#if __GLASGOW_HASKELL__ < 809
- instance (TestEquality f) => TestEquality (Compose f g) where
- testEquality = testEqualityCompose
-+#endif
diff --git a/src/Data/Parameterized/Context/Safe.hs b/src/Data/Parameterized/Context/Safe.hs
index 186c584..ef26788 100644
--- a/src/Data/Parameterized/Context/Safe.hs
@@ -111,10 +88,10 @@ index b82e093..faaf4a8 100644
-- This is an unsafe version of update that changes the type of the expression.
diff --git a/src/Data/Parameterized/Map.hs b/src/Data/Parameterized/Map.hs
-index 9213e7f..ed53533 100644
+index ee42088..2b10eff 100644
--- a/src/Data/Parameterized/Map.hs
+++ b/src/Data/Parameterized/Map.hs
-@@ -246,12 +246,12 @@ type instance IndexF (MapF k v) = k
+@@ -247,12 +247,12 @@ type instance IndexF (MapF k v) = k
type instance IxValueF (MapF k v) = v
-- | Turn a map key into a traversal that visits the indicated element in the map, if it exists.
diff --git a/patches/proto3-wire-1.1.0.patch b/patches/proto3-wire-1.1.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..45a9904a7f5d7a1bee9dde80f20927e586a7a449
--- /dev/null
+++ b/patches/proto3-wire-1.1.0.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Proto3/Wire/Decode.hs b/src/Proto3/Wire/Decode.hs
+index d90a0a8..e600923 100644
+--- a/src/Proto3/Wire/Decode.hs
++++ b/src/Proto3/Wire/Decode.hs
+@@ -192,7 +192,7 @@ gwireType 2 = return LengthDelimited
+ gwireType wt = Left $ "wireType got unknown wire type: " ++ show wt
+
+ safeSplit :: Int -> B.ByteString -> Either String (B.ByteString, B.ByteString)
+-safeSplit !i! b | B.length b < i = Left "failed to parse varint128: not enough bytes"
++safeSplit !i !b | B.length b < i = Left "failed to parse varint128: not enough bytes"
+ | otherwise = Right $ B.splitAt i b
+
+ takeWT :: WireType -> B.ByteString -> Either String (ParsedField, B.ByteString)
diff --git a/patches/row-types-0.3.0.0.patch b/patches/row-types-0.3.1.0.patch
similarity index 84%
rename from patches/row-types-0.3.0.0.patch
rename to patches/row-types-0.3.1.0.patch
index 72a8567731f5b1add370870e9bf563f10c3e6ae8..4b75665ab68dd4f580bd6470952223a61465a6f0 100644
--- a/patches/row-types-0.3.0.0.patch
+++ b/patches/row-types-0.3.1.0.patch
@@ -1,8 +1,8 @@
diff --git a/Data/Row/Records.hs b/Data/Row/Records.hs
-index 4838938..db41430 100644
+index 85c4cf9..12230b5 100644
--- a/Data/Row/Records.hs
+++ b/Data/Row/Records.hs
-@@ -320,7 +320,7 @@ newtype RecAp (ϕ :: Row (k -> *)) (ρ :: Row k) = RecAp (Rec (Ap ϕ ρ))
+@@ -321,7 +321,7 @@ newtype RecAp (ϕ :: Row (k -> *)) (ρ :: Row k) = RecAp (Rec (Ap ϕ ρ))
newtype App (f :: k -> *) (a :: k) = App (f a)
-- | A function to map over a Ap record given constraints.