Undo for groups

frontend/src/Libs/List.elm

@@ -29,6 +29,7 @@ module Libs.List exposing
     , last
     , mapAt
     , mapAtCmd
+    , mapAtTL
     , mapBy
     , mapByCmd
     , mapByT
@@ -268,6 +269,21 @@ mapAt index f list =
             )
 
 
+mapAtTL : Int -> (a -> ( a, List t )) -> List a -> ( List a, List t )
+mapAtTL index f list =
+    list
+        |> List.indexedMap
+            (\i a ->
+                if index == i then
+                    f a
+
+                else
+                    ( a, [] )
+            )
+        |> List.unzip
+        |> Tuple.mapSecond List.concat
+
+
 mapAtCmd : Int -> (a -> ( a, Cmd msg )) -> List a -> ( List a, Cmd msg )
 mapAtCmd index f list =
     list

frontend/src/PagesComponents/Organization_/Project_/Models.elm

@@ -28,6 +28,7 @@ import Models.Project.ColumnPath exposing (ColumnPath)
 import Models.Project.ColumnRef exposing (ColumnRef)
 import Models.Project.ColumnStats exposing (ColumnStats)
 import Models.Project.FindPathSettings exposing (FindPathSettings)
+import Models.Project.Group exposing (Group)
 import Models.Project.LayoutName exposing (LayoutName)
 import Models.Project.ProjectName exposing (ProjectName)
 import Models.Project.ProjectStorage exposing (ProjectStorage)
@@ -340,11 +341,12 @@ type GroupMsg
     = GCreate (List TableId)
     | GEdit Int String
     | GEditUpdate String
-    | GEditSave
+    | GEditSave GroupEdit
     | GSetColor Int Color
     | GAddTables Int (List TableId)
     | GRemoveTables Int (List TableId)
     | GDelete Int
+    | GUnDelete Int Group
 
 
 type MemoMsg

frontend/src/PagesComponents/Organization_/Project_/Updates.elm

@@ -306,7 +306,7 @@ update urlLayout zone now urlInfos organizations projects msg model =
             model |> handleLayout message
 
         GroupMsg message ->
-            model |> handleGroups now urlInfos message |> Tuple.append []
+            model |> handleGroups now urlInfos message
 
         NotesMsg message ->
             model |> handleNotes message |> Tuple.append []

frontend/src/PagesComponents/Organization_/Project_/Updates/Groups.elm

@@ -15,9 +15,8 @@ import PagesComponents.Organization_.Project_.Models exposing (GroupEdit, GroupM
 import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd)
 import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf)
 import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout)
-import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyCmd)
-import Services.Lenses exposing (mapEditGroupM, mapErdM, mapGroups, mapTables, setColor, setContent, setEditGroup, setName)
-import Services.Toasts as Toasts
+import PagesComponents.Organization_.Project_.Updates.Utils exposing (setHDirty, setHDirtyCmd, setHL, setHLCmd, setHLDirty)
+import Services.Lenses exposing (mapColorT, mapEditGroupM, mapErdM, mapErdMT, mapErdMTM, mapGroups, mapGroupsT, mapTables, setContent, setEditGroup, setName)
 import Task
 import Time
 import Track
@@ -32,44 +31,71 @@ type alias Model x =
     }
 
 
-handleGroups : Time.Posix -> UrlInfos -> GroupMsg -> Model x -> ( Model x, Cmd Msg )
+handleGroups : Time.Posix -> UrlInfos -> GroupMsg -> Model x -> ( Model x, Cmd Msg, List ( Msg, Msg ) )
 handleGroups now urlInfos msg model =
     case msg of
         GCreate tables ->
             model |> createGroup now urlInfos tables
 
         GEdit index name ->
-            ( model |> setEditGroup (Just { index = index, content = name }), index |> Group.toInputId |> Dom.focus |> Task.attempt (\_ -> Noop "focus-group-input") )
+            ( model |> setEditGroup (Just { index = index, content = name }), index |> Group.toInputId |> Dom.focus |> Task.attempt (\_ -> Noop "focus-group-input"), [] )
 
         GEditUpdate name ->
-            ( model |> mapEditGroupM (setContent name), Cmd.none )
+            ( model |> mapEditGroupM (setContent name), Cmd.none, [] )
 
-        GEditSave ->
-            model.editGroup |> Maybe.mapOrElse (\edit -> model |> saveGroup now edit) ( model, "No group to save" |> Toasts.create "warning" |> Toast |> T.send )
+        GEditSave content ->
+            model |> saveGroup now content
 
         GSetColor index color ->
             model |> setGroupColor now urlInfos index color
 
         GAddTables index tables ->
-            model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt index (mapTables (List.append tables))))) |> setDirty
+            model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt index (mapTables (List.append tables))))) |> setHDirty [ ( GroupMsg (GRemoveTables index tables), GroupMsg msg ) ]
 
         GRemoveTables index tables ->
-            model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt index (mapTables (List.removeAll tables))))) |> setDirty
+            model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt index (mapTables (List.removeAll tables))))) |> setHDirty [ ( GroupMsg (GAddTables index tables), GroupMsg msg ) ]
 
         GDelete index ->
-            model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.removeAt index))) |> setDirty
-
-
-createGroup : Time.Posix -> UrlInfos -> List TableId -> Model x -> ( Model x, Cmd Msg )
+            model
+                |> mapErdMT
+                    (Erd.mapCurrentLayoutTLWithTime now
+                        (mapGroupsT
+                            (\groups ->
+                                (groups |> List.get index)
+                                    |> Maybe.map (\g -> ( groups |> List.removeAt index, [ ( GroupMsg (GUnDelete index g), GroupMsg msg ) ] ))
+                                    |> Maybe.withDefault ( groups, [] )
+                            )
+                        )
+                    )
+                |> setHLDirty
+
+        GUnDelete index group ->
+            model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapGroupsT (\groups -> ( groups |> List.insertAt index group, [ ( GroupMsg (GDelete index), GroupMsg msg ) ] )))) |> setHL
+
+
+createGroup : Time.Posix -> UrlInfos -> List TableId -> Model x -> ( Model x, Cmd Msg, List ( Msg, Msg ) )
 createGroup now urlInfos tables model =
     if tables |> List.isEmpty then
-        ( model, Cmd.none )
+        ( model, Cmd.none, [] )
 
     else if model.erd |> Erd.canCreateGroup then
-        ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (\l -> l |> mapGroups (List.insert (Group.init tables (groupColor l tables))))), Track.groupCreated model.erd ) |> setDirtyCmd
+        model
+            |> mapErdMTM
+                (Erd.mapCurrentLayoutTWithTime now
+                    (\l ->
+                        l
+                            |> mapGroupsT
+                                (\groups ->
+                                    ( groups |> List.insert (Group.init tables (groupColor l tables))
+                                    , ( Track.groupCreated model.erd, [ ( GroupMsg (GDelete (List.length groups)), GroupMsg (GCreate tables) ) ] )
+                                    )
+                                )
+                    )
+                )
+            |> setHLCmd
 
     else
-        ( model, model.erd |> Maybe.mapOrElse (\erd -> Cmd.batch [ erd |> Erd.getProjectRef urlInfos |> ProPlan.groupsModalBody |> CustomModalOpen |> T.send, Track.planLimit .groups (Just erd) ]) Cmd.none )
+        ( model, model.erd |> Maybe.mapOrElse (\erd -> Cmd.batch [ erd |> Erd.getProjectRef urlInfos |> ProPlan.groupsModalBody |> CustomModalOpen |> T.send, Track.planLimit .groups (Just erd) ]) Cmd.none, [] )
 
 
 groupColor : ErdLayout -> List TableId -> Color
@@ -85,30 +111,33 @@ groupColor layout tableIds =
         |> Maybe.mapOrElse Tuple.first Tw.indigo
 
 
-setGroupColor : Time.Posix -> UrlInfos -> Int -> Color -> Model x -> ( Model x, Cmd Msg )
+setGroupColor : Time.Posix -> UrlInfos -> Int -> Color -> Model x -> ( Model x, Cmd Msg, List ( Msg, Msg ) )
 setGroupColor now urlInfos index color model =
     let
         project : ProjectRef
         project =
             model.erd |> Erd.getProjectRefM urlInfos
     in
     if model.erd |> Erd.canChangeColor then
-        model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt index (setColor color)))) |> setDirty
+        model |> mapErdMT (Erd.mapCurrentLayoutTLWithTime now (mapGroupsT (List.mapAtTL index (mapColorT (\c -> ( color, [ ( GroupMsg (GSetColor index c), GroupMsg (GSetColor index color) ) ] )))))) |> setHLDirty
 
     else
-        ( model, Cmd.batch [ ProPlan.colorsModalBody project ProPlanColors ProPlan.colorsInit |> CustomModalOpen |> T.send, Track.planLimit .tableColor model.erd ] )
+        ( model, Cmd.batch [ ProPlan.colorsModalBody project ProPlanColors ProPlan.colorsInit |> CustomModalOpen |> T.send, Track.planLimit .tableColor model.erd ], [] )
 
 
-saveGroup : Time.Posix -> GroupEdit -> Model x -> ( Model x, Cmd Msg )
+saveGroup : Time.Posix -> GroupEdit -> Model x -> ( Model x, Cmd Msg, List ( Msg, Msg ) )
 saveGroup now edit model =
     let
         groupName : String
         groupName =
-            model.erd |> Maybe.andThen (\erd -> erd |> Erd.currentLayout |> .groups |> List.get edit.index) |> Maybe.mapOrElse .name ""
+            model.erd |> Maybe.andThen (Erd.currentLayout >> .groups >> List.get edit.index) |> Maybe.mapOrElse .name ""
     in
     if edit.content == groupName then
         -- no change, don't save
-        ( model |> setEditGroup Nothing, Cmd.none )
+        ( model |> setEditGroup Nothing, Cmd.none, [] )
 
     else
-        ( model |> setEditGroup Nothing |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt edit.index (setName edit.content)))), Track.groupRenamed edit.content model.erd ) |> setDirtyCmd
+        ( model |> setEditGroup Nothing |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapGroups (List.mapAt edit.index (setName edit.content))))
+        , Track.groupRenamed edit.content model.erd
+        )
+            |> setHDirtyCmd [ ( GroupMsg (GEditSave { edit | content = groupName }), GroupMsg (GEditSave edit) ) ]

frontend/src/PagesComponents/Organization_/Project_/Views/Erd.elm

@@ -345,7 +345,7 @@ viewGroups platform defaultSchema editGroup groups =
                                         , placeholder "Group name"
                                         , value edit.content
                                         , onInput (GEditUpdate >> GroupMsg)
-                                        , onBlur (GEditSave |> GroupMsg)
+                                        , onBlur (GEditSave edit |> GroupMsg)
                                         , autofocus True
                                         , css [ "px-2 py-0 shadow-sm block border-gray-300 rounded-md", focus [ Tw.ring_500 group.color, Tw.border_500 group.color ] ]
                                         ]

frontend/src/Services/Lenses.elm

@@ -32,6 +32,7 @@ module Services.Lenses exposing
     , mapFindPath
     , mapFindPathM
     , mapGroups
+    , mapGroupsT
     , mapHidden
     , mapHiddenColumns
     , mapHoverTable
@@ -42,7 +43,6 @@ module Services.Lenses exposing
     , mapLayoutsD
     , mapLayoutsDT
     , mapLayoutsDTL
-    , mapLayoutsDTM
     , mapLayoutsDTW
     , mapList
     , mapMTW
@@ -612,6 +612,11 @@ mapGroups =
     map_ .groups setGroups
 
 
+mapGroupsT : (v -> ( v, a )) -> { item | groups : v } -> ( { item | groups : v }, a )
+mapGroupsT =
+    mapT_ .groups setGroups
+
+
 setHidden : v -> { item | hidden : v } -> { item | hidden : v }
 setHidden =
     set_ .hidden (\value item -> { item | hidden = value })
@@ -737,11 +742,6 @@ mapLayoutsDT =
     mapDT_ .layouts setLayouts
 
 
-mapLayoutsDTM : comparable -> (v -> ( v, Maybe a )) -> { item | layouts : Dict comparable v } -> ( { item | layouts : Dict comparable v }, Maybe a )
-mapLayoutsDTM =
-    mapDTM_ .layouts setLayouts
-
-
 mapLayoutsDTL : comparable -> (v -> ( v, List a )) -> { item | layouts : Dict comparable v } -> ( { item | layouts : Dict comparable v }, List a )
 mapLayoutsDTL =
     mapDTL_ .layouts setLayouts