cleanups

MetaBrush.cabal

@@ -135,7 +135,7 @@ common extras
       , stm
           ^>= 2.5.0.0
       , text
-          ^>= 2.1.1
+           >= 2.0        && < 3
       , unordered-containers
            >= 0.2.11     && < 0.3
       , waargonaut
@@ -151,7 +151,7 @@ common gtk
       , gi-gdk
            >= 4.0.2      && < 4.1
       , gi-gio
-           >= 2.0.27     && < 2.1
+           >= 2.0.34     && < 2.1
       , gi-glib
            >= 2.0.23     && < 2.1
       , gi-gobject

brush-strokes/src/lib/Math/Differentiable.hs

@@ -38,11 +38,13 @@ class
   ( Module ( I i Double ) ( T ( I i u ) )
   , HasChainRule ( I i Double ) k ( I i u )
   , Traversable ( D k u )
+  , Representable ( I i Double ) ( I i u )
   ) => Differentiable k i u
 instance
   ( Module ( I i Double ) ( T ( I i u ) )
   , HasChainRule ( I i Double ) k ( I i u )
   , Traversable ( D k u )
+  , Representable ( I i Double ) ( I i u )
   ) => Differentiable k i u
 
 type DiffInterp :: Nat -> k -> Nat -> Constraint
@@ -55,7 +57,6 @@ class
   , Transcendental ( D k u ( I i Double ) )
   , Applicative ( D k u )
   , Representable ( I i Double ) ( I i u )
-  , RepDim ( I i u ) ~ RepDim u
   ) => DiffInterp k i u
 instance
   ( Differentiable k i u
@@ -66,5 +67,4 @@ instance
   , Transcendental ( D k u ( I i Double ) )
   , Applicative ( D k u )
   , Representable ( I i Double ) ( I i u )
-  , RepDim ( I i u ) ~ RepDim u
   ) => DiffInterp k i u

src/app/MetaBrush/Document/Selection.hs

@@ -120,7 +120,7 @@ import MetaBrush.Document
 import {-# SOURCE #-} MetaBrush.Document.Update
   ( DocChange(..) )
 import MetaBrush.Records
-  ( Record
+  ( Record(..)
   , Intersection(..), intersect
   )
 import MetaBrush.Unique
@@ -890,7 +890,7 @@ applyBrushWidgetAction pressingCtrl c mbPrevAction doc@( Document { zoomFactor }
           | otherwise
           -> case intersect @pointFields @brushFields of
                Intersection { inject1 = injectUsedParams, inject2 = updateBrushParams, project1 = ptParamsToUsedParams, project2 = brushParamsToUsedParams } -> do
-                let embedUsedParams = updateBrushParams ( defaultParams $ brushFunction brush )
+                let embedUsedParams = updateBrushParams ( MkR $ defaultParams $ brushFunction brush )
                     toBrushParams = embedUsedParams . ptParamsToUsedParams
                     updatePointParams brushParams' ptParams = injectUsedParams ptParams ( brushParamsToUsedParams brushParams' )
                 spline' <- updateSpline brush toBrushParams updatePointParams strokeUnique spline0

src/app/MetaBrush/Render/Document.hs

@@ -11,6 +11,8 @@ import Control.Monad
   ( guard, when, unless )
 import Control.Monad.ST
   ( RealWorld, ST )
+import Data.Coerce
+  ( coerce )
 import Data.Fixed
   ( mod' )
 import Data.Foldable
@@ -319,12 +321,12 @@ strokeRenderData rootAlgo mbCuspOptions fitParams
                  { inject2
                  , project1 = toUsedParams :: Record pointFields -> Record usedFields }
                  -> do
-                    let embedUsedParams = inject2 brush_defaults
+                    let embedUsedParams = inject2 $ MkR brush_defaults
 
                   -- Compute the outline using the brush function.
                     ( outline, fitPts, cusps ) <-
                       computeStrokeOutline @clo rootAlgo mbCuspOptions fitParams
-                        ( toUsedParams . brushParams ) embedUsedParams
+                        ( coerce toUsedParams . brushParams ) ( coerce embedUsedParams )
                         brush spline
                     pure $
                       StrokeWithOutlineRenderData
@@ -332,7 +334,7 @@ strokeRenderData rootAlgo mbCuspOptions fitParams
                         , strokeOutlineData   = ( outline, fitPts, cusps )
                         , strokeBrushFunction =
                             \ params ->
-                            let brushParams = embedUsedParams $ toUsedParams params
+                            let MkR brushParams = embedUsedParams $ toUsedParams params
                                 shape = fun @Double brushBaseShape brushParams
                                 -- TODO: remove this logic which is duplicated
                                 -- from elsewhere. The type should make it

src/metabrushes/MetaBrush/Asset/Brushes.hs

@@ -41,8 +41,6 @@ import MetaBrush.Brush
   ( NamedBrush(..), SomeBrush(..), WithParams(..) )
 import qualified MetaBrush.Brush.Widget as Brush
   ( Widget(..) )
-import MetaBrush.Records
-  ( Record(MkR) )
 
 --------------------------------------------------------------------------------
 
@@ -69,8 +67,7 @@ circle =
     , brushWidget   = Brush.SquareWidget
     }
   where
-    deflts :: Record CircleBrushFields
+    deflts = ℝ1 1
-    deflts = MkR ( ℝ1 1 )
 {-# INLINE circle #-}
 
 type EllipseBrushFields = '[ "a", "b", "phi" ]
@@ -84,8 +81,7 @@ ellipse =
     , brushWidget   = Brush.RotatableRectangleWidget
     }
   where
-    deflts :: Record EllipseBrushFields
+    deflts = ℝ3 1 1 0
-    deflts = MkR ( ℝ3 1 1 0 )
 {-# INLINE ellipse #-}
 
 type TearDropBrushFields = '[ "w", "h", "phi" ]
@@ -98,6 +94,5 @@ tearDrop =
     , brushWidget   = Brush.RotatableRectangleWidget
     }
   where
-    deflts :: Record TearDropBrushFields
+    deflts = ℝ3 1 2.25 0
-    deflts = MkR ( ℝ3 1 2.25 0 )
 {-# INLINE tearDrop #-}

src/metabrushes/MetaBrush/Brush.hs

@@ -24,6 +24,8 @@ import GHC.TypeLits
   ( Symbol, someSymbolVal
   , SomeSymbol(..)
   )
+import GHC.TypeNats
+  ( Nat )
 
 -- deepseq
 import Control.DeepSeq
@@ -59,11 +61,11 @@ import MetaBrush.Serialisable
 --------------------------------------------------------------------------------
 
 -- | A brush, with default parameter values.
-type WithParams :: Type -> Type
+type WithParams :: Nat -> Type
-data WithParams params =
+data WithParams nbParams =
   WithParams
-    { defaultParams :: params
+    { defaultParams :: ℝ nbParams
-    , withParams :: Brush params
+    , withParams :: Brush nbParams
     }
 
 --------------------------------------------------------------------------------
@@ -71,7 +73,7 @@ data WithParams params =
 -- | A brush function: a function from a record of parameters to a closed spline.
 type BrushFunction :: [ Symbol ] -> Type
 type BrushFunction brushFields =
-  WithParams ( Record brushFields )
+  WithParams ( Length brushFields )
 
 type NamedBrush :: [ Symbol ] -> Type
 data NamedBrush brushFields where
@@ -79,8 +81,9 @@ data NamedBrush brushFields where
     :: forall brushFields
     .  ( KnownSymbols brushFields
        , Representable Double ( ℝ ( Length brushFields ) )
-       , DiffInterp 2 () ( ℝ ( Length brushFields ) )
+       , DiffInterp 2 ℝ ( Length brushFields )
-       , DiffInterp 3 𝕀  ( ℝ ( Length brushFields ) )
+       , DiffInterp 3 𝕀 ( Length brushFields )
+       , Show ( ℝ ( Length brushFields ) )
        )
     => { brushName     :: !Text
        , brushFunction :: !( BrushFunction brushFields )
@@ -118,19 +121,23 @@ type PointFields :: [ Symbol ] -> Constraint
 class ( KnownSymbols pointFields, Typeable pointFields
       , Serialisable   ( Record pointFields )
       , Show           ( Record pointFields )
+      , Show           ( ℝ ( Length pointFields ) )
       , NFData         ( Record pointFields )
       , Representable  Double   ( ℝ ( Length pointFields ) )
-      , DiffInterp 2 () ( ℝ ( Length pointFields ) )
+      , RepDim ( ℝ ( Length pointFields ) ) ~ Length pointFields
-      , DiffInterp 3 𝕀  ( ℝ ( Length pointFields ) )
+      , DiffInterp 2 ℝ  ( Length pointFields )
+      , DiffInterp 3 𝕀  ( Length pointFields )
       )
    => PointFields pointFields where { }
 instance ( KnownSymbols pointFields, Typeable pointFields
          , Serialisable   ( Record pointFields )
          , Show           ( Record pointFields )
+         , Show           ( ℝ ( Length pointFields ) )
          , NFData         ( Record pointFields )
          , Representable  Double   ( ℝ ( Length pointFields ) )
-         , DiffInterp 2 () ( ℝ ( Length pointFields ) )
+         , RepDim ( ℝ ( Length pointFields ) ) ~ Length pointFields
-         , DiffInterp 3 𝕀  ( ℝ ( Length pointFields ) )
+         , DiffInterp 2 ℝ ( Length pointFields )
+         , DiffInterp 3 𝕀 ( Length pointFields )
          )
       => PointFields pointFields where { }
 

src/metabrushes/MetaBrush/Records.hs

@@ -48,7 +48,6 @@ import qualified Data.Text as Text
   ( pack, unpack )
 
 -- MetaBrush
-import Math.Algebra.Dual
 import Math.Differentiable
 import Math.Interval
 import Math.Linear
@@ -99,19 +98,6 @@ deriving via ( T ( ℝ ( Length ks ) ) )
   instance Module Double ( T ( ℝ ( Length ks ) ) )
         => Module Double ( T ( Record ks ) )
 
-deriving via ( T ( 𝕀ℝ ( Length ks ) ) )
-  instance Semigroup ( T ( 𝕀ℝ ( Length ks ) ) )
-        => Semigroup ( T ( 𝕀 ( Record ks ) ) )
-deriving via ( T ( 𝕀ℝ ( Length ks ) ) )
-  instance Monoid    ( T ( 𝕀ℝ ( Length ks ) ) )
-        => Monoid    ( T ( 𝕀 ( Record ks ) ) )
-deriving via ( T ( 𝕀ℝ ( Length ks ) ) )
-  instance Group     ( T ( 𝕀ℝ ( Length ks ) ) )
-        => Group     ( T ( 𝕀 ( Record ks ) ) )
-deriving via ( T ( 𝕀ℝ ( Length ks ) ) )
-  instance Module ( 𝕀 Double ) ( T ( 𝕀ℝ ( Length ks ) ) )
-        => Module ( 𝕀 Double ) ( T ( 𝕀 ( Record ks ) ) )
-
 instance ( Act       ( T ( ℝ ( Length ks ) ) ) ( ℝ ( Length ks ) )
          , Semigroup ( T ( ℝ ( Length ks ) ) ) )
         => Act ( T ( Record ks ) ) ( Record ks ) where
@@ -121,39 +107,11 @@ instance ( Torsor ( T ( ℝ ( Length ks ) ) ) ( ℝ ( Length ks ) )
         => Torsor ( T ( Record ks ) ) ( Record ks ) where
   MkR g --> MkR a = T $ MkR $ unT $ g --> a
 
-instance ( Act       ( T ( 𝕀ℝ ( Length ks ) ) ) ( 𝕀ℝ ( Length ks ) )
-         , Semigroup ( T ( 𝕀ℝ ( Length ks ) ) ) )
-        => Act ( T ( 𝕀 ( Record ks ) ) ) ( 𝕀 ( Record ks ) ) where
-  T ( 𝕀 ( MkR g_lo ) ( MkR g_hi ) )
-    • 𝕀 ( MkR a_lo ) ( MkR a_hi )
-      = case T ( 𝕀 g_lo g_hi ) • 𝕀 a_lo a_hi of
-          𝕀 b_lo b_hi ->
-            𝕀 ( MkR b_lo ) ( MkR b_hi )
-instance ( Torsor ( T ( 𝕀ℝ ( Length ks ) ) ) ( 𝕀ℝ ( Length ks ) )
-         , Group  ( T ( 𝕀ℝ ( Length ks ) ) ) )
-        => Torsor ( T ( 𝕀 ( Record ks ) ) ) ( 𝕀 ( Record ks ) ) where
-  𝕀 ( MkR a_lo ) ( MkR a_hi )
-    --> 𝕀 ( MkR b_lo ) ( MkR b_hi )
-      = case 𝕀 a_lo a_hi --> 𝕀 b_lo b_hi of
-          T ( 𝕀 c_lo c_hi ) ->
-            T ( 𝕀 ( MkR c_lo ) ( MkR c_hi ) )
-
 type instance RepDim ( Record ks ) = Length ks
 deriving newtype instance ( KnownNat (Length ks)
                           , Representable r ( ℝ ( Length ks ) ) )
                        => Representable r ( Record ks )
 
-type instance D k ( Record ks ) = D k ( ℝ ( Length ks ) )
-deriving newtype instance HasChainRule Double 2 ( ℝ ( Length ks ) )
-                       => HasChainRule Double 2 ( Record ks )
-
-deriving via 𝕀ℝ ( Length ks )
-  instance HasChainRule ( 𝕀 Double ) 2 ( 𝕀ℝ ( Length ks ) )
-        => HasChainRule ( 𝕀 Double ) 2 ( 𝕀 ( Record ks ) )
-deriving via 𝕀ℝ ( Length ks )
-  instance HasChainRule ( 𝕀 Double ) 3 ( 𝕀ℝ ( Length ks ) )
-        => HasChainRule ( 𝕀 Double ) 3 ( 𝕀 ( Record ks ) )
-
 --------------------------------------------------------------------------------
 
 type Length :: [ k ] -> Nat
@@ -180,8 +138,10 @@ intersect :: forall r1 r2 l1 l2
             , l1 ~ Length r1, l2 ~ Length r2
             , Representable Double ( ℝ l1 )
             , Representable Double ( ℝ l2 )
-            , Differentiable 2 () ( ℝ l2 )
+            , Show ( ℝ l1 )
-            , Differentiable 3 𝕀  ( ℝ l2 )
+            , Show ( ℝ l2 )
+            , Differentiable 2 ℝ l2
+            , Differentiable 3 𝕀 l2
             )
           => Intersection r1 r2
 intersect
@@ -211,8 +171,9 @@ data Intersection r1 r2 where
     .  ( l12 ~ Length r1r2
        , KnownSymbols r1r2
        , Representable Double ( ℝ l12 )
-       , Differentiable 2 () ( ℝ l12 )
+       , Show ( ℝ l12 )
-       , Differentiable 3 𝕀  ( ℝ l12 )
+       , Differentiable 2 ℝ l12
+       , Differentiable 3 𝕀 l12
        )
     => { project1 :: Record r1 -> Record r1r2
           -- ^ project out fields present in both rows
@@ -237,9 +198,10 @@ doIntersection
   => ( forall r1r2 l12.
         ( r1r2 ~ Intersect r1 r2
         , KnownSymbols r1r2, l12 ~ Length r1r2
-        , Differentiable 2 () ( ℝ l12 )
+        , Differentiable 2 ℝ l12
-        , Differentiable 3 𝕀  ( ℝ l12 )
+        , Differentiable 3 𝕀  l12
         , Representable Double ( ℝ l12 )
+        , Show ( ℝ l12 )
         )
       => Proxy# r1r2 -> Vec l12 ( Fin l1 ) -> Vec l12 ( Fin l2 ) -> kont )
   -> kont