hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

GHC 9.0 compatibility

Browse source
This commit is contained in:
sheaf 2021-02-23 13:14:32 +01:00
parent ab3a12c983
commit b32499cc68
9 changed files with 109 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
MetaBrush.cabal
View file

@ -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

49
cabal.project
View file

@ -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

1
src/app/MetaBrush/Assert.hs
View file

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

2
src/app/MetaBrush/Document/Serialise.hs
View file

@ -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

50
src/app/MetaBrush/MetaParameter/Driver.hs
View file

@ -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

12
src/app/MetaBrush/UI/FileBar.hs
View file

@ -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

7
src/lib/Math/Bezier/Spline.hs
View file

@ -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' )

1
src/lib/Math/Bezier/Stroke.hs
View file

@ -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

4
src/lib/Math/Linear/Solve.hs
View file

@ -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] )