use Seq for strokes

src/app/MetaBrush/Application.hs

@@ -174,22 +174,24 @@ runApplication application = do
     testDocuments = fmap newHistory $ uniqueMapFromList
       [ emptyDocument "Test" docUnique
       & ( field' @"documentContent" . field' @"strokes" ) .~
-        [ Stroke
+        ( Seq.fromList
-          { strokeName    = "Stroke 1"
+          [ Stroke
-          , strokeVisible = True
+            { strokeName    = "Stroke 1"
-          , strokeUnique  = strokeUnique
+            , strokeVisible = True
-          , strokeBrush   = Just $ adaptBrush @'[ "r" SuperRecord.:= Double ] circleBrush
+            , strokeUnique  = strokeUnique
-          , strokeSpline  =
+            , strokeBrush   = Just $ adaptBrush @'[ "r" SuperRecord.:= Double ] circleBrush
-            Spline
+            , strokeSpline  =
-              { splineStart  = mkPoint ( Point2D 10 -20 ) 2
+              Spline
-              , splineCurves = OpenCurves $ Seq.fromList
+                { splineStart  = mkPoint ( Point2D 10 -20 ) 2
-                [ LineTo { curveEnd = NextPoint ( mkPoint ( Point2D  10  10 ) 5 ), curveData = invalidateCache undefined }
+                , splineCurves = OpenCurves $ Seq.fromList
-                , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10  10 ) 5 ), curveData = invalidateCache undefined }
+                  [ LineTo { curveEnd = NextPoint ( mkPoint ( Point2D  10  10 ) 5 ), curveData = invalidateCache undefined }
-                , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10 -20 ) 2 ), curveData = invalidateCache undefined }
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10  10 ) 5 ), curveData = invalidateCache undefined }
-                ]
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10 -20 ) 2 ), curveData = invalidateCache undefined }
-              }
+                  ]
-          }
+                }
-        ]
+            }
+          ]
+        )
       ]
         where
           mkPoint :: Point2D Double -> Double -> PointData ( Super.Rec '[ "r" SuperRecord.:= Double ] )

src/app/MetaBrush/Document.hs

@@ -56,6 +56,10 @@ import Data.Map.Strict
   ( Map )
 import qualified Data.Map.Strict as Map
   ( empty, insert )
+import Data.Sequence
+  ( Seq )
+import qualified Data.Sequence as Seq
+  ( empty )
 
 -- deepseq
 import Control.DeepSeq
@@ -154,7 +158,7 @@ data DocumentContent
   { unsavedChanges :: !Bool
   , latestChange   :: !Text
   , guides         :: !( Map Unique Guide )
-  , strokes        :: ![ Stroke ]
+  , strokes        :: !( Seq Stroke )
   }
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
@@ -262,7 +266,7 @@ emptyDocument docName unique =
       Content
       { unsavedChanges = False
       , latestChange   = "New document"
-      , strokes        = []
+      , strokes        = Seq.empty
       , guides         = Map.empty
       }
     }

src/app/MetaBrush/Document/Draw.hs

@@ -18,8 +18,6 @@ module MetaBrush.Document.Draw
 -- base
 import Data.Functor
   ( ($>) )
-import Data.Maybe
-  ( listToMaybe )
 
 -- acts
 import Data.Act
@@ -28,6 +26,8 @@ import Data.Act
 -- containers
 import Data.Sequence
   ( Seq(..) )
+import qualified Data.Sequence as Seq
+  ( filter, lookup )
 
 -- deepseq
 import Control.DeepSeq
@@ -144,7 +144,7 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
         newDoc' :: Document
         newDoc'
           = over ( field' @"documentContent" . field' @"strokes" )
-              ( newStroke : )
+              ( newStroke :<| )
               newDoc
       pure ( newDoc', AnchorAtEnd uniq, c, Nothing )
   where
@@ -244,7 +244,7 @@ withAnchorBrushData
      )
   -> r
 withAnchorBrushData anchor ( Document { documentContent = Content { strokes } } ) f =
-  splineAnchor . listToMaybe $ filter ( \ Stroke { strokeUnique } -> strokeUnique == anchorStrokeUnique anchor ) strokes
+  splineAnchor . Seq.lookup 0 $ Seq.filter ( \ Stroke { strokeUnique } -> strokeUnique == anchorStrokeUnique anchor ) strokes
   where
     splineAnchor :: Maybe Stroke -> r
     splineAnchor ( Just ( Stroke { strokeSpline = strokeSpline :: StrokeSpline clo pointData, strokeBrush } ) )

src/app/MetaBrush/Document/Selection.hs

@@ -128,6 +128,8 @@ import MetaBrush.MetaParameter.Interpolation
   ( Interpolatable(Diff) )
 import MetaBrush.Unique
   ( Unique )
+import MetaBrush.Util
+  ( traverseMaybe )
 
 --------------------------------------------------------------------------------
 
@@ -504,7 +506,7 @@ deleteSelected :: Document -> ( Document, UpdateInfo )
 deleteSelected doc =
   ( `runState` mempty ) $
     ( field' @"documentContent" . field' @"strokes" )
-      ( fmap catMaybes . traverse updateStroke )
+      ( traverseMaybe updateStroke )
       doc
 
   where

src/app/MetaBrush/Document/Serialise.hs

@@ -713,8 +713,8 @@ decodeGuide uniqueSupply = do
 
 encodeDocumentContent :: Applicative f => JSON.Encoder f DocumentContent
 encodeDocumentContent  = JSON.Encoder.mapLikeObj \ ( Content { guides, strokes } ) ->
-    JSON.Encoder.atKey' "guides"  ( encodeUniqueMap   encodeGuide  ) guides
+    JSON.Encoder.atKey' "guides"  ( encodeUniqueMap encodeGuide  ) guides
-  . JSON.Encoder.atKey' "strokes" ( JSON.Encoder.list encodeStroke ) strokes
+  . JSON.Encoder.atKey' "strokes" ( encodeSequence  encodeStroke ) strokes
 
 decodeDocumentContent :: MonadIO m => UniqueSupply -> JSON.Decoder m DocumentContent
 decodeDocumentContent uniqueSupply = do
@@ -723,8 +723,8 @@ decodeDocumentContent uniqueSupply = do
     unsavedChanges = False
     latestChange :: Text
     latestChange = "Load document"
-  strokes <- JSON.Decoder.atKey "strokes" ( JSON.Decoder.list ( decodeStroke uniqueSupply ) )
+  strokes <- JSON.Decoder.atKey "strokes" ( decodeSequence  ( decodeStroke uniqueSupply ) )
-  guides  <- JSON.Decoder.atKey "guides"  ( decodeUniqueMap   ( decodeGuide  uniqueSupply ) )
+  guides  <- JSON.Decoder.atKey "guides"  ( decodeUniqueMap ( decodeGuide  uniqueSupply ) )
   pure ( Content { unsavedChanges, latestChange, strokes, guides } )
 
 

src/app/MetaBrush/Render/Document.hs

@@ -138,7 +138,7 @@ import MetaBrush.UI.ToolBar
 import MetaBrush.Unique
   ( unsafeUnique )
 import MetaBrush.Util
-  ( withRGBA )
+  ( traverseMaybe, withRGBA )
 
 --------------------------------------------------------------------------------
 
@@ -178,7 +178,7 @@ getDocumentRender
 
       let
         -- Get any modifications from in-flight user actions (e.g. in the middle of dragging something).
-        modifiedStrokes :: [ Stroke ]
+        modifiedStrokes :: Seq Stroke
         modifiedStrokes = case mode of
           PathMode
             | Just ( DragMoveHold { holdStartPos = p0, dragAction } ) <- mbHoldEvent
@@ -230,10 +230,10 @@ getDocumentRender
                       , strokeName     = "Preview stroke (temporary)"
                       , strokeBrush    = mbBrush
                       }
-              -> previewStroke : strokes content
+              -> previewStroke :<| strokes content
           _ -> strokes content
 
-      strokesRenderData <- sequenceA $ mapMaybe ( strokeRenderData fitParams ) modifiedStrokes
+      strokesRenderData <- traverseMaybe ( sequenceA . strokeRenderData fitParams ) modifiedStrokes
 
       let
         renderSelectionRect :: Cairo.Render ()

src/app/MetaBrush/Util.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BlockArguments      #-}
 {-# LANGUAGE ConstraintKinds     #-}
 {-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE MonoLocalBinds      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
@@ -9,6 +10,7 @@ module MetaBrush.Util
   ( withRGBA, showRGBA
   , widgetAddClasses, widgetAddClass
   , (>=?=>), (>>?=)
+  , traverseMaybe
   , Exists(..)
   )
   where
@@ -23,6 +25,10 @@ import Data.Foldable
 import GHC.Stack
   ( HasCallStack )
 
+-- containers
+import Data.Sequence
+  ( Seq(..) )
+
 -- gi-gdk
 import qualified GI.Gdk as GDK
 
@@ -73,5 +79,11 @@ infixl 1 >>?=
 
 --------------------------------------------------------------------------------
 
+traverseMaybe :: Applicative f => ( a -> f ( Maybe b ) ) -> Seq a -> f ( Seq b )
+traverseMaybe _ Empty        = pure Empty
+traverseMaybe f ( a :<| as ) = ( \ case { Nothing -> id; Just b -> ( b :<| ) } ) <$> f a <*> traverseMaybe f as
+
+--------------------------------------------------------------------------------
+
 data Exists c where
   Exists :: c a => a -> Exists c