quasar: Remove ListReplaceAll from the ListOperation

queezle42 · Jun 24, 2024 · 5e4e871 · 5e4e871
1 parent c9cfa40
commit 5e4e871
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 13 deletions.
diff --git a/quasar-web/src/Quasar/Web.hs b/quasar-web/src/Quasar/Web.hs
@@ -33,7 +33,7 @@ import Data.Text (Text)
 import Quasar.Disposer (TDisposer, isTrivialTDisposer, disposeTDisposer)
 import Quasar.Observable.AccumulatingObserver
 import Quasar.Observable.Core
-import Quasar.Observable.List (ListOperation(..), ObservableList, updateToOperations)
+import Quasar.Observable.List (ListOperation(..), ObservableList, deltaToOperations)
 import Quasar.Observable.List qualified as ObservableList
 import Quasar.Observable.Map (ObservableMap)
 import Quasar.Observable.Map qualified as ObservableMap
@@ -259,7 +259,7 @@ listChangeCommands ::
 listChangeCommands _ctx (ObservableChangeLiveReplace (ObservableResultTrivial xs)) =
   [ReplaceAllChildren (toList xs)]
 listChangeCommands ctx (ObservableChangeLiveDelta delta) =
-  toCommand <$> updateToOperations initialListLength (ObservableUpdateDelta delta)
+  toCommand <$> deltaToOperations initialListLength delta
   where
     initialListLength = case ctx of
       (ObserverContextLive (Just len)) -> len
@@ -268,7 +268,6 @@ listChangeCommands ctx (ObservableChangeLiveDelta delta) =
     toCommand (ListInsert pos value) = InsertChild (fromIntegral pos) value
     toCommand (ListAppend value) = AppendChild value
     toCommand (ListDelete pos) = RemoveChild (fromIntegral pos)
-    toCommand (ListReplaceAll new) = ReplaceAllChildren (toList new)
 
 
 -- | Create a DOM element that contains text.

diff --git a/quasar/src/Quasar/Observable/List.hs b/quasar/src/Quasar/Observable/List.hs
@@ -36,6 +36,7 @@ module Quasar.Observable.List (
   -- * List operations with absolute addressing
   ListOperation(..),
   updateToOperations,
+  deltaToOperations,
   operationsToUpdate,
 
   -- * ObservableListVar (mutable observable var)
@@ -446,12 +447,10 @@ data ListOperation v
   = ListInsert Length v -- ^ Insert before element n.
   | ListAppend v -- ^ Append at the end of the list.
   | ListDelete Length -- ^ Delete element with index n.
-  | ListReplaceAll (Seq v)
   deriving (Show, Eq, Ord)
 
-updateToOperations :: Length -> ObservableUpdate Seq v -> [ListOperation v]
-updateToOperations _initialLength (ObservableUpdateReplace new) = [ListReplaceAll new]
-updateToOperations initialLength (ObservableUpdateDelta (ListDelta initialOps)) =
+deltaToOperations :: Length -> ListDelta v -> [ListOperation v]
+deltaToOperations initialLength (ListDelta initialOps) =
   go 0 initialLength initialOps
   where
     go :: Length -> Length -> [ListDeltaOperation v] -> [ListOperation v]
@@ -469,6 +468,10 @@ updateToOperations initialLength (ObservableUpdateDelta (ListDelta initialOps))
       | count < remaining = replicate (fromIntegral count) (ListDelete offset) <> go offset (remaining - count) ops
       | otherwise = replicate (fromIntegral remaining) (ListDelete offset) <> go offset 0 ops
 
+updateToOperations :: Length -> ObservableUpdate Seq v -> Either (Seq v) [ListOperation v]
+updateToOperations _initialLength (ObservableUpdateReplace new) = Left new
+updateToOperations initialLength (ObservableUpdateDelta initialDelta) = Right (deltaToOperations initialLength initialDelta)
+
 
 operationsToUpdate :: Length -> [ListOperation v] -> Maybe (ObservableUpdate Seq v)
 operationsToUpdate _initialLength [] = Nothing
@@ -508,8 +511,6 @@ operationToValidatedUpdate len (ListDelete pos) =
             then FT.singleton (ListKeep pos)
             else FT.fromList [ListKeep pos, ListDrop 1, ListKeep (len - pos - 1)]
     else Left len
-operationToValidatedUpdate 0 (ListReplaceAll []) = Left 0
-operationToValidatedUpdate _len (ListReplaceAll new) = Right (ValidatedUpdateReplace new)
 
 
 data ConcatList canLoad exceptions v = Concat (ObservableList canLoad exceptions v) (ObservableList canLoad exceptions v)
@@ -582,7 +583,8 @@ lookupDeleteVar var@(ObservableListVar subject) pos = do
   pure r
 
 replaceVar :: (MonadSTMc NoRetry '[] m) => ObservableListVar v -> Seq v -> m ()
-replaceVar var new = applyOperationsVar var [ListReplaceAll new]
+replaceVar (ObservableListVar subject) new =
+  modifySubject subject \_ -> Just (ObservableUpdateReplace new)
 
 clearVar :: (MonadSTMc NoRetry '[] m) => ObservableListVar v -> m ()
 clearVar var = replaceVar var mempty
diff --git a/quasar/test/Quasar/Observable/ListSpec.hs b/quasar/test/Quasar/Observable/ListSpec.hs
@@ -225,9 +225,6 @@ spec = parallel do
     it "can replace" do
       operationsToUpdate @Text 4 [ListDelete 2, ListInsert 2 "a"] `shouldBe` Just (ObservableUpdateDelta (ListDelta [ListKeep 2, ListSplice ["a"], ListDrop 1, ListKeep 1]))
 
-    it "can replace all" do
-      operationsToUpdate @Text 4 [ListReplaceAll ["a"]] `shouldBe` Just (ObservableUpdateReplace ["a"])
-
 testUpdateDeltaContext :: HasCallStack => Seq Int -> ListDelta Int -> Maybe (ValidatedListDelta Int) -> IO ()
 testUpdateDeltaContext list delta expectedDelta = withFrozenCallStack do
   let