fix: add explicit delete cancel and clean up cell controls

frontend/dist/index.html

@@ -208,8 +208,9 @@
         min-width: 34px;
         height: 34px;
         min-height: 34px;
-        display: inline-grid;
-        place-items: center;
+        display: inline-flex;
+        align-items: center;
+        justify-content: center;
         padding: 0;
         border-radius: 7px;
         line-height: 1;
@@ -615,6 +616,9 @@
       .rt-drag-handle {
         width: 28px;
         min-height: 24px;
+        display: inline-flex;
+        align-items: center;
+        justify-content: center;
         padding: 0;
         cursor: grab;
         color: oklch(0.5 0.01 260);
@@ -626,13 +630,20 @@
         height: 15px;
       }
 
+      .rt-drag-handle .rt-icon circle {
+        fill: currentColor;
+        stroke: none;
+      }
+
       .rt-cell-grip,
       .rt-cell-select {
         width: 28px;
         min-width: 28px;
+        height: 28px;
         min-height: 24px;
-        display: inline-grid;
-        place-items: center;
+        display: inline-flex;
+        align-items: center;
+        justify-content: center;
         padding: 0;
         line-height: 1;
       }
@@ -650,8 +661,17 @@
       }
 
       .rt-cell-select {
+        appearance: auto;
+        width: 16px;
+        min-width: 16px;
+        height: 16px;
+        min-height: 16px;
+        margin: 0 6px;
+        padding: 0;
+        border-radius: 50%;
         color: oklch(0.68 0.03 200);
         background: transparent;
+        cursor: pointer;
       }
 
       .rt-drag-handle:active {
@@ -681,8 +701,9 @@
       }
 
       .rt-cell-add {
-        display: grid;
-        place-items: center;
+        display: flex;
+        align-items: center;
+        justify-content: center;
         border-style: dashed;
         color: oklch(0.6 0.01 260);
         background: transparent;

frontend/src/Riptide/App.purs

@@ -28,9 +28,17 @@ import Riptide.WebSocket as WebSocket
 import Web.Event.Event as Event
 import Web.HTML.Event.DragEvent (DragEvent)
 import Web.HTML.Event.DragEvent as DragEvent
+import Web.UIEvent.KeyboardEvent (KeyboardEvent)
+import Web.UIEvent.KeyboardEvent as KeyboardEvent
+import Web.UIEvent.MouseEvent (MouseEvent)
+import Web.UIEvent.MouseEvent as MouseEvent
 
 data Action
   = Initialize
+  | CancelConfirm
+  | CancelConfirmClick MouseEvent
+  | ConfirmTimeout H.SubscriptionId String Int
+  | ShellKeyDown KeyboardEvent
   | GoSong
   | GoDefs
   | ToggleEngine
@@ -50,24 +58,24 @@ data Action
   | RenameToolbox ToolboxId String
   | DuplicateSong SongId
   | DuplicateToolbox ToolboxId
-  | DeleteSong SongId
-  | DeleteToolbox ToolboxId
+  | DeleteSong SongId MouseEvent
+  | DeleteToolbox ToolboxId MouseEvent
   | AddBlock
   | RenameBlock BlockId String
   | EditBlockCode BlockId String
   | ApplyBlock BlockId
   | ApplyAll
-  | DeleteBlock BlockId
+  | DeleteBlock BlockId MouseEvent
   | RenameTrack TrackId String
   | SetCtrl TrackId ControlKey String
   | StopTrack TrackId
   | AddTrack
-  | DeleteTrack TrackId
+  | DeleteTrack TrackId MouseEvent
   | AddCell TrackId
   | SelectCell TrackId CellId
   | ToggleCell TrackId CellId
   | EditCode TrackId CellId String
-  | DeleteCell TrackId CellId
+  | DeleteCell TrackId CellId MouseEvent
   | StartEdit String String
   | StopEdit
   | FocusCell CellId
@@ -115,6 +123,8 @@ shellActions =
   , importSong: ImportSong
   , exportToolbox: ExportToolbox
   , importToolbox: ImportToolbox
+  , cancelConfirm: CancelConfirm
+  , keyDown: ShellKeyDown
   }
 
 songActions :: Song.SongActions Action
@@ -124,6 +134,7 @@ songActions =
   , renameSong: RenameSong
   , duplicateSong: DuplicateSong
   , deleteSong: DeleteSong
+  , cancelConfirm: CancelConfirmClick
   , renameTrack: RenameTrack
   , setCtrl: SetCtrl
   , stopTrack: StopTrack
@@ -160,6 +171,7 @@ definitionsActions =
   , renameToolbox: RenameToolbox
   , duplicateToolbox: DuplicateToolbox
   , deleteToolbox: DeleteToolbox
+  , cancelConfirm: CancelConfirmClick
   , addBlock: AddBlock
   , renameBlock: RenameBlock
   , editBlockCode: EditBlockCode
@@ -177,6 +189,22 @@ handleAction = case _ of
     H.modify_ (Reducer.setConnection Connecting)
     subscribeWebSocket
     when app.playing startPlayhead
+  CancelConfirm ->
+    H.modify_ Reducer.cancelConfirm
+  CancelConfirmClick event -> do
+    stopMouseEvent event
+    H.modify_ Reducer.cancelConfirm
+  ConfirmTimeout subscriptionId key token -> do
+    H.unsubscribe subscriptionId
+    H.modify_ \app ->
+      if app.confirm == Just key && app.confirmToken == token then
+        Reducer.cancelConfirm app
+      else
+        app
+  ShellKeyDown event ->
+    when (KeyboardEvent.key event == "Escape") do
+      H.liftEffect (Event.preventDefault (KeyboardEvent.toEvent event))
+      H.modify_ Reducer.cancelConfirm
   GoSong ->
     H.modify_ \app ->
       case app.currentSongId of
@@ -291,10 +319,10 @@ handleAction = case _ of
         H.modify_ (Reducer.duplicateToolbox toolboxId { toolboxId: newToolboxId, blockIds })
       Nothing ->
         pure unit
-  DeleteSong songId ->
-    H.modify_ (Reducer.deleteSong songId)
-  DeleteToolbox toolboxId ->
-    H.modify_ (Reducer.deleteToolbox toolboxId)
+  DeleteSong songId event ->
+    applyDelete event (Reducer.deleteSong songId)
+  DeleteToolbox toolboxId event ->
+    applyDelete event (Reducer.deleteToolbox toolboxId)
   AddBlock -> do
     blockId <- H.liftEffect (mintId "b")
     H.modify_ (Reducer.addBlock blockId)
@@ -322,8 +350,8 @@ handleAction = case _ of
     H.modify_ Reducer.applyAll
     app <- H.get
     traverse_ sendDefinitionAndApply (currentBlocks app)
-  DeleteBlock blockId ->
-    H.modify_ (Reducer.deleteBlock blockId)
+  DeleteBlock blockId event ->
+    applyDelete event (Reducer.deleteBlock blockId)
   RenameTrack trackId name ->
     H.modify_ (Reducer.renameTrack trackId name)
   SetCtrl trackId key raw ->
@@ -338,8 +366,8 @@ handleAction = case _ of
   AddTrack -> do
     trackId <- H.liftEffect (mintId "t")
     H.modify_ (Reducer.addTrack trackId)
-  DeleteTrack trackId ->
-    H.modify_ (Reducer.removeTrack trackId)
+  DeleteTrack trackId event ->
+    applyDelete event (Reducer.removeTrack trackId)
   AddCell trackId -> do
     cellId <- H.liftEffect (mintId "c")
     H.modify_ (Reducer.addCell trackId cellId)
@@ -357,8 +385,8 @@ handleAction = case _ of
     H.modify_ (Reducer.editCode trackId cellId code)
     sendWhenConnected (Protocol.SaveTrackText trackId cellId code)
     sendWhenConnected (Protocol.ValidateText code)
-  DeleteCell trackId cellId ->
-    H.modify_ (Reducer.removeCell trackId cellId)
+  DeleteCell trackId cellId event ->
+    applyDelete event (Reducer.removeCell trackId cellId)
   StartEdit kind id ->
     H.modify_ (Reducer.startEdit kind id)
   StopEdit ->
@@ -594,6 +622,29 @@ sendDefinitionAndApply block = do
   sendWhenConnected (Protocol.SaveDefinition block.id block.name block.code)
   sendWhenConnected (Protocol.ApplyDefinition block.id)
 
+applyDelete :: forall output m. MonadAff m => MouseEvent -> (App -> App) -> H.HalogenM App Action () output m Unit
+applyDelete event reducer = do
+  stopMouseEvent event
+  before <- H.get
+  let
+    after = reducer before
+  H.put after
+  scheduleConfirmTimeout before after
+
+scheduleConfirmTimeout :: forall output m. MonadAff m => App -> App -> H.HalogenM App Action () output m Unit
+scheduleConfirmTimeout before after =
+  case after.confirm of
+    Just key
+      | before.confirm /= after.confirm || before.confirmToken /= after.confirmToken ->
+          H.subscribe' \subscriptionId ->
+            Files.timeoutEmitter 2800 (ConfirmTimeout subscriptionId key after.confirmToken)
+    _ ->
+      pure unit
+
+stopMouseEvent :: forall output m. MonadAff m => MouseEvent -> H.HalogenM App Action () output m Unit
+stopMouseEvent event =
+  H.liftEffect (Event.stopPropagation (MouseEvent.toEvent event))
+
 fileName :: String -> String -> String
 fileName name kind =
   name <> ".riptide-" <> kind <> ".json"

frontend/src/Riptide/Model.purs

@@ -97,6 +97,7 @@ type App =
   , hoverCell :: Maybe CellId
   , focusCell :: Maybe CellId
   , confirm :: Maybe String
+  , confirmToken :: Int
   , editing :: Maybe EditingTarget
   , drag :: Maybe DragState
   , over :: Maybe DropTarget
@@ -187,6 +188,7 @@ defaultApp =
   , hoverCell: Nothing
   , focusCell: Nothing
   , confirm: Nothing
+  , confirmToken: 0
   , editing: Nothing
   , drag: Nothing
   , over: Nothing

frontend/src/Riptide/Reducer.purs

@@ -10,6 +10,7 @@ module Riptide.Reducer
   , deleteBlock
   , deleteSong
   , deleteToolbox
+  , cancelConfirm
   , duplicateSong
   , duplicateToolbox
   , editBlockCode
@@ -437,6 +438,10 @@ endResizeScore :: App -> App
 endResizeScore app =
   app { resizing = false }
 
+cancelConfirm :: App -> App
+cancelConfirm app =
+  app { confirm = Nothing }
+
 setPaint :: TrackId -> Int -> Boolean -> App -> App
 setPaint trackId bar value =
   mapTrack trackId \track ->
@@ -517,7 +522,7 @@ armDelete key action app =
   if app.confirm == Just key then
     (action app) { confirm = Nothing }
   else
-    app { confirm = Just key }
+    app { confirm = Just key, confirmToken = app.confirmToken + 1 }
 
 mapCurrentSongTracks :: (Track -> Track) -> App -> App
 mapCurrentSongTracks f =

frontend/src/Riptide/View/Definitions.purs

@@ -15,19 +15,21 @@ import Riptide.Model (App, Block, BlockId, EditingTarget, Toolbox, ToolboxId)
 import Riptide.Validation (ValidationResult, authoritativeValidation)
 import Riptide.View.Icons (Icon(..))
 import Riptide.View.Icons as Icons
+import Web.UIEvent.MouseEvent (MouseEvent)
 
 type DefinitionsActions action =
   { newToolbox :: action
   , openToolbox :: ToolboxId -> action
   , renameToolbox :: ToolboxId -> String -> action
   , duplicateToolbox :: ToolboxId -> action
-  , deleteToolbox :: ToolboxId -> action
+  , deleteToolbox :: ToolboxId -> MouseEvent -> action
+  , cancelConfirm :: MouseEvent -> action
   , addBlock :: action
   , renameBlock :: BlockId -> String -> action
   , editBlockCode :: BlockId -> String -> action
   , applyBlock :: BlockId -> action
   , applyAll :: action
-  , deleteBlock :: BlockId -> action
+  , deleteBlock :: BlockId -> MouseEvent -> action
   , startEdit :: String -> String -> action
   , stopEdit :: action
   }
@@ -81,13 +83,13 @@ toolboxRow actions app toolbox =
           , HH.small_ [ HH.text (toolboxMeta app toolbox) ]
           ]
       , HH.div [ HP.classes [ HH.ClassName "rt-row-actions" ] ]
+          (
           [ Icons.iconButton "Open toolbox" Eye (actions.openToolbox toolbox.id)
           , Icons.iconButton "Rename toolbox" Edit (actions.startEdit "tbx" toolbox.id)
           , Icons.iconButton "Duplicate toolbox" Copy (actions.duplicateToolbox toolbox.id)
-          , Icons.dangerButton (if confirming then "Confirm delete toolbox" else "Delete toolbox")
-              (if confirming then Check else Delete)
-              (actions.deleteToolbox toolbox.id)
           ]
+            <> confirmDeleteButtons "toolbox" confirming (actions.deleteToolbox toolbox.id) actions.cancelConfirm
+          )
       ]
 
 toolboxShell :: forall action slots m. DefinitionsActions action -> App -> Toolbox -> Array (HH.ComponentHTML action slots m)
@@ -142,11 +144,11 @@ blockCard actions app block =
           , HH.span [ HP.classes [ HH.ClassName "rt-badge" ] ] [ HH.text (show impact.count <> " live uses") ]
           ]
       , HH.div [ HP.classes [ HH.ClassName "rt-block-actions" ] ]
+          (
           [ Icons.iconButtonDisabled "Apply definition" Check (not canApply) (actions.applyBlock block.id)
-          , Icons.dangerButton (if confirming then "Confirm delete block" else "Delete block")
-              (if confirming then Check else Delete)
-              (actions.deleteBlock block.id)
           ]
+            <> confirmDeleteButtons "block" confirming (actions.deleteBlock block.id) actions.cancelConfirm
+          )
       , case result.error of
           Just err ->
             HH.div [ HP.classes [ HH.ClassName "rt-block-error" ] ] [ HH.text err ]
@@ -180,6 +182,21 @@ cascadeEntry entry =
     , HH.code_ [ HH.text entry.code ]
     ]
 
+confirmDeleteButtons
+  :: forall action slots m
+   . String
+  -> Boolean
+  -> (MouseEvent -> action)
+  -> (MouseEvent -> action)
+  -> Array (HH.ComponentHTML action slots m)
+confirmDeleteButtons label confirming confirmAction cancelAction =
+  if confirming then
+    [ Icons.dangerButton ("Confirm delete " <> label) Check confirmAction
+    , Icons.cancelButton ("Cancel delete " <> label) cancelAction
+    ]
+  else
+    [ Icons.dangerButton ("Delete " <> label) Delete confirmAction ]
+
 currentToolbox :: App -> Maybe Toolbox
 currentToolbox app =
   case app.currentToolboxId of