GHC 9.0 compatibility

MetaBrush.cabal

@@ -32,19 +32,19 @@ common common
 
     build-depends:
         base
-          >= 4.13 && < 4.17
+           >= 4.13 && < 4.17
       , acts
           ^>= 0.3.1.0
       , containers
-          >= 0.6.0.1 && < 0.6.4
+           >= 0.6.0.1 && < 0.6.5
       , deepseq
-          ^>= 1.4.4.0
+           >= 1.4.4.0 && < 1.5
       , generic-data
-          >= 0.8.0.0 && < 0.8.4.0
+           >= 0.8.0.0 && < 0.10
       , generic-lens
-          >= 1.2.0.1 && < 2.0
+           >= 1.2.0.1 && < 2.0
       , groups
-          ^>= 0.4.1.0
+           >= 0.4.1.0 && < 0.6
       , primitive
           ^>= 0.7.1.0
       , transformers
@@ -92,9 +92,9 @@ library
 
     build-depends:
         bifunctors
-          ^>= 5.5.4
+           >= 5.5.4      && < 5.6
       , groups-generic
-          ^>= 0.1.0.0
+           >= 0.1.0.0    && < 0.3
       , hmatrix
           ^>= 0.20.0.0
       , parallel
@@ -102,7 +102,7 @@ library
       , prim-instances
           ^>= 0.2
       , vector
-          ^>= 0.12.1.2
+           >= 0.12.1.2   && < 0.13
 
 executable MetaBrush
 
@@ -177,7 +177,7 @@ executable MetaBrush
       , bytestring
           ^>= 0.10.10.0
       , directory
-          >= 1.3.4.0 && < 1.4
+           >= 1.3.4.0    && < 1.4
       , dlist
           ^>= 1.0
       , Earley
@@ -185,29 +185,31 @@ executable MetaBrush
       , filepath
           ^>= 1.4.2.1
       , ghc-typelits-knownnat
-          ^>= 0.7.3
+           >= 0.7.3      && < 0.8
       , gi-cairo-render
-          ^>= 0.0.1
+          ^>= 0.1.0
       , gi-cairo-connector
-          ^>= 0.0.1
+          ^>= 0.1.0
       , gi-gdk
-          >= 3.0.22 && < 3.1
+           >= 3.0.22     && < 3.1
       , gi-gio
-          >= 2.0.27 && < 2.1
+           >= 2.0.27     && < 2.1
       , gi-glib
-          >= 2.0.23 && < 2.1
+           >= 2.0.23     && < 2.1
       , gi-gobject
           ^>= 2.0.24
       , gi-gtk
-          >= 3.0.35 && < 3.1
+           >= 3.0.35     && < 3.1
       , gi-gtksource
-          >= 3.0.23 && < 3.1
+           >= 3.0.23     && < 3.1
       , hashable
           ^>= 1.3.0.0
+      , haskell-gi
+           >= 0.25       && < 0.26
       , haskell-gi-base
-          ^>= 0.24.3
+           >= 0.25       && < 0.26
       , lens
-          ^>= 4.19.2
+           >= 4.19.2     && < 5.1
       , mtl
           ^>= 2.2.2
       , scientific
@@ -217,12 +219,12 @@ executable MetaBrush
       , superrecord
           ^>= 0.5.1.0
       , tardis
-          ^>= 0.4.1.0
+           >= 0.4.2.0    && < 0.5
       , text
-          >= 1.2.3.1 && < 1.2.5
+           >= 1.2.3.1    && < 1.2.5
       , tree-view
           ^>= 0.5
       , unordered-containers
-          >= 0.2.11 && < 0.2.14
+           >= 0.2.11     && < 0.2.14
       , waargonaut
-          ^>= 0.8.0.1
+          ^>= 0.8.0.2

cabal.project

@@ -4,45 +4,46 @@ constraints:
     acts -finitary
 
 allow-newer:
-    waargonaut:*
+    waargonaut:*,
+    *:haskell-gi-base, *:haskell-gi,
 
-
+-- various fixes for 'hmatrix'
--- fixes gi-cairo-render to work with haskell-gi >= 0.24
-source-repository-package
-  type: git
-  location: https://github.com/sheaf/gi-cairo-render
-  tag: a53d1596e36ce7bbff517940260faf1c4d02ffcc
-  subdir: gi-cairo-render gi-cairo-connector
-
--- latest version of hmatrix
 source-repository-package
   type: git
   location: https://github.com/haskell-numerics/hmatrix
-  tag: 08138810946c7eae2254feeb33269cd962d5e0c8
+  tag: e9268cd5ea31322220c0847f2fdce968789693b4
   subdir: packages/base
 
 package hmatrix
   ghc-options: "-w"
   flags: +openblas
 
--- adds MonadTrans Decoder instance to waargonaut Decoder
+---- instances for CPS Writer / CPS RWST
+--source-repository-package
+--  type: git
+--  location: https://github.com/haskell/mtl
+--  tag: c8af65eb8437aebefd7f3ff1664316a0240f2157
+
+-- GHC 9.0 compatibility for 'generics-lens' version 1.2
 source-repository-package
   type: git
-  location: https://github.com/sheaf/waargonaut
+  location: https://github.com/sheaf/generic-lens
-  tag: dc835fb86d2592fa2e55753fa4eb7c59d6124699
+  tag: 8d3f0b405894ecade5821c99dcde6efb4a637363
 
--- instances for CPS Writer / CPS RWST
+-- GHC 9.0 compatibility for 'haskell-gi' and 'haskell-gi-base'
 source-repository-package
   type: git
-  location: https://github.com/haskell/mtl
+  location: https://github.com/haskell-gi/haskell-gi
-  tag: a9023c764a08beedbb1b8ca20bc39103f26529c5
+  tag: cc6c25a32288ceef79585e8bba5f197065fb477c
-
+  subdir: .
--- patch to superrecord with API improvements
 source-repository-package
   type: git
-  location: https://github.com/sheaf/superrecord
+  location: https://github.com/haskell-gi/haskell-gi
-  tag: 4cecac06afaa3fb60e67cdb273e36eed3f04335d
+  tag: cc6c25a32288ceef79585e8bba5f197065fb477c
+  subdir: base
 
-constraints:
+-- superrecord API improvements
-  -- fix for Haskell GI GValue bug
+source-repository-package
-  haskell-gi >= 0.24.5
+  type: git
+  location: https://github.com/agrafix/superrecord
+  tag: f1c8cf87fd25243e715fd9585e595a90fff34050

src/app/MetaBrush/Assert.hs

@@ -12,6 +12,7 @@ import Control.Exception
 
 --------------------------------------------------------------------------------
 
+{-# INLINE assert #-}
 assert :: String -> a -> a
 #ifdef ASSERTS
 assert message _ = throw ( AssertionFailed message )

src/app/MetaBrush/Document/Serialise.hs

@@ -55,7 +55,7 @@ import qualified Data.ByteString as Strict.ByteString
   ( readFile )
 import qualified Data.ByteString.Lazy as Lazy
   ( ByteString )
-import qualified Data.ByteString.Lazy.Builder as Lazy.ByteString.Builder
+import qualified Data.ByteString.Builder as Lazy.ByteString.Builder
   ( toLazyByteString )
 
 -- containers

src/app/MetaBrush/MetaParameter/Driver.hs

@@ -1,11 +1,16 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DerivingStrategies  #-}
+{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE DerivingStrategies    #-}
-{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MagicHash           #-}
+{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE MagicHash             #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module MetaBrush.MetaParameter.Driver where
 
@@ -59,6 +64,35 @@ import MetaBrush.Unique
 
 --------------------------------------------------------------------------------
 
+#if !MIN_VERSION_mtl(2,3,0)
+-- mtl
+import Control.Monad.Reader
+  ( MonadReader(..) )
+import Control.Monad.State
+  ( MonadState(..) )
+import Control.Monad.Writer
+  ( MonadWriter(..) )
+
+-- transformers
+import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
+
+instance ( Monad m, Monoid w ) => MonadReader r ( CPSRWS.RWST r w s m ) where
+  ask    = CPSRWS.ask
+  local  = CPSRWS.local
+  reader = CPSRWS.reader
+
+instance ( Monad m, Monoid w ) => MonadState  s ( CPSRWS.RWST r w s m ) where
+  get   = CPSRWS.get
+  put   = CPSRWS.put
+  state = CPSRWS.state
+
+instance ( Monoid w, Monad m ) => MonadWriter w ( CPSRWS.RWST r w s m ) where
+  writer = CPSRWS.writer
+  tell   = CPSRWS.tell
+  listen = CPSRWS.listen
+  pass   = CPSRWS.pass
+#endif
+
 data DriverError
   = ParseError     !( Earley.Report Text [ Located Token ] )
   | RenameError    !RnError

src/app/MetaBrush/UI/FileBar.hs

@@ -18,8 +18,8 @@ import Control.Monad
   ( join, unless, void )
 import Data.Foldable
   ( for_, sequenceA_ )
-import Data.Functor
+import Data.Int
-  ( (<&>) )
+  ( Int32 )
 import Data.Traversable
   ( for )
 
@@ -153,10 +153,10 @@ newFileTab
           for mbUnique \ docUnique -> do
             Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar
         for_ mbActiveTab \ ( activeTab, _ ) -> do
-          gValue <- GI.newGValue GI.gtypeInt
+          old_gValue <- GI.newGValue GI.gtypeInt
-          GTK.containerChildGetProperty fileTabsBox activeTab "position" gValue
+          GTK.containerChildGetProperty fileTabsBox activeTab "position" old_gValue
-          ( GI.get_int gValue <&> ( +1 ) ) >>= GI.set_int gValue
+          new_gValue <- GI.toGValue @Int32 =<< ( +1 ) <$> GI.fromGValue @Int32 old_gValue
-          GTK.containerChildSetProperty fileTabsBox       tab "position" gValue
+          GTK.containerChildSetProperty fileTabsBox       tab "position" new_gValue
 
     -- Ensure consistency of hover/selection state between the two elements in the tab.
     for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do

src/lib/Math/Bezier/Spline.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
@@ -435,7 +436,9 @@ instance KnownSplineType Open where
   biwitherSpline
     :: forall f crvData ptData crvData' ptData'
     .  Monad f
-    => ( Maybe ptData' -> Curve Open crvData ptData -> f ( Maybe ( Curve Open crvData' ptData' ) ) )
+    => (  forall clo'. ( clo' ~ Open, SplineTypeI clo' )
+       => Maybe ptData' -> Curve clo' crvData ptData -> f ( Maybe ( Curve clo' crvData' ptData' ) )
+       )
     -> ( ptData -> f ( Maybe ptData' ) )
     -> Spline Open crvData ptData
     -> f ( Maybe ( Spline Open crvData' ptData' ) )
@@ -475,7 +478,7 @@ instance KnownSplineType Closed where
   ibitraverseSpline
     :: forall f crvData ptData crvData' ptData' 
     .  Applicative f
-    => ( forall clo'. ( SplineTypeI clo', Traversable ( NextPoint clo' ) )
+    => (  forall clo'. ( (), SplineTypeI clo' )
        => Int -> ptData -> Curve clo' crvData ptData -> f ( Curve clo' crvData' ptData' )
        )
     -> ( ptData -> f ptData' )

src/lib/Math/Bezier/Stroke.hs

@@ -96,6 +96,7 @@ import Math.Bezier.Spline
   , Spline(..), SplinePts, Curves(..), Curve(..)
   , openCurveStart, openCurveEnd
   , splitSplineAt, dropCurves
+  , reverseSpline
   )
 import qualified Math.Bezier.Quadratic as Quadratic
 import Math.Epsilon

src/lib/Math/Linear/Solve.hs

@@ -4,7 +4,7 @@ module Math.Linear.Solve
 
 -- hmatrix
 import qualified Numeric.LinearAlgebra      as LAPACK
-  ( linearSolveLS )
+  ( linearSolveSVD )
 import qualified Numeric.LinearAlgebra.Data as HMatrix
   ( Matrix, col, matrix, atIndex )
 
@@ -18,4 +18,4 @@ linearSolve :: Mat22 Double -> Vector2D Double -> Vector2D Double
 linearSolve ( Mat22 a b c d ) ( Vector2D p q ) = Vector2D ( sol `HMatrix.atIndex` (0,0) ) ( sol `HMatrix.atIndex` (1,0) )
   where
     sol :: HMatrix.Matrix Double
-    sol = LAPACK.linearSolveLS ( HMatrix.matrix 2 [a,b,c,d] ) ( HMatrix.col [p,q] )
+    sol = LAPACK.linearSolveSVD ( HMatrix.matrix 2 [a,b,c,d] ) ( HMatrix.col [p,q] )