switch to using eigen instead of hmatrix

MetaBrush.cabal

@@ -32,7 +32,7 @@ common common
 
     build-depends:
         base
-           >= 4.13    && < 4.17
+           >= 4.16    && < 4.20
       , acts
           ^>= 0.3.1.0
       , containers
@@ -143,8 +143,8 @@ library splines
     build-depends:
         bifunctors
            >= 5.5.4      && < 5.6
-      , hmatrix
+      , eigen
-          ^>= 0.20.0.0
+          ^>= 3.3.7.0
       , parallel
           ^>= 3.2.2.0
       , prim-instances

app/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 

cabal.project

@@ -19,6 +19,12 @@ source-repository-package
   tag: e9268cd5ea31322220c0847f2fdce968789693b4
   subdir: packages/base
 
+-- GHC compat fixes for records-sop
+source-repository-package
+  type: git
+  location: https://github.com/kosmikus/records-sop
+  tag: abab99b4b870fce55e81dd03d4e41fb50502ca4e
+
 package hmatrix
   ghc-options: "-w"
   flags: +openblas
@@ -29,3 +35,6 @@ source-repository-package
   subdir: large-generics
           large-anon
   tag: acb837a9a4c22cea1abf552b47f9d3bf5af2fbdf
+
+package *
+  ghc-options: "-finfo-table-map" "-fdistinct-constructor-tables"

shell.nix

@@ -0,0 +1,30 @@
+let np = import <nixpkgs> {};
+in with np; np.mkShell { packages =
+  [ cabal-install
+    zlib
+    pkg-config
+    gobject-introspection
+    gtk4
+    pcre
+    cairo
+    glib
+    atk
+    util-linux
+    libselinux
+    libsepol
+    xorg.libXdmcp
+    libthai
+    libdatrie
+    epoxy
+    fribidi
+    xorg.libXi
+    xorg.libXrandr
+    xorg.libXcursor
+    xorg.libXdamage
+    xorg.libXinerama
+    libxkbcommon ];
+  shellHook = ''
+    export LC_ALL=C.UTF-8
+    export XDG_DATA_DIRS=${gsettings-desktop-schemas}/share/gsettings-schemas/${gsettings-desktop-schemas.name}:${gtk4}/share/gsettings-schemas/${gtk4.name}:$XDG_DATA_DIRS
+  '';
+}

src/app/MetaBrush/Action.hs

@@ -267,22 +267,23 @@ instance HandleAction OpenFolder where
     GTK.nativeDialogShow fileChooser
     void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
       when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
-        folder <- GTK.fileChooserGetFile fileChooser
+        mbFolder <- GTK.fileChooserGetFile fileChooser
-        mbFolderPath <- GIO.fileGetPath folder
+        for_ mbFolder \ folder -> do
-        for_ mbFolderPath \ folderPath -> do
+          mbFolderPath <- GIO.fileGetPath folder
-          exists <- doesDirectoryExist folderPath
+          for_ mbFolderPath \ folderPath -> do
-          when exists do
+            exists <- doesDirectoryExist folderPath
-            filePaths <- listDirectory folderPath
+            when exists do
-            for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
+              filePaths <- listDirectory folderPath
-              mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
+              for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
-              case mbDoc of
+                mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
-                Left errMessage -> warningDialog window filePath errMessage
+                case mbDoc of
-                Right doc -> do
+                  Left errMessage -> warningDialog window filePath errMessage
-                  let
+                  Right doc -> do
-                    newDocHist :: DocumentHistory
+                    let
-                    newDocHist = newHistory doc
+                      newDocHist :: DocumentHistory
-                  newFileTab uiElts vars ( Just newDocHist ) tabLoc
+                      newDocHist = newHistory doc
-                  updateHistoryState uiElts ( Just newDocHist )
+                    newFileTab uiElts vars ( Just newDocHist ) tabLoc
+                    updateHistoryState uiElts ( Just newDocHist )
 
 --------------------
 -- Save & Save as --
@@ -342,9 +343,10 @@ withSavePath ( UIElements {..} ) action = do
   GTK.nativeDialogShow fileChooser
   void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
     when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
-      saveFile <- GTK.fileChooserGetFile fileChooser
+      mbSaveFile <- GTK.fileChooserGetFile fileChooser
-      mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
+      for_ mbSaveFile \ saveFile -> do
-      for_ mbSavePath action
+        mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
+        for_ mbSavePath action
   where
     fullFilePath :: FilePath -> FilePath
     fullFilePath fp

src/app/MetaBrush/Application.hs

@@ -75,10 +75,6 @@ import qualified Control.Concurrent.STM as STM
 import qualified Control.Concurrent.STM.TVar as STM
   ( newTVarIO, readTVar, writeTVar )
 
--- text
-import qualified Data.Text as Text
-  ( pack )
-
 -- transformers
 import Control.Monad.Trans.Reader
   ( runReaderT )
@@ -229,7 +225,7 @@ runApplication application = do
   display     <- GTK.rootGetDisplay window
 
   dataPath    <- Directory.canonicalizePath =<< Cabal.getDataDir
-  themePath   <- Text.pack <$> ( Directory.canonicalizePath =<< Cabal.getDataFileName "theme.css" )
+  themePath   <- ( Directory.canonicalizePath =<< Cabal.getDataFileName "theme.css" )
   cssProvider <- GTK.cssProviderNew
   GTK.cssProviderLoadFromPath cssProvider themePath
   GTK.styleContextAddProviderForDisplay display cssProvider 1000
@@ -268,8 +264,8 @@ runApplication application = do
 
   mainView <- GTK.boxNew GTK.OrientationVertical 0
 
-  GTK.panedSetStartChild mainPane mainView
+  GTK.panedSetStartChild mainPane ( Just mainView )
-  GTK.panedSetEndChild   mainPane panelBox
+  GTK.panedSetEndChild   mainPane ( Just panelBox )
 
   viewportGrid <- GTK.gridNew
 

src/app/MetaBrush/UI/Panels.hs

@@ -36,8 +36,8 @@ createPanelBar panelBox = do
   GTK.notebookSetGroupName panels1 ( Just "Panel" )
   GTK.notebookSetGroupName panels2 ( Just "Panel" )
 
-  GTK.panedSetStartChild pane1 panels1
+  GTK.panedSetStartChild pane1 ( Just panels1 )
-  GTK.panedSetEndChild   pane1 panels2
+  GTK.panedSetEndChild   pane1 ( Just panels2 )
 
   strokesPanel   <- GTK.boxNew GTK.OrientationVertical 0
   brushesPanel   <- GTK.boxNew GTK.OrientationVertical 0

src/splines/Math/Bezier/Cubic/Fit.hs

@@ -242,8 +242,8 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
             b2'  = b2  + ( q'  ^.^ f1i )
           hermiteParameters ( Mat22 a11' a12' a21' a22' ) ( Vector2D b1' b2' ) ( i + 1 ) rest
         hermiteParameters a b _ [] = pure ( linearSolve a b )
-      
+
-      Vector2D s1 s2 <- hermiteParameters ( Mat22 0 0 0 0 ) ( Vector2D 0 0 ) 0 qs
+      ~(Vector2D s1 s2) <- hermiteParameters ( Mat22 0 0 0 0 ) ( Vector2D 0 0 ) 0 qs
 
       let
         -- Convert from Hermite form to Bézier form.

src/splines/Math/Linear/Solve.hs

@@ -1,12 +1,18 @@
+{-# LANGUAGE DataKinds #-}
+
 module Math.Linear.Solve
   ( linearSolve )
   where
 
--- hmatrix
+-- base
-import qualified Numeric.LinearAlgebra      as LAPACK
+import Data.Maybe
-  ( linearSolveSVD )
+  ( fromJust )
-import qualified Numeric.LinearAlgebra.Data as HMatrix
+
-  ( Matrix, col, matrix, atIndex )
+-- eigen
+import qualified Eigen.Matrix as Eigen
+  ( Matrix, toList, fromList )
+import qualified Eigen.Solver.LA as Eigen
+  ( Decomposition(..), solve )
 
 -- MetaBrush
 import Math.Vector2D
@@ -15,7 +21,11 @@ import Math.Vector2D
 --------------------------------------------------------------------------------
 
 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) )
+linearSolve ( Mat22 a b c d ) ( Vector2D p q ) = Vector2D u v
   where
-    sol :: HMatrix.Matrix Double
+    [[u],[v]] = Eigen.toList
-    sol = LAPACK.linearSolveSVD ( HMatrix.matrix 2 [a,b,c,d] ) ( HMatrix.col [p,q] )
+              $ Eigen.solve Eigen.JacobiSVD
+                  ( fromJust ( Eigen.fromList [[a,b],[c,d]] )
+                    :: Eigen.Matrix 2 2 Double )
+                  ( fromJust ( Eigen.fromList [[p],[q]] )
+                    :: Eigen.Matrix 2 1 Double )

src/splines/Math/Vector2D.hs

@@ -2,10 +2,15 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MonoLocalBinds             #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 module Math.Vector2D
   ( Point2D(..), Vector2D(.., Vector2D), Mat22(..)
@@ -17,7 +22,7 @@ module Math.Vector2D
 import Data.Monoid
   ( Sum(..) )
 import GHC.Generics
-  ( Generic, Generic1, Generically(..), Generically1(..) )
+
 
 -- acts
 import Data.Act
@@ -29,7 +34,7 @@ import Control.DeepSeq
 
 -- groups
 import Data.Group
-  ( Group )
+  ( Group(..) )
 
 -- groups-generic
 import Data.Group.Generics
@@ -73,3 +78,20 @@ data Segment p =
   deriving Applicative
     via Generically1 Segment
   deriving anyclass ( NFData, NFData1 )
+
+
+-- TODO: move the following to the groups or groups-generic package.
+ginvert :: forall g. ( Generic g, Group ( Rep g () ) ) => g -> g
+ginvert = to . invert @( Rep g () ) . from
+
+gpow :: forall n g. ( Integral n, Generic g, Group ( Rep g () ) ) => g -> n -> g
+gpow x n = to ( pow @( Rep g () ) ( from x ) n )
+
+instance
+  ( Generic g
+  , Monoid ( Generically g )
+  , Group  ( Rep g () )
+  )
+  => Group ( Generically g ) where
+  invert (Generically x) = Generically (ginvert x)
+  pow (Generically x) n = Generically (gpow x n)