diff --git a/MetaBrush.cabal b/MetaBrush.cabal index 00faba1..c268b4f 100644 --- a/MetaBrush.cabal +++ b/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 diff --git a/cabal.project b/cabal.project index cdf15cc..cdc3908 100644 --- a/cabal.project +++ b/cabal.project @@ -4,45 +4,46 @@ constraints: acts -finitary allow-newer: - waargonaut:* + waargonaut:*, + *:haskell-gi-base, *:haskell-gi, - --- 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 +-- various fixes for '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 - tag: dc835fb86d2592fa2e55753fa4eb7c59d6124699 + location: https://github.com/sheaf/generic-lens + 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 - tag: a9023c764a08beedbb1b8ca20bc39103f26529c5 - --- patch to superrecord with API improvements + location: https://github.com/haskell-gi/haskell-gi + tag: cc6c25a32288ceef79585e8bba5f197065fb477c + subdir: . source-repository-package type: git - location: https://github.com/sheaf/superrecord - tag: 4cecac06afaa3fb60e67cdb273e36eed3f04335d + location: https://github.com/haskell-gi/haskell-gi + tag: cc6c25a32288ceef79585e8bba5f197065fb477c + subdir: base -constraints: - -- fix for Haskell GI GValue bug - haskell-gi >= 0.24.5 +-- superrecord API improvements +source-repository-package + type: git + location: https://github.com/agrafix/superrecord + tag: f1c8cf87fd25243e715fd9585e595a90fff34050 diff --git a/src/app/MetaBrush/Assert.hs b/src/app/MetaBrush/Assert.hs index f059e2d..1a05d1e 100644 --- a/src/app/MetaBrush/Assert.hs +++ b/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 ) diff --git a/src/app/MetaBrush/Document/Serialise.hs b/src/app/MetaBrush/Document/Serialise.hs index 6edf25d..8ce5066 100644 --- a/src/app/MetaBrush/Document/Serialise.hs +++ b/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 diff --git a/src/app/MetaBrush/MetaParameter/Driver.hs b/src/app/MetaBrush/MetaParameter/Driver.hs index f6be7ce..18e29a8 100644 --- a/src/app/MetaBrush/MetaParameter/Driver.hs +++ b/src/app/MetaBrush/MetaParameter/Driver.hs @@ -1,11 +1,16 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# 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 diff --git a/src/app/MetaBrush/UI/FileBar.hs b/src/app/MetaBrush/UI/FileBar.hs index 7b88fc8..a1413c1 100644 --- a/src/app/MetaBrush/UI/FileBar.hs +++ b/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 - GTK.containerChildGetProperty fileTabsBox activeTab "position" gValue - ( GI.get_int gValue <&> ( +1 ) ) >>= GI.set_int gValue - GTK.containerChildSetProperty fileTabsBox tab "position" gValue + old_gValue <- GI.newGValue GI.gtypeInt + GTK.containerChildGetProperty fileTabsBox activeTab "position" old_gValue + new_gValue <- GI.toGValue @Int32 =<< ( +1 ) <$> GI.fromGValue @Int32 old_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 diff --git a/src/lib/Math/Bezier/Spline.hs b/src/lib/Math/Bezier/Spline.hs index 957aa64..dc47c26 100644 --- a/src/lib/Math/Bezier/Spline.hs +++ b/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' ) diff --git a/src/lib/Math/Bezier/Stroke.hs b/src/lib/Math/Bezier/Stroke.hs index b063fbc..81a78c3 100644 --- a/src/lib/Math/Bezier/Stroke.hs +++ b/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 diff --git a/src/lib/Math/Linear/Solve.hs b/src/lib/Math/Linear/Solve.hs index 0eee033..f6f2034 100644 --- a/src/lib/Math/Linear/Solve.hs +++ b/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] )