Undo for layouts

azimuttapp · Dec 27, 2023 · 009ffde · 009ffde
1 parent 9f32014
commit 009ffde
Show file tree

Hide file tree

Showing 8 changed files with 106 additions and 64 deletions.
diff --git a/frontend/src/PagesComponents/Organization_/Project_/Models.elm b/frontend/src/PagesComponents/Organization_/Project_/Models.elm
@@ -51,6 +51,7 @@ import PagesComponents.Organization_.Project_.Models.DragState exposing (DragSta
 import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd)
 import PagesComponents.Organization_.Project_.Models.ErdColumnProps exposing (ErdColumnProps)
 import PagesComponents.Organization_.Project_.Models.ErdConf as ErdConf exposing (ErdConf)
+import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout)
 import PagesComponents.Organization_.Project_.Models.ErdRelation exposing (ErdRelation)
 import PagesComponents.Organization_.Project_.Models.ErdTable exposing (ErdTable)
 import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout)
@@ -330,8 +331,9 @@ type Msg
 
 
 type LayoutMsg
-    = LLoad LayoutName
+    = LLoad String LayoutName
     | LDelete LayoutName
+    | LUnDelete_ LayoutName ErdLayout
 
 
 type GroupMsg

diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates.elm
@@ -48,7 +48,7 @@ import PagesComponents.Organization_.Project_.Components.ExportDialog as ExportD
 import PagesComponents.Organization_.Project_.Components.ProjectSaveDialog as ProjectSaveDialog
 import PagesComponents.Organization_.Project_.Components.ProjectSharing as ProjectSharing
 import PagesComponents.Organization_.Project_.Components.SourceUpdateDialog as SourceUpdateDialog
-import PagesComponents.Organization_.Project_.Models exposing (AmlSidebar, AmlSidebarMsg(..), Model, Msg(..), ProjectSettingsMsg(..), SchemaAnalysisMsg(..))
+import PagesComponents.Organization_.Project_.Models exposing (AmlSidebar, AmlSidebarMsg(..), LayoutMsg(..), Model, Msg(..), ProjectSettingsMsg(..), SchemaAnalysisMsg(..))
 import PagesComponents.Organization_.Project_.Models.CursorMode as CursorMode
 import PagesComponents.Organization_.Project_.Models.DragState as DragState
 import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd)
@@ -300,10 +300,10 @@ update urlLayout zone now urlInfos organizations projects msg model =
             model |> mapErdMT (Erd.mapIgnoredRelationsT (Dict.updateT col.table (\cols -> ( cols |> Maybe.map (List.filter (\c -> c /= col.column)), [ ( IgnoreRelation col, msg ) ] )))) |> setHLDirty
 
         NewLayoutMsg message ->
-            model |> NewLayout.update ModalOpen Toast CustomModalOpen now urlInfos message |> Tuple.append []
+            model |> NewLayout.update NewLayoutMsg Batch ModalOpen Toast CustomModalOpen (LLoad "" >> LayoutMsg) (LDelete >> LayoutMsg) now urlInfos message
 
         LayoutMsg message ->
-            model |> handleLayout message |> Tuple.append []
+            model |> handleLayout message
 
         GroupMsg message ->
             model |> handleGroups now urlInfos message |> Tuple.append []

diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm
@@ -8,9 +8,10 @@ import Models.Project.LayoutName exposing (LayoutName)
 import PagesComponents.Organization_.Project_.Models exposing (LayoutMsg(..), Msg(..))
 import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd)
 import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf)
-import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyCmd)
+import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout)
+import PagesComponents.Organization_.Project_.Updates.Utils exposing (setHLCmd, setHLDirtyCmd)
 import Ports
-import Services.Lenses exposing (mapErdMTW, mapLayouts, setCurrentLayout, setLayoutOnLoad)
+import Services.Lenses exposing (mapErdMT, mapLayouts, setCurrentLayout, setLayoutOnLoad)
 import Services.Toasts as Toasts
 import Track
 
@@ -19,30 +20,34 @@ type alias Model x =
     { x | conf : ErdConf, dirty : Bool, erd : Maybe Erd }
 
 
-handleLayout : LayoutMsg -> Model x -> ( Model x, Cmd Msg )
+handleLayout : LayoutMsg -> Model x -> ( Model x, Cmd Msg, List ( Msg, Msg ) )
 handleLayout msg model =
     case msg of
-        LLoad name ->
-            model |> mapErdMTW (loadLayout name) Cmd.none
+        LLoad onLoad name ->
+            model |> mapErdMT (loadLayout onLoad name) |> setHLCmd
 
         LDelete name ->
-            model |> mapErdMTW (deleteLayout name) Cmd.none |> setDirtyCmd
+            model |> mapErdMT (deleteLayout name) |> setHLDirtyCmd
 
+        LUnDelete_ name layout ->
+            model |> mapErdMT (unDeleteLayout name layout) |> setHLDirtyCmd
 
-loadLayout : LayoutName -> Erd -> ( Erd, Cmd Msg )
-loadLayout name erd =
-    erd.layouts
-        |> Dict.get name
+
+loadLayout : String -> LayoutName -> Erd -> ( Erd, ( Cmd Msg, List ( Msg, Msg ) ) )
+loadLayout onLoad name erd =
+    (erd.layouts |> Dict.get name)
         |> Maybe.mapOrElse
             (\layout ->
-                ( erd |> setCurrentLayout name |> setLayoutOnLoad "fit"
-                , Cmd.batch [ Ports.observeLayout layout, Track.layoutLoaded erd.project layout ]
+                ( erd |> setCurrentLayout name |> setLayoutOnLoad onLoad
+                , ( Cmd.batch [ Ports.observeLayout layout, Track.layoutLoaded erd.project layout ]
+                  , [ ( LayoutMsg (LLoad onLoad erd.currentLayout), LayoutMsg (LLoad onLoad name) ) ]
+                  )
                 )
             )
-            ( erd, Cmd.none )
+            ( erd, ( Cmd.none, [] ) )
 
 
-deleteLayout : LayoutName -> Erd -> ( Erd, Cmd Msg )
+deleteLayout : LayoutName -> Erd -> ( Erd, ( Cmd Msg, List ( Msg, Msg ) ) )
 deleteLayout name erd =
     (erd.layouts |> Dict.get name)
         |> Maybe.map
@@ -60,10 +65,29 @@ deleteLayout name erd =
                                 |> Maybe.orElse (names |> List.filter (\n -> n /= name) |> List.head)
                     in
                     next
-                        |> Maybe.map (\nextLayout -> ( erd |> mapLayouts (Dict.remove name) |> setCurrentLayout nextLayout, Track.layoutDeleted erd.project layout ))
-                        |> Maybe.withDefault ( erd, "Can't delete last layout" |> Toasts.warning |> Toast |> T.send )
+                        |> Maybe.map
+                            (\nextLayout ->
+                                ( erd |> mapLayouts (Dict.remove name) |> setCurrentLayout nextLayout
+                                , ( Track.layoutDeleted erd.project layout, [ ( Batch [ LayoutMsg (LUnDelete_ name layout), LayoutMsg (LLoad "fit" name) ], LayoutMsg (LDelete name) ) ] )
+                                )
+                            )
+                        |> Maybe.withDefault ( erd, ( "Can't delete last layout" |> Toasts.warning |> Toast |> T.send, [] ) )
 
                 else
-                    ( erd |> mapLayouts (Dict.remove name), Track.layoutDeleted erd.project layout )
+                    ( erd |> mapLayouts (Dict.remove name)
+                    , ( Track.layoutDeleted erd.project layout, [ ( LayoutMsg (LUnDelete_ name layout), LayoutMsg (LDelete name) ) ] )
+                    )
+            )
+        |> Maybe.withDefault ( erd, ( "Can't find layout '" ++ name ++ "' to delete" |> Toasts.warning |> Toast |> T.send, [] ) )
+
+
+unDeleteLayout : LayoutName -> ErdLayout -> Erd -> ( Erd, ( Cmd Msg, List ( Msg, Msg ) ) )
+unDeleteLayout name layout erd =
+    (erd.layouts |> Dict.get name)
+        |> Maybe.map (\_ -> ( erd, ( "'" ++ name ++ "' layout already exists" |> Toasts.error |> Toast |> T.send, [] ) ))
+        |> Maybe.withDefault
+            ( erd |> mapLayouts (Dict.insert name layout)
+            , ( Cmd.none
+              , [ ( Batch [ LayoutMsg (LDelete name), LayoutMsg (LLoad "fit" erd.currentLayout) ], LayoutMsg (LUnDelete_ name layout) ) ]
+              )
             )
-        |> Maybe.withDefault ( erd, "Can't find layout '" ++ name ++ "' to delete" |> Toasts.warning |> Toast |> T.send )
diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm
@@ -1,4 +1,4 @@
-module PagesComponents.Organization_.Project_.Updates.Utils exposing (DirtyModel, setDirty, setDirtyCmd, setHDirty, setHDirtyCmd, setHDirtyCmdM, setHL, setHLDirty, setHLDirtyCmd)
+module PagesComponents.Organization_.Project_.Updates.Utils exposing (DirtyModel, setDirty, setDirtyCmd, setHCmd, setHDirty, setHDirtyCmd, setHDirtyCmdM, setHL, setHLCmd, setHLDirty, setHLDirtyCmd)
 
 import Libs.Maybe as Maybe
 import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf)
@@ -14,6 +14,16 @@ setHL ( model, history ) =
     ( model, Cmd.none, history |> Maybe.withDefault [] )
 
 
+setHCmd : ( a, Maybe (Cmd msg) ) -> ( a, Cmd msg, List ( msg, msg ) )
+setHCmd ( model, cmd ) =
+    ( model, cmd |> Maybe.withDefault Cmd.none, [] )
+
+
+setHLCmd : ( a, Maybe ( Cmd msg, List ( msg, msg ) ) ) -> ( a, Cmd msg, List ( msg, msg ) )
+setHLCmd ( model, meta ) =
+    extract meta |> (\( cmd, history ) -> ( model, cmd, history ))
+
+
 setHLDirty : ( DirtyModel m, Maybe (List ( msg, msg )) ) -> ( DirtyModel m, Cmd msg, List ( msg, msg ) )
 setHLDirty ( model, history ) =
     if model.dirty || not model.conf.save then
@@ -26,13 +36,8 @@ setHLDirty ( model, history ) =
 setHLDirtyCmd : ( DirtyModel m, Maybe ( Cmd msg, List ( msg, msg ) ) ) -> ( DirtyModel m, Cmd msg, List ( msg, msg ) )
 setHLDirtyCmd ( model, meta ) =
     let
-        cmd : Cmd msg
-        cmd =
-            meta |> Maybe.mapOrElse Tuple.first Cmd.none
-
-        history : List ( msg, msg )
-        history =
-            meta |> Maybe.map Tuple.second |> Maybe.withDefault []
+        ( cmd, history ) =
+            extract meta
     in
     if model.dirty || not model.conf.save then
         ( model, cmd, history )
@@ -68,6 +73,11 @@ setHDirtyCmdM history ( model, cmd ) =
         ( { model | dirty = True }, Cmd.batch [ cmd |> Maybe.withDefault Cmd.none, Ports.projectDirty True ], history )
 
 
+extract : Maybe ( Cmd msg, List ( msg, msg ) ) -> ( Cmd msg, List ( msg, msg ) )
+extract meta =
+    ( meta |> Maybe.mapOrElse Tuple.first Cmd.none, meta |> Maybe.map Tuple.second |> Maybe.withDefault [] )
+
+
 setDirty : DirtyModel m -> ( DirtyModel m, Cmd msg )
 setDirty model =
     if model.dirty || not model.conf.save then

diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views.elm b/frontend/src/PagesComponents/Organization_/Project_/Views.elm
@@ -143,7 +143,7 @@ viewLeftSidebar model =
     let
         content : Maybe (Html Msg)
         content =
-            model.detailsSidebar |> Maybe.map2 (DetailsSidebar.view DetailsSidebarMsg (\id -> ShowTable id Nothing "details") (ShowColumn 1000) HideColumn (LLoad >> LayoutMsg) (\source q -> DataExplorer.Open (Just source) (Just q) |> DataExplorerMsg) model.tableStats model.columnStats) model.erd
+            model.detailsSidebar |> Maybe.map2 (DetailsSidebar.view DetailsSidebarMsg (\id -> ShowTable id Nothing "details") (ShowColumn 1000) HideColumn (LLoad "fit" >> LayoutMsg) (\source q -> DataExplorer.Open (Just source) (Just q) |> DataExplorerMsg) model.tableStats model.columnStats) model.erd
     in
     aside [ css [ "block flex-shrink-0 order-first" ] ]
         [ div [ css [ B.cond (content == Nothing) "-ml-112" "", "w-112 transition-[margin] ease-in-out duration-200 h-full relative flex flex-col border-r border-gray-200 bg-white overflow-y-auto" ] ]

diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm
@@ -15,8 +15,8 @@ import Models.UrlInfos exposing (UrlInfos)
 import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd)
 import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf)
 import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout
-import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyCmd)
-import Services.Lenses exposing (mapErdMTW, mapLayouts, mapNewLayoutMTW, setCurrentLayout, setNewLayout)
+import PagesComponents.Organization_.Project_.Updates.Utils exposing (setHCmd, setHLDirtyCmd)
+import Services.Lenses exposing (mapErdMT, mapLayouts, mapNewLayoutMT, setCurrentLayout, setNewLayout)
 import Services.Toasts as Toasts
 import Time
 import Track
@@ -47,59 +47,65 @@ type Msg
     | Cancel
 
 
-update : (HtmlId -> msg) -> (Toasts.Msg -> msg) -> ((msg -> String -> Html msg) -> msg) -> Time.Posix -> UrlInfos -> Msg -> GlobalModel x -> ( GlobalModel x, Cmd msg )
-update modalOpen toast customModalOpen now urlInfos msg model =
+update : (Msg -> msg) -> (List msg -> msg) -> (HtmlId -> msg) -> (Toasts.Msg -> msg) -> ((msg -> String -> Html msg) -> msg) -> (LayoutName -> msg) -> (LayoutName -> msg) -> Time.Posix -> UrlInfos -> Msg -> GlobalModel x -> ( GlobalModel x, Cmd msg, List ( msg, msg ) )
+update wrap batch modalOpen toast customModalOpen loadLayout deleteLayout now urlInfos msg model =
     case msg of
         Open from ->
             if model.erd |> Erd.canCreateLayout then
-                ( model |> setNewLayout (Just (NewLayoutBody.init dialogId from)), Cmd.batch [ T.sendAfter 1 (modalOpen dialogId) ] )
+                ( model |> setNewLayout (Just (NewLayoutBody.init dialogId from)), Cmd.batch [ T.sendAfter 1 (modalOpen dialogId) ], [] )
 
             else
-                ( model
-                , Cmd.batch
-                    [ model.erd |> Erd.getProjectRefM urlInfos |> ProPlan.layoutsModalBody |> customModalOpen |> T.send
-                    , Track.planLimit .layouts model.erd
-                    ]
-                )
+                ( model, Cmd.batch [ model.erd |> Erd.getProjectRefM urlInfos |> ProPlan.layoutsModalBody |> customModalOpen |> T.send, Track.planLimit .layouts model.erd ], [] )
 
         BodyMsg m ->
-            model |> mapNewLayoutMTW (NewLayoutBody.update m) Cmd.none
+            model |> mapNewLayoutMT (NewLayoutBody.update m) |> setHCmd
 
         Submit mode name ->
-            model |> setNewLayout Nothing |> mapErdMTW (updateLayouts toast mode name now) Cmd.none |> setDirtyCmd
+            model |> setNewLayout Nothing |> mapErdMT (updateLayouts wrap batch toast loadLayout deleteLayout mode name now) |> setHLDirtyCmd
 
         Cancel ->
-            ( model |> setNewLayout Nothing, Cmd.none )
+            ( model |> setNewLayout Nothing, Cmd.none, [] )
 
 
-updateLayouts : (Toasts.Msg -> msg) -> NewLayoutBody.Mode -> LayoutName -> Time.Posix -> Erd -> ( Erd, Cmd msg )
-updateLayouts toast mode name now erd =
+updateLayouts : (Msg -> msg) -> (List msg -> msg) -> (Toasts.Msg -> msg) -> (LayoutName -> msg) -> (LayoutName -> msg) -> NewLayoutBody.Mode -> LayoutName -> Time.Posix -> Erd -> ( Erd, ( Cmd msg, List ( msg, msg ) ) )
+updateLayouts wrap batch toast loadLayout deleteLayout mode name now erd =
     case mode of
         NewLayoutBody.Create ->
-            createLayout toast Nothing name now erd
+            createLayout wrap batch toast loadLayout deleteLayout Nothing name now erd
 
         NewLayoutBody.Duplicate from ->
-            createLayout toast (Just from) name now erd
+            createLayout wrap batch toast loadLayout deleteLayout (Just from) name now erd
 
         NewLayoutBody.Rename from ->
-            renameLayout toast from name erd
+            renameLayout wrap toast from name erd
 
 
-createLayout : (Toasts.Msg -> msg) -> Maybe LayoutName -> LayoutName -> Time.Posix -> Erd -> ( Erd, Cmd msg )
-createLayout toast from name now erd =
+createLayout : (Msg -> msg) -> (List msg -> msg) -> (Toasts.Msg -> msg) -> (LayoutName -> msg) -> (LayoutName -> msg) -> Maybe LayoutName -> LayoutName -> Time.Posix -> Erd -> ( Erd, ( Cmd msg, List ( msg, msg ) ) )
+createLayout wrap batch toast loadLayout deleteLayout from name now erd =
     (erd.layouts |> Dict.get name)
-        |> Maybe.mapOrElse
-            (\_ -> ( erd, "Layout " ++ name ++ " already exists" |> Toasts.error |> toast |> T.send ))
+        |> Maybe.map (\_ -> ( erd, ( "'" ++ name ++ "' layout already exists" |> Toasts.error |> toast |> T.send, [] ) ))
+        |> Maybe.withDefault
             ((from |> Maybe.andThen (\f -> erd.layouts |> Dict.get f) |> Maybe.withDefault (ErdLayout.empty now))
-                |> (\layout -> ( erd |> mapLayouts (Dict.insert name layout) |> setCurrentLayout name, Track.layoutCreated erd.project layout ))
+                |> (\layout ->
+                        ( erd |> mapLayouts (Dict.insert name layout) |> setCurrentLayout name
+                        , ( Track.layoutCreated erd.project layout
+                          , [ ( batch [ deleteLayout name, loadLayout erd.currentLayout ], wrap (Submit (from |> Maybe.mapOrElse NewLayoutBody.Duplicate NewLayoutBody.Create) name) ) ]
+                          )
+                        )
+                   )
             )
 
 
-renameLayout : (Toasts.Msg -> msg) -> LayoutName -> LayoutName -> Erd -> ( Erd, Cmd msg )
-renameLayout toast from name erd =
+renameLayout : (Msg -> msg) -> (Toasts.Msg -> msg) -> LayoutName -> LayoutName -> Erd -> ( Erd, ( Cmd msg, List ( msg, msg ) ) )
+renameLayout wrap toast from name erd =
     (erd.layouts |> Dict.get from)
-        |> Maybe.map (\l -> ( erd |> mapLayouts (Dict.remove from >> Dict.insert name l) |> setCurrentLayout name, Track.layoutRenamed erd.project l ))
-        |> Maybe.withDefault ( erd, "Layout " ++ from ++ " does not exist" |> Toasts.error |> toast |> T.send )
+        |> Maybe.map
+            (\l ->
+                ( erd |> mapLayouts (Dict.remove from >> Dict.insert name l) |> setCurrentLayout name
+                , ( Track.layoutRenamed erd.project l, [ ( wrap (Submit (NewLayoutBody.Rename name) from), wrap (Submit (NewLayoutBody.Rename from) name) ) ] )
+                )
+            )
+        |> Maybe.withDefault ( erd, ( "'" ++ from ++ "' layout does not exist" |> Toasts.error |> toast |> T.send, [] ) )
 
 
 view : (Msg -> msg) -> (msg -> msg) -> ProjectRef -> List LayoutName -> Bool -> Model -> Html msg

diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm
@@ -269,7 +269,7 @@ viewLayoutFolders currentLayout folderPrefix folders =
 
 viewLayoutItem : Bool -> String -> LayoutName -> ErdLayout -> Html Msg
 viewLayoutItem isCurrent folderName layoutName layout =
-    button [ type_ "button", onClick (layoutName |> LLoad |> LayoutMsg), role "menuitem", tabindex -1, css [ "w-full text-left", B.cond isCurrent ContextMenu.itemCurrentStyles ContextMenu.itemStyles, focus [ "outline-none" ] ] ]
+    button [ type_ "button", onClick (layoutName |> LLoad "fit" |> LayoutMsg), role "menuitem", tabindex -1, css [ "w-full text-left", B.cond isCurrent ContextMenu.itemCurrentStyles ContextMenu.itemStyles, focus [ "outline-none" ] ] ]
         [ text folderName, text " ", small [] [ text ("(" ++ ((List.length layout.tables + List.length layout.tableRows + List.length layout.memos) |> String.pluralize "item") ++ ")") ] ]
 
 

diff --git a/frontend/src/Services/Lenses.elm b/frontend/src/Services/Lenses.elm
@@ -52,7 +52,7 @@ module Services.Lenses exposing
     , mapMetadata
     , mapMobileMenuOpen
     , mapNavbar
-    , mapNewLayoutMTW
+    , mapNewLayoutMT
     , mapOpened
     , mapOpenedDialogs
     , mapOpenedDropdown
@@ -832,9 +832,9 @@ setNewLayout =
     set_ .newLayout (\value item -> { item | newLayout = value })
 
 
-mapNewLayoutMTW : (v -> ( v, a )) -> a -> { item | newLayout : Maybe v } -> ( { item | newLayout : Maybe v }, a )
-mapNewLayoutMTW transform default item =
-    mapMT_ .newLayout setNewLayout transform item |> Tuple.mapSecond (Maybe.withDefault default)
+mapNewLayoutMT : (v -> ( v, a )) -> { item | newLayout : Maybe v } -> ( { item | newLayout : Maybe v }, Maybe a )
+mapNewLayoutMT transform item =
+    mapMT_ .newLayout setNewLayout transform item
 
 
 setNotes : v -> { item | notes : v } -> { item | notes : v }