diff --git a/frontend/review/src/ReviewConfig.elm b/frontend/review/src/ReviewConfig.elm index f443e3252..cb80acc01 100644 --- a/frontend/review/src/ReviewConfig.elm +++ b/frontend/review/src/ReviewConfig.elm @@ -31,7 +31,7 @@ config = , NoDebug.TodoOrToString.rule |> Rule.ignoreErrorsForFiles [ "src/Libs/Debug.elm" ] , NoExposingEverything.rule |> Rule.ignoreErrorsForDirectories [ "tests" ] , NoMissingSubscriptionsCall.rule - , NoRecursiveUpdate.rule + , NoRecursiveUpdate.rule |> Rule.ignoreErrorsForFiles [ "src/PagesComponents/Organization_/Project_/Updates.elm" ] , NoMissingTypeAnnotation.rule |> Rule.ignoreErrorsForDirectories [ ".elm-spa" ] , NoMissingTypeAnnotationInLetIn.rule , NoMissingTypeExpose.rule |> Rule.ignoreErrorsForDirectories [ ".elm-spa" ] diff --git a/frontend/src/Components/Organisms/Table.elm b/frontend/src/Components/Organisms/Table.elm index 7bb65d9b5..ffa15dcaa 100644 --- a/frontend/src/Components/Organisms/Table.elm +++ b/frontend/src/Components/Organisms/Table.elm @@ -1,4 +1,4 @@ -module Components.Organisms.Table exposing (Actions, CheckConstraint, Column, DocState, IndexConstraint, Model, NestedColumns(..), ProjectInfo, Relation, SharedDocState, State, TableConf, UniqueConstraint, doc, docInit, table) +module Components.Organisms.Table exposing (Actions, CheckConstraint, Column, DocState, IndexConstraint, Model, NestedColumns(..), ProjectInfo, Relation, SharedDocState, State, TableConf, TableHover, UniqueConstraint, doc, docInit, table) import Components.Atoms.Icon as Icon import Components.Atoms.Icons as Icons @@ -84,6 +84,10 @@ type NestedColumns = NestedColumns Int (List Column) +type alias TableHover = + ( TableId, Maybe ColumnPath ) + + type alias State = { color : Color , isHover : Bool diff --git a/frontend/src/Components/Organisms/TableRow.elm b/frontend/src/Components/Organisms/TableRow.elm index 87cab2c7d..82485e3f2 100644 --- a/frontend/src/Components/Organisms/TableRow.elm +++ b/frontend/src/Components/Organisms/TableRow.elm @@ -62,10 +62,11 @@ import Models.Size as Size import Models.SqlQuery exposing (SqlQuery, SqlQueryOrigin) import PagesComponents.Organization_.Project_.Models.ErdConf as ErdConf exposing (ErdConf) import PagesComponents.Organization_.Project_.Models.PositionHint as PositionHint exposing (PositionHint) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import PagesComponents.Organization_.Project_.Views.Modals.ColumnRowContextMenu as ColumnRowContextMenu import PagesComponents.Organization_.Project_.Views.Modals.TableRowContextMenu as TableRowContextMenu import Ports -import Services.Lenses exposing (mapColumns, mapHidden, mapSelected, mapShowHiddenColumns, mapState, setCollapsed, setPrevious, setState) +import Services.Lenses exposing (mapCollapsedT, mapColumns, mapHidden, mapSelected, mapShowHiddenColumns, mapState, mapStateT, setPrevious, setState) import Services.Toasts as Toasts import Set exposing (Set) import Time @@ -84,9 +85,8 @@ type Msg = GotResult QueryResult | Refresh | Cancel - | Restore TableRow.SuccessState - | Collapse - | Expand + | SetState State + | SetCollapsed Bool | ShowColumn ColumnPathStr | HideColumn ColumnPathStr | ToggleHiddenColumns @@ -144,7 +144,10 @@ init project id now source query hidden previous hint = , selected = False , collapsed = False } - , Cmd.batch [ previous |> Maybe.mapOrElse (\_ -> Cmd.none) (Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url sqlQuery), Track.tableRowOpened previous source sqlQuery project ] + , Cmd.batch + [ previous |> Maybe.mapOrElse (\_ -> Cmd.none) (Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url sqlQuery) + , Track.tableRowOpened previous source sqlQuery project + ] ) @@ -181,22 +184,31 @@ initRelation src ref = -- UPDATE -update : (HtmlId -> msg) -> (Toasts.Msg -> msg) -> Time.Posix -> ProjectInfo -> List Source -> HtmlId -> Msg -> Model -> ( Model, Cmd msg ) -update toggleDropdown showToast now project sources openedDropdown msg model = +update : (Msg -> msg) -> (HtmlId -> msg) -> (Toasts.Msg -> msg) -> msg -> (TableRow -> msg) -> Time.Posix -> ProjectInfo -> List Source -> HtmlId -> Msg -> Model -> ( Model, Extra msg ) +update wrap toggleDropdown showToast deleteTableRow unDeleteTableRow now project sources openedDropdown msg model = case msg of GotResult res -> - ( model - |> mapStateLoading (\l -> res.result |> Result.fold (initFailure l.query l.previous res.started res.finished) (initSuccess res.started res.finished)) - |> mapHidden - (\h -> - if Set.isEmpty h then - res.result |> Result.mapOrElse defaultHidden Set.empty - - else - h - ) - , Track.tableRowResult res project - ) + model + |> mapStateLoadingTM (\l -> ( res.result |> Result.fold (initFailure l.query l.previous res.started res.finished) (initSuccess res.started res.finished), l.previous )) + |> (\( newModel, previous ) -> + ( newModel + |> mapHidden + (\h -> + if Set.isEmpty h then + res.result |> Result.mapOrElse defaultHidden Set.empty + + else + h + ) + , Extra.new + (Track.tableRowResult res project) + (previous + |> Maybe.map (\s -> ( wrap (SetState (StateSuccess s)), wrap (SetState newModel.state) )) + |> Maybe.withDefault ( deleteTableRow, unDeleteTableRow newModel ) + -- if no previous, add history for show table row (initial loading, cf frontend/src/PagesComponents/Organization_/Project_/Updates/TableRow.elm#showTableRow) + ) + ) + ) Refresh -> withDbSource showToast @@ -209,30 +221,27 @@ update toggleDropdown showToast now project sources openedDropdown msg model = DbQuery.findRow dbSrc.db.kind { table = model.table, primaryKey = model.primaryKey } in ( model |> setState (StateLoading { query = sqlQuery, startedAt = now, previous = model |> TableRow.stateSuccess }) - , Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id) dbSrc.db.url sqlQuery + , Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id) dbSrc.db.url sqlQuery |> Extra.cmd ) ) Cancel -> - ( model |> mapStateLoading (\l -> initFailure l.query l.previous l.startedAt now "Query canceled"), Cmd.none ) - - Restore success -> - ( model |> setState (StateSuccess success), Cmd.none ) + ( model |> mapStateLoading (\l -> initFailure l.query l.previous l.startedAt now "Query canceled"), Extra.none ) - Collapse -> - ( model |> setCollapsed True, Cmd.none ) + SetState state -> + model |> mapStateT (\s -> ( state, Extra.history ( wrap (SetState s), wrap msg ) )) - Expand -> - ( model |> setCollapsed False, Cmd.none ) + SetCollapsed value -> + model |> mapCollapsedT (\c -> ( value, Extra.history ( wrap (SetCollapsed c), wrap msg ) )) ShowColumn pathStr -> - ( model |> mapHidden (Set.remove pathStr), Cmd.none ) + ( model |> mapHidden (Set.remove pathStr), Extra.history ( wrap (HideColumn pathStr), wrap msg ) ) HideColumn pathStr -> - ( model |> mapHidden (Set.insert pathStr), Cmd.none ) + ( model |> mapHidden (Set.insert pathStr), Extra.history ( wrap (ShowColumn pathStr), wrap msg ) ) ToggleHiddenColumns -> - ( model |> mapShowHiddenColumns not, Cmd.none ) + ( model |> mapShowHiddenColumns not, Extra.history ( wrap ToggleHiddenColumns, wrap ToggleHiddenColumns ) ) ToggleIncomingRows dropdown column relations -> if Dict.isEmpty column.linkedBy && openedDropdown /= dropdown then @@ -245,11 +254,11 @@ update toggleDropdown showToast now project sources openedDropdown msg model = sqlQuery = DbQuery.incomingRows dbSrc.db.kind relations { table = model.table, primaryKey = model.primaryKey } in - ( model, Cmd.batch [ toggleDropdown dropdown |> T.send, Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id ++ "/" ++ column.pathStr) dbSrc.db.url sqlQuery ] ) + ( model, Extra.cmdL [ toggleDropdown dropdown |> T.send, Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id ++ "/" ++ column.pathStr) dbSrc.db.url sqlQuery ] ) ) else - ( model, toggleDropdown dropdown |> T.send ) + ( model, toggleDropdown dropdown |> Extra.msg ) GotIncomingRows column result -> let @@ -258,20 +267,20 @@ update toggleDropdown showToast now project sources openedDropdown msg model = result.result |> Result.fold (\_ -> Dict.empty) (.rows >> List.head >> Maybe.mapOrElse (Dict.mapBoth TableId.parse parsePks) Dict.empty) in ( model |> mapState (mapSuccess (mapColumns (List.mapBy .path column (\c -> { c | linkedBy = linkedBy })))) - , result.result |> Result.fold (\err -> Toasts.error ("Can't get incoming rows: " ++ err) |> showToast |> T.send) (\_ -> Cmd.none) + , result.result |> Result.fold (\err -> "Can't get incoming rows: " ++ err |> Toasts.error |> showToast |> Extra.msg) (\_ -> Extra.none) ) -withDbSource : (Toasts.Msg -> msg) -> List Source -> Model -> (DbSourceInfo -> ( Model, Cmd msg )) -> ( Model, Cmd msg ) +withDbSource : (Toasts.Msg -> msg) -> List Source -> Model -> (DbSourceInfo -> ( Model, Extra msg )) -> ( Model, Extra msg ) withDbSource showToast sources model f = sources |> List.findBy .id model.source |> Maybe.map (DbSourceInfo.fromSource >> Maybe.map f - >> Maybe.withDefault ( model, Toasts.error "Can't refresh row, source is not a database." |> showToast |> T.send ) + >> Maybe.withDefault ( model, "Can't refresh row, source is not a database." |> Toasts.error |> showToast |> Extra.msg ) ) - |> Maybe.withDefault ( model, Toasts.error "Can't refresh row, source not found." |> showToast |> T.send ) + |> Maybe.withDefault ( model, "Can't refresh row, source not found." |> Toasts.error |> showToast |> Extra.msg ) parsePks : DbValue -> List RowPrimaryKey @@ -320,6 +329,16 @@ mapStateLoading f row = row +mapStateLoadingTM : (TableRow.LoadingState -> ( State, Maybe a )) -> TableRow -> ( TableRow, Maybe a ) +mapStateLoadingTM f row = + case row.state of + StateLoading s -> + f s |> Tuple.mapFirst (\res -> { row | state = res }) + + _ -> + ( row, Nothing ) + + mapLoading : (TableRow.LoadingState -> TableRow.LoadingState) -> State -> State mapLoading f state = case state of @@ -419,7 +438,7 @@ viewHeader wrap noop toggleDropdown createContextMenu selectItem showTable delet dropdown : Html msg dropdown = - TableRowContextMenu.view (wrap Refresh) openNotes (wrap Collapse) (wrap Expand) delete platform conf defaultSchema row notes + TableRowContextMenu.view (wrap Refresh) openNotes (SetCollapsed >> wrap) delete platform conf defaultSchema row notes tableLabel : String tableLabel = @@ -470,7 +489,7 @@ viewLoading wrap delete res = , viewQuery "mt-2 px-3 py-2 text-sm" res.query , div [ class "mt-6 flex justify-around" ] [ Button.white1 Tw.indigo [ onClick (Cancel |> wrap), title "Cancel fetching data" ] [ text "Cancel" ] - , res.previous |> Maybe.map (\p -> Button.white1 Tw.emerald [ onClick (Restore p |> wrap), title "Restore previous data" ] [ text "Restore" ]) |> Maybe.withDefault (text "") + , res.previous |> Maybe.map (\p -> Button.white1 Tw.emerald [ onClick (StateSuccess p |> SetState |> wrap), title "Restore previous data" ] [ text "Restore" ]) |> Maybe.withDefault (text "") , Button.white1 Tw.red [ onClick delete, title "Remove this row" ] [ text "Delete" ] ] ] @@ -485,7 +504,7 @@ viewFailure wrap delete res = , viewQuery "mt-1 px-3 py-2" res.query , div [ class "mt-6 flex justify-around" ] [ Button.white1 Tw.indigo [ onClick (Refresh |> wrap), title "Retry fetching data" ] [ text "Refresh" ] - , res.previous |> Maybe.map (\p -> Button.white1 Tw.emerald [ onClick (Restore p |> wrap), title "Restore previous data" ] [ text "Restore" ]) |> Maybe.withDefault (text "") + , res.previous |> Maybe.map (\p -> Button.white1 Tw.emerald [ onClick (StateSuccess p |> SetState |> wrap), title "Restore previous data" ] [ text "Restore" ]) |> Maybe.withDefault (text "") , Button.white1 Tw.red [ onClick delete, title "Remove this row" ] [ text "Delete" ] ] ] @@ -718,7 +737,7 @@ viewColumnRowIncomingRows noop showTableRow openDataExplorer defaultSchema sourc , action = showTableRow source { table = tableId, primaryKey = r } Nothing (Just (PositionHint.PlaceRight row.position row.size)) } ) - |> List.add { label = "See all", action = openDataExplorer (Just source.id) (Just (DbQuery.filterTable source.db.kind { table = tableId, filters = query.foreignKeys |> List.map (\( fk, _ ) -> TableFilter DbOr fk DbEqual rowColumn.value) })) } + |> List.insert { label = "See all", action = openDataExplorer (Just source.id) (Just (DbQuery.filterTable source.db.kind { table = tableId, filters = query.foreignKeys |> List.map (\( fk, _ ) -> TableFilter DbOr fk DbEqual rowColumn.value) })) } ) ContextMenu.BottomRight } @@ -1008,7 +1027,7 @@ docRelation ( fromSchema, fromTable, fromColumn ) ( toSchema, toTable, toColumn docUpdate : DocState -> (DocState -> Model) -> (DocState -> Model -> DocState) -> Msg -> ElmBook.Msg (SharedDocState x) docUpdate s get set msg = - s |> get |> update (docToggleDropdown s) docShowToast Time.zero ProjectInfo.zero [ docSource ] s.openedDropdown msg |> Tuple.first |> set s |> docSetState + s |> get |> update (\_ -> logAction "msg") (docToggleDropdown s) docShowToast docDelete docUnDelete Time.zero ProjectInfo.zero [ docSource ] s.openedDropdown msg |> Tuple.first |> set s |> docSetState docSetState : DocState -> ElmBook.Msg (SharedDocState x) @@ -1069,6 +1088,11 @@ docDelete = logAction "delete" +docUnDelete : TableRow -> ElmBook.Msg state +docUnDelete _ = + logAction "unDelete" + + docOpenNotes : TableId -> Maybe ColumnPath -> ElmBook.Msg state docOpenNotes _ _ = logAction "openNotes" diff --git a/frontend/src/Components/Slices/DataExplorer.elm b/frontend/src/Components/Slices/DataExplorer.elm index 7c422720f..0c1075114 100644 --- a/frontend/src/Components/Slices/DataExplorer.elm +++ b/frontend/src/Components/Slices/DataExplorer.elm @@ -47,8 +47,9 @@ import Models.ProjectInfo as ProjectInfo exposing (ProjectInfo) import Models.SqlQuery exposing (SqlQuery, SqlQueryOrigin) import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports -import Services.Lenses exposing (mapDetailsCmd, mapFilters, mapResultsCmd, mapVisualEditor, setOperation, setOperator, setValue) +import Services.Lenses exposing (mapDetailsT, mapFilters, mapResultsT, mapVisualEditor, setOperation, setOperator, setValue) import Services.Toasts as Toasts import Track @@ -149,7 +150,7 @@ init = -- UPDATE -update : (Msg -> msg) -> (Toasts.Msg -> msg) -> ProjectInfo -> List Source -> Msg -> Model -> ( Model, Cmd msg ) +update : (Msg -> msg) -> (Toasts.Msg -> msg) -> ProjectInfo -> List Source -> Msg -> Model -> ( Model, Extra msg ) update wrap showToast project sources msg model = case msg of Open sourceId query -> @@ -172,7 +173,7 @@ update wrap showToast project sources msg model = , source = source |> Maybe.orElse model.source |> Maybe.orElse (dbSources |> List.head) , queryEditor = query |> Maybe.map (.sql >> Editor.init) |> Maybe.withDefault model.queryEditor } - , Cmd.batch + , Extra.cmdL (Track.dataExplorerOpened sources source query project :: focusMainInput tab :: (Maybe.map2 (\src q -> RunQuery src q |> wrap |> T.send) source query |> Maybe.toList) @@ -180,55 +181,55 @@ update wrap showToast project sources msg model = ) Close -> - ( { model | display = Nothing }, Cmd.none ) + ( { model | display = Nothing }, Extra.none ) UpdateDisplay d -> - ( { model | display = d }, Cmd.none ) + ( { model | display = d }, Extra.none ) UpdateTab tab -> - ( { model | activeTab = tab }, focusMainInput tab ) + ( { model | activeTab = tab }, focusMainInput tab |> Extra.cmd ) UpdateSource source -> - ( { model | source = source, visualEditor = { table = Nothing, filters = [] } }, Cmd.none ) + ( { model | source = source, visualEditor = { table = Nothing, filters = [] } }, Extra.none ) UpdateTable table -> - ( { model | visualEditor = { table = table, filters = [] } }, Cmd.none ) + ( { model | visualEditor = { table = table, filters = [] } }, Extra.none ) AddFilter table path -> - ( table |> Table.getColumn path |> Maybe.mapOrElse (\col -> model |> mapVisualEditor (mapFilters (List.add { operator = DbAnd, column = path, kind = col.kind, nullable = col.nullable, operation = DbEqual, value = DbString "" }))) model, Cmd.none ) + ( table |> Table.getColumn path |> Maybe.mapOrElse (\col -> model |> mapVisualEditor (mapFilters (List.insert { operator = DbAnd, column = path, kind = col.kind, nullable = col.nullable, operation = DbEqual, value = DbString "" }))) model, Extra.none ) UpdateFilterOperator i operator -> - ( model |> mapVisualEditor (mapFilters (List.mapAt i (setOperator operator))), Cmd.none ) + ( model |> mapVisualEditor (mapFilters (List.mapAt i (setOperator operator))), Extra.none ) UpdateFilterOperation i operation -> - ( model |> mapVisualEditor (mapFilters (List.mapAt i (setOperation operation))), Cmd.none ) + ( model |> mapVisualEditor (mapFilters (List.mapAt i (setOperation operation))), Extra.none ) UpdateFilterValue i value -> - ( model |> mapVisualEditor (mapFilters (List.mapAt i (setValue value))), Cmd.none ) + ( model |> mapVisualEditor (mapFilters (List.mapAt i (setValue value))), Extra.none ) DeleteFilter i -> - ( model |> mapVisualEditor (mapFilters (List.removeAt i)), Cmd.none ) + ( model |> mapVisualEditor (mapFilters (List.removeAt i)), Extra.none ) UpdateQuery message -> - ( { model | queryEditor = Editor.update message model.queryEditor }, Cmd.none ) + ( { model | queryEditor = Editor.update message model.queryEditor }, Extra.none ) RunQuery source query -> - { model | resultsSeq = model.resultsSeq + 1 } |> mapResultsCmd (List.prependCmd (DataExplorerQuery.init project model.resultsSeq (DbSource.toInfo source) (query |> DbQuery.addLimit source.db.kind))) + { model | resultsSeq = model.resultsSeq + 1 } |> mapResultsT (List.prependT (DataExplorerQuery.init project model.resultsSeq (DbSource.toInfo source) (query |> DbQuery.addLimit source.db.kind))) DeleteQuery id -> - ( { model | results = model.results |> List.filter (\r -> r.id /= id) }, Cmd.none ) + ( { model | results = model.results |> List.filter (\r -> r.id /= id) }, Extra.none ) QueryMsg id m -> - model |> mapResultsCmd (List.mapByCmd .id id (DataExplorerQuery.update showToast project m)) + model |> mapResultsT (List.mapByTE .id id (DataExplorerQuery.update showToast project m)) OpenDetails source query -> - { model | detailsSeq = model.detailsSeq + 1 } |> mapDetailsCmd (List.prependCmd (DataExplorerDetails.init project model.detailsSeq source query)) + { model | detailsSeq = model.detailsSeq + 1 } |> mapDetailsT (List.prependT (DataExplorerDetails.init project model.detailsSeq source query)) CloseDetails id -> - ( { model | details = model.details |> List.removeBy .id id }, Cmd.none ) + ( { model | details = model.details |> List.removeBy .id id }, Extra.none ) DetailsMsg id m -> - model |> mapDetailsCmd (List.mapByCmd .id id (DataExplorerDetails.update project m)) + model |> mapDetailsT (List.mapByTE .id id (DataExplorerDetails.update project m)) focusMainInput : DataExplorerTab -> Cmd msg diff --git a/frontend/src/Components/Slices/DataExplorerDetails.elm b/frontend/src/Components/Slices/DataExplorerDetails.elm index 69109b5ae..592557723 100644 --- a/frontend/src/Components/Slices/DataExplorerDetails.elm +++ b/frontend/src/Components/Slices/DataExplorerDetails.elm @@ -41,6 +41,7 @@ import Models.SqlQuery exposing (SqlQueryOrigin) import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.ErdTableProps as ErdTableProps import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Lenses exposing (mapState) import Set exposing (Set) @@ -93,7 +94,7 @@ dbPrefix = "data-explorer-details" -init : ProjectInfo -> Id -> DbSourceInfo -> RowQuery -> ( Model, Cmd msg ) +init : ProjectInfo -> Id -> DbSourceInfo -> RowQuery -> ( Model, Extra msg ) init project id source query = let sqlQuery : SqlQueryOrigin @@ -101,7 +102,7 @@ init project id source query = DbQuery.findRow source.db.kind query in ( { id = id, source = source, query = query, state = StateLoading, expanded = Set.empty } - , Cmd.batch [ Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url sqlQuery, Track.dataExplorerDetailsOpened source sqlQuery project ] + , Extra.cmdL [ Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url sqlQuery, Track.dataExplorerDetailsOpened source sqlQuery project ] ) @@ -124,14 +125,14 @@ initSuccess started finished res = -- UPDATE -update : ProjectInfo -> Msg -> Model -> ( Model, Cmd msg ) +update : ProjectInfo -> Msg -> Model -> ( Model, Extra msg ) update project msg model = case msg of GotResult res -> - ( model |> mapState (\_ -> res.result |> Result.fold (initFailure res.started res.finished) (initSuccess res.started res.finished)), Track.dataExplorerDetailsResult res project ) + ( model |> mapState (\_ -> res.result |> Result.fold (initFailure res.started res.finished) (initSuccess res.started res.finished)), Track.dataExplorerDetailsResult res project |> Extra.cmd ) ExpandValue column -> - ( { model | expanded = model.expanded |> Set.toggle column }, Cmd.none ) + ( { model | expanded = model.expanded |> Set.toggle column }, Extra.none ) diff --git a/frontend/src/Components/Slices/DataExplorerQuery.elm b/frontend/src/Components/Slices/DataExplorerQuery.elm index 0a7ebd242..d9b359828 100644 --- a/frontend/src/Components/Slices/DataExplorerQuery.elm +++ b/frontend/src/Components/Slices/DataExplorerQuery.elm @@ -31,7 +31,6 @@ import Libs.Result as Result import Libs.Set as Set import Libs.String as String import Libs.Tailwind exposing (TwClass, focus) -import Libs.Task as T import Libs.Time as Time import Models.DbSourceInfo as DbSourceInfo exposing (DbSourceInfo) import Models.DbValue as DbValue exposing (DbValue(..)) @@ -54,6 +53,7 @@ import Models.Project.TableName exposing (TableName) import Models.ProjectInfo as ProjectInfo exposing (ProjectInfo) import Models.QueryResult as QueryResult exposing (QueryResult, QueryResultColumn, QueryResultColumnTarget, QueryResultRow, QueryResultSuccess) import Models.SqlQuery exposing (SqlQuery, SqlQueryOrigin) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Lenses exposing (mapState, setQuery, setState) import Services.Toasts as Toasts @@ -129,10 +129,10 @@ dbPrefix = "data-explorer-query" -init : ProjectInfo -> Id -> DbSourceInfo -> SqlQueryOrigin -> ( Model, Cmd msg ) +init : ProjectInfo -> Id -> DbSourceInfo -> SqlQueryOrigin -> ( Model, Extra msg ) init project id source query = ( { id = id, source = source, query = query, state = StateRunning } - , Cmd.batch [ Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url query, Track.dataExplorerQueryOpened source query project ] + , Extra.cmdL [ Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt id) source.db.url query, Track.dataExplorerQueryOpened source query project ] ) @@ -163,49 +163,49 @@ initSuccess started finished res = -- UPDATE -update : (Toasts.Msg -> msg) -> ProjectInfo -> Msg -> Model -> ( Model, Cmd msg ) +update : (Toasts.Msg -> msg) -> ProjectInfo -> Msg -> Model -> ( Model, Extra msg ) update showToast project msg model = case msg of Cancel -> - ( model |> mapState (\_ -> StateCanceled), Cmd.none ) + ( model |> mapState (\_ -> StateCanceled), Extra.none ) GotResult res -> - ( model |> setQuery res.query |> mapState (\_ -> res.result |> Result.fold (initFailure res.started res.finished) (initSuccess res.started res.finished)), Track.dataExplorerQueryResult res project ) + ( model |> setQuery res.query |> mapState (\_ -> res.result |> Result.fold (initFailure res.started res.finished) (initSuccess res.started res.finished)), Track.dataExplorerQueryResult res project |> Extra.cmd ) ChangePage p -> - ( model |> mapState (mapSuccess (\s -> { s | page = p })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | page = p })), Extra.none ) ExpandRow i -> - ( model |> mapState (mapSuccess (\s -> { s | expanded = s.expanded |> Set.toggle i })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | expanded = s.expanded |> Set.toggle i })), Extra.none ) CollapseColumn pathStr -> - ( model |> mapState (mapSuccess (\s -> { s | collapsed = s.collapsed |> Set.toggle pathStr })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | collapsed = s.collapsed |> Set.toggle pathStr })), Extra.none ) ToggleQuery -> - ( model |> mapState (mapSuccess (\s -> { s | showQuery = not s.showQuery })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | showQuery = not s.showQuery })), Extra.none ) ToggleDocumentMode -> - ( model |> mapState (mapSuccess (\s -> { s | documentMode = not s.documentMode })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | documentMode = not s.documentMode })), Extra.none ) ToggleFullScreen -> - ( model |> mapState (mapSuccess (\s -> { s | fullScreen = not s.fullScreen })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | fullScreen = not s.fullScreen })), Extra.none ) UpdateSearch search -> - ( model |> mapState (mapSuccess (\s -> { s | search = search, page = 1 })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | search = search, page = 1 })), Extra.none ) UpdateSort sort -> - ( model |> mapState (mapSuccess (\s -> { s | sortBy = sort, page = 1 })), Cmd.none ) + ( model |> mapState (mapSuccess (\s -> { s | sortBy = sort, page = 1 })), Extra.none ) Refresh -> - ( model |> setState StateRunning, Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id) model.source.db.url model.query ) + ( model |> setState StateRunning, Ports.runDatabaseQuery (dbPrefix ++ "/" ++ String.fromInt model.id) model.source.db.url model.query |> Extra.cmd ) ExportData extension -> case model.state of StateSuccess s -> - ( model, Ports.downloadFile (model |> fileName extension) (s |> fileContent extension) ) + ( model, Ports.downloadFile (model |> fileName extension) (s |> fileContent extension) |> Extra.cmd ) _ -> - ( model, Toasts.warning "Can't export data not in success." |> showToast |> T.send ) + ( model, Toasts.warning "Can't export data not in success." |> showToast |> Extra.msg ) stateSuccess : Model -> Maybe SuccessState diff --git a/frontend/src/Components/Slices/DataExplorerStats.elm b/frontend/src/Components/Slices/DataExplorerStats.elm index 50784aed6..47e98d858 100644 --- a/frontend/src/Components/Slices/DataExplorerStats.elm +++ b/frontend/src/Components/Slices/DataExplorerStats.elm @@ -205,7 +205,7 @@ viewPieChart values = data : List { value : String, count : Int } data = if List.length sorted > maxSlices then - sorted |> List.take (maxSlices - 1) |> List.add { value = "Other values", count = sorted |> List.drop (maxSlices - 1) |> List.map .count |> List.sum } + sorted |> List.take (maxSlices - 1) |> List.insert { value = "Other values", count = sorted |> List.drop (maxSlices - 1) |> List.map .count |> List.sum } else sorted diff --git a/frontend/src/Components/Slices/ExportDialogBody.elm b/frontend/src/Components/Slices/ExportDialogBody.elm index 65d9880af..b762e8957 100644 --- a/frontend/src/Components/Slices/ExportDialogBody.elm +++ b/frontend/src/Components/Slices/ExportDialogBody.elm @@ -46,6 +46,7 @@ import PagesComponents.Organization_.Project_.Models.ErdColumnProps as ErdColumn import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.ErdTableProps exposing (ErdTableProps) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Lenses exposing (mapOrganization, mapProject, setCurrentLayout, setLayouts, setOrganization, setTables) import Track @@ -84,7 +85,7 @@ init id = { id = id, input = Nothing, format = Nothing, output = Pending } -update : (Msg -> msg) -> UrlInfos -> Erd -> Msg -> Model -> ( Model, Cmd msg ) +update : (Msg -> msg) -> UrlInfos -> Erd -> Msg -> Model -> ( Model, Extra msg ) update wrap urlInfos erd msg model = case msg of SetInput source -> @@ -97,26 +98,25 @@ update wrap urlInfos erd msg model = ( { model | output = Fetching }, getOutput wrap urlInfos erd source format ) GotOutput file content -> - ( { model | output = Fetched ( file, content ) }, Cmd.none ) + ( { model | output = Fetched ( file, content ) }, Extra.none ) -shouldGetOutput : (Msg -> msg) -> Model -> ( Model, Cmd msg ) +shouldGetOutput : (Msg -> msg) -> Model -> ( Model, Extra msg ) shouldGetOutput wrap model = if model.output /= Fetching then ( { model | output = Pending } , if model.input == Just Project then - GetOutput Project JSON |> wrap |> T.send + GetOutput Project JSON |> wrap |> Extra.msg else - Maybe.map2 (\input format -> GetOutput input format |> wrap |> T.send) model.input model.format - |> Maybe.withDefault Cmd.none + Maybe.map2 GetOutput model.input model.format |> Maybe.map wrap |> Extra.msgM ) else - ( model, Cmd.none ) + ( model, Extra.none ) -getOutput : (Msg -> msg) -> UrlInfos -> Erd -> ExportInput -> ExportFormat -> Cmd msg +getOutput : (Msg -> msg) -> UrlInfos -> Erd -> ExportInput -> ExportFormat -> Extra msg getOutput wrap urlInfos erd input format = let sqlExportAllowed : Bool @@ -125,25 +125,25 @@ getOutput wrap urlInfos erd input format = in case input of Project -> - erd |> Erd.unpack |> Project.downloadContent |> (\output -> output |> GotOutput (erd.project.name ++ ".azimutt.json") |> wrap |> T.send) + erd |> Erd.unpack |> Project.downloadContent |> (GotOutput (erd.project.name ++ ".azimutt.json") >> wrap >> Extra.msg) AllTables -> if format /= AML && format /= JSON && not sqlExportAllowed then - Cmd.batch [ GotOutput "" "plan_limit" |> wrap |> T.send, Track.planLimit .sqlExport (Just erd) ] + Extra.cmdL [ GotOutput "" "plan_limit" |> wrap |> T.send, Track.planLimit .sqlExport (Just erd) ] else - erd |> Erd.toSchema |> generateTables format |> (\( output, ext ) -> output |> GotOutput (erd.project.name ++ "." ++ ext) |> wrap |> T.send) + erd |> Erd.toSchema |> generateTables format |> (\( output, ext ) -> output |> GotOutput (erd.project.name ++ "." ++ ext) |> wrap |> Extra.msg) CurrentLayout -> if format /= AML && format /= JSON && not sqlExportAllowed then - Cmd.batch [ GotOutput "" "plan_limit" |> wrap |> T.send, Track.planLimit .sqlExport (Just erd) ] + Extra.cmdL [ GotOutput "" "plan_limit" |> wrap |> T.send, Track.planLimit .sqlExport (Just erd) ] else erd |> Erd.toSchema |> Schema.filter (erd.layouts |> Dict.get erd.currentLayout |> Maybe.mapOrElse (.tables >> List.map .id) []) |> generateTables format - |> (\( output, ext ) -> output |> GotOutput (erd.project.name ++ "-" ++ erd.currentLayout ++ "." ++ ext) |> wrap |> T.send) + |> (\( output, ext ) -> output |> GotOutput (erd.project.name ++ "-" ++ erd.currentLayout ++ "." ++ ext) |> wrap |> Extra.msg) generateTables : ExportFormat -> Schema -> ( String, String ) @@ -293,7 +293,7 @@ updateDocState project get set msg = s.exportDialogDocState |> get |> update (updateDocState project get set) UrlInfos.empty (sampleErd |> mapProject (setOrganization (Just project.organization))) msg - |> Tuple.mapFirst (\r -> { s | exportDialogDocState = s.exportDialogDocState |> set r }) + |> Tuple.mapBoth (\r -> { s | exportDialogDocState = s.exportDialogDocState |> set r }) .cmd ) diff --git a/frontend/src/Components/Slices/NewLayoutBody.elm b/frontend/src/Components/Slices/NewLayoutBody.elm index d9fd5bdf8..93941b51b 100644 --- a/frontend/src/Components/Slices/NewLayoutBody.elm +++ b/frontend/src/Components/Slices/NewLayoutBody.elm @@ -18,6 +18,7 @@ import Libs.Tailwind as Tw exposing (focus, sm) import Models.Organization exposing (Organization) import Models.Project.LayoutName exposing (LayoutName) import Models.ProjectRef as ProjectRef exposing (ProjectRef) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) type alias Model = @@ -42,11 +43,11 @@ init id mode = { id = id, name = mode |> foldMode "" identity identity, mode = mode } -update : Msg -> Model -> ( Model, Cmd msg ) +update : Msg -> Model -> ( Model, Extra msg ) update msg model = case msg of UpdateLayoutName value -> - ( { model | name = value }, Cmd.none ) + ( { model | name = value }, Extra.none ) view : (Msg -> msg) -> (LayoutName -> msg) -> msg -> HtmlId -> List LayoutName -> ProjectRef -> Model -> Html msg @@ -78,10 +79,10 @@ view wrap onSubmit onCancel titleId layouts project model = [ input [ type_ "text", name inputId, id inputId, placeholder "Layout name (use / to create folders)", value model.name, onInput (UpdateLayoutName >> wrap), autofocus True, css [ "shadow-sm block w-full border-gray-300 rounded-md", focus [ "ring-indigo-500 border-indigo-500" ], sm [ "text-sm" ] ] ] [] ] , if alreadyExists && model.mode /= Duplicate model.name && model.mode /= Rename model.name then - p [ class "mt-2 text-sm text-red-600" ] [ text ("Layout '" ++ model.name ++ "' already exists 😥") ] + p [ class "mt-1 text-sm text-red-600" ] [ text ("Layout '" ++ model.name ++ "' already exists 😥") ] else - p [] [] + p [ class "mt-1 text-sm text-gray-400" ] [ text "Use '/' in the name to create folders when several layouts have the same parents." ] , p [ class "mt-2 text-sm text-gray-500" ] [ text "Do you like Azimutt? Consider " , sendTweet Conf.constants.cheeringTweet [ tabindex -1, class "link" ] [ text "sending us a tweet" ] diff --git a/frontend/src/Components/Slices/ProPlan.elm b/frontend/src/Components/Slices/ProPlan.elm index 948a3183d..bb9028e9c 100644 --- a/frontend/src/Components/Slices/ProPlan.elm +++ b/frontend/src/Components/Slices/ProPlan.elm @@ -20,11 +20,11 @@ import Libs.Nel as Nel import Libs.Result as Result import Libs.String as String import Libs.Tailwind as Tw exposing (Color, focus, sm) -import Libs.Task as T import Models.Organization exposing (Organization) import Models.OrganizationId exposing (OrganizationId) import Models.Project.ProjectId as ProjectId exposing (ProjectId) import Models.ProjectRef as ProjectRef exposing (ProjectRef) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.Backend as Backend exposing (TableColorTweet) import Services.Lenses exposing (setColors, setResult) @@ -140,7 +140,7 @@ colorsInit = { tweetOpen = False, tweetUrl = "", result = Nothing } -colorsUpdate : (ColorsModel -> ColorsMsg -> msg) -> ColorsMsg -> ColorsModel -> ( ColorsModel, Cmd msg ) +colorsUpdate : (ColorsModel -> ColorsMsg -> msg) -> ColorsMsg -> ColorsModel -> ( ColorsModel, Extra msg ) colorsUpdate update msg model = let wrap : ColorsMsg -> msg @@ -149,17 +149,17 @@ colorsUpdate update msg model = in case msg of ToggleTweet -> - ( { model | tweetOpen = not model.tweetOpen }, Cmd.none ) + ( { model | tweetOpen = not model.tweetOpen }, Extra.none ) UpdateTweetUrl value -> - ( { model | tweetUrl = value }, Cmd.none ) + ( { model | tweetUrl = value }, Extra.none ) GetTableColorTweet id url -> if url == "" then - ( { model | result = Nothing }, Cmd.none ) + ( { model | result = Nothing }, Extra.none ) else - ( { model | result = Nothing }, Backend.getTableColorTweet id url (GotTableColorTweet >> wrap) ) + ( { model | result = Nothing }, Backend.getTableColorTweet id url (GotTableColorTweet >> wrap) |> Extra.cmd ) GotTableColorTweet res -> let @@ -167,11 +167,11 @@ colorsUpdate update msg model = result = res |> Result.mapError Backend.errorToString |> Result.andThen colorsTweetResult in - ( { model | result = Just result }, result |> Result.map (\_ -> EnableTableChangeColor |> wrap |> T.send) |> Result.withDefault Cmd.none ) + ( { model | result = Just result }, result |> Result.map (\_ -> EnableTableChangeColor |> wrap) |> Extra.msgR ) EnableTableChangeColor -> -- never called, should be intercepted in the higher level to update the global model - ( model, Cmd.none ) + ( model, Extra.none ) colorsTweetResult : TableColorTweet -> Result ErrorMessage TweetText diff --git a/frontend/src/Components/Slices/ProjectSaveDialogBody.elm b/frontend/src/Components/Slices/ProjectSaveDialogBody.elm index 0d96349ed..87d8b06fd 100644 --- a/frontend/src/Components/Slices/ProjectSaveDialogBody.elm +++ b/frontend/src/Components/Slices/ProjectSaveDialogBody.elm @@ -24,6 +24,7 @@ import Models.Organization exposing (Organization) import Models.Plan as Plan exposing (Plan) import Models.Project.ProjectName exposing (ProjectName) import Models.Project.ProjectStorage as ProjectStorage exposing (ProjectStorage) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) type alias Model = @@ -45,17 +46,17 @@ init id name organization = { id = id, name = name, organization = organization, storage = ProjectStorage.Remote } -update : Msg -> Model -> ( Model, Cmd msg ) +update : Msg -> Model -> ( Model, Extra msg ) update msg model = case msg of UpdateProjectName value -> - ( { model | name = value }, Cmd.none ) + ( { model | name = value }, Extra.none ) UpdateOrganization value -> - ( { model | organization = value }, Cmd.none ) + ( { model | organization = value }, Extra.none ) UpdateStorage value -> - ( { model | storage = value }, Cmd.none ) + ( { model | storage = value }, Extra.none ) signIn : msg -> String -> HtmlId -> Html msg diff --git a/frontend/src/DataSources/DbMiner/QueryCouchbase.elm b/frontend/src/DataSources/DbMiner/QueryCouchbase.elm index 854d05cd3..eae7c61bd 100644 --- a/frontend/src/DataSources/DbMiner/QueryCouchbase.elm +++ b/frontend/src/DataSources/DbMiner/QueryCouchbase.elm @@ -57,7 +57,7 @@ collectionRef : SchemaName -> TableName -> String collectionRef schema table = schema |> String.split "__" - |> List.add table + |> List.insert table |> List.map shouldEscape |> String.join "." diff --git a/frontend/src/Libs/Array.elm b/frontend/src/Libs/Array.elm new file mode 100644 index 000000000..a11a3cd1c --- /dev/null +++ b/frontend/src/Libs/Array.elm @@ -0,0 +1,8 @@ +module Libs.Array exposing (filterNot) + +import Array exposing (Array) + + +filterNot : (a -> Bool) -> Array a -> Array a +filterNot predicate list = + list |> Array.filter (\a -> not (predicate a)) diff --git a/frontend/src/Libs/Dict.elm b/frontend/src/Libs/Dict.elm index 6fe66e4bf..605206fdf 100644 --- a/frontend/src/Libs/Dict.elm +++ b/frontend/src/Libs/Dict.elm @@ -1,4 +1,4 @@ -module Libs.Dict exposing (alter, any, count, filterMap, find, from, fromIndexedList, fromListMap, fuse, getOrElse, getResult, mapBoth, mapKeys, mapValues, nonEmpty, notMember, set, zip) +module Libs.Dict exposing (alter, any, count, filterMap, find, from, fromIndexedList, fromListMap, fuse, getOrElse, getResult, mapBoth, mapKeys, mapValues, nonEmpty, notMember, set, updateT, zip) import Dict exposing (Dict) @@ -106,6 +106,16 @@ count predicate dict = 0 +updateT : comparable -> (Maybe v -> ( Maybe v, a )) -> Dict comparable v -> ( Dict comparable v, a ) +updateT key transform dict = + case transform (dict |> Dict.get key) of + ( Just value, a ) -> + ( dict |> Dict.insert key value, a ) + + ( Nothing, a ) -> + ( dict |> Dict.remove key, a ) + + alter : comparable -> (v -> v) -> Dict comparable v -> Dict comparable v alter key transform dict = -- similar to update but only when key is present diff --git a/frontend/src/Libs/List.elm b/frontend/src/Libs/List.elm index a39644b91..16ca914f7 100644 --- a/frontend/src/Libs/List.elm +++ b/frontend/src/Libs/List.elm @@ -1,7 +1,5 @@ module Libs.List exposing - ( add - , addAt - , appendIf + ( appendIf , appendOn , diff , dropRight @@ -20,17 +18,26 @@ module Libs.List exposing , get , groupBy , groupByL + , headOr , indexOf , indexedConcatMap , indexedFilter , indexedFilterMap , indexedFind + , insert + , insertAt , last , mapAt - , mapAtCmd + , mapAtT + , mapAtTL , mapBy - , mapByCmd + , mapByT + , mapByTE , mapLast + , mapT + , mapTE + , mapTL + , mapTM , maximumBy , memberBy , memberWith @@ -45,9 +52,9 @@ module Libs.List exposing , nonEmptyMap , one , prepend - , prependCmd , prependIf , prependOn + , prependT , reduce , remove , removeAll @@ -57,6 +64,7 @@ module Libs.List exposing , resultCollect , resultSeq , toggle + , tupleSeq , unique , uniqueBy , zip @@ -70,10 +78,16 @@ import Libs.Basics exposing (maxBy, minBy) import Libs.Bool as B import Libs.Maybe as Maybe import Libs.Tuple3 as Tuple3 +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Random import Set +headOr : a -> List a -> a +headOr default list = + list |> List.head |> Maybe.withDefault default + + get : Int -> List a -> Maybe a get index list = if index < 0 then @@ -256,6 +270,36 @@ mapAt index f list = ) +mapAtT : Int -> (a -> ( a, t )) -> List a -> ( List a, Maybe t ) +mapAtT index f list = + list + |> List.indexedMap + (\i a -> + if index == i then + f a |> Tuple.mapSecond Just + + else + ( a, Nothing ) + ) + |> List.unzip + |> Tuple.mapSecond (List.filterMap identity >> List.head) + + +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 + + mapLast : (a -> a) -> List a -> List a mapLast f list = let @@ -279,23 +323,23 @@ mapBy matcher value transform list = ) -mapAtCmd : Int -> (a -> ( a, Cmd msg )) -> List a -> ( List a, Cmd msg ) -mapAtCmd index f list = +mapByT : (a -> b) -> b -> (a -> ( a, t )) -> List a -> ( List a, List t ) +mapByT matcher value f list = list - |> List.indexedMap - (\i a -> - if index == i then - f a + |> List.map + (\a -> + if matcher a == value then + f a |> Tuple.mapSecond Just else - ( a, Cmd.none ) + ( a, Nothing ) ) |> List.unzip - |> Tuple.mapSecond Cmd.batch + |> Tuple.mapSecond (List.filterMap identity) -mapByCmd : (a -> b) -> b -> (a -> ( a, Cmd msg )) -> List a -> ( List a, Cmd msg ) -mapByCmd matcher value f list = +mapByTE : (a -> b) -> b -> (a -> ( a, Extra msg )) -> List a -> ( List a, Extra msg ) +mapByTE matcher value f list = list |> List.map (\a -> @@ -303,10 +347,30 @@ mapByCmd matcher value f list = f a else - ( a, Cmd.none ) + ( a, Extra.none ) ) |> List.unzip - |> Tuple.mapSecond Cmd.batch + |> Tuple.mapSecond Extra.concat + + +mapT : (a -> ( b, t )) -> List a -> ( List b, List t ) +mapT transform list = + list |> List.map transform |> List.unzip + + +mapTM : (a -> ( b, Maybe t )) -> List a -> ( List b, List t ) +mapTM transform list = + list |> mapT transform |> Tuple.mapSecond (List.filterMap identity) + + +mapTL : (a -> ( b, List t )) -> List a -> ( List b, List t ) +mapTL transform list = + list |> mapT transform |> Tuple.mapSecond (List.concatMap identity) + + +mapTE : (a -> ( b, Extra t )) -> List a -> ( List b, Extra t ) +mapTE transform list = + list |> mapT transform |> Tuple.mapSecond Extra.concat zip : List b -> List a -> List ( a, b ) @@ -321,7 +385,7 @@ filterZip f xs = moveIndex : Int -> Int -> List a -> List a moveIndex from to list = - list |> get from |> Maybe.mapOrElse (\v -> list |> removeAt from |> addAt v to) list + list |> get from |> Maybe.mapOrElse (\v -> list |> removeAt from |> insertAt to v) list move : a -> Int -> List a -> List a @@ -359,17 +423,17 @@ removeAll items list = list |> List.filter (\i -> items |> List.member i |> not) -add : a -> List a -> List a -add item list = +insert : a -> List a -> List a +insert item list = list ++ [ item ] -addAt : a -> Int -> List a -> List a -addAt item index list = +insertAt : Int -> a -> List a -> List a +insertAt index item list = if index >= List.length list then list ++ [ item ] - else if index < 0 then + else if index <= 0 then item :: list else @@ -383,9 +447,9 @@ prepend item list = item :: list -prependCmd : ( a, Cmd msg ) -> List a -> ( List a, Cmd msg ) -prependCmd ( item, cmd ) list = - ( item :: list, cmd ) +prependT : ( a, t ) -> List a -> ( List a, t ) +prependT ( item, t ) list = + ( item :: list, t ) prependIf : Bool -> a -> List a -> List a @@ -645,6 +709,11 @@ resultSeq list = Err errs +tupleSeq : List ( a, b ) -> ( List a, List b ) +tupleSeq list = + List.foldr (\( a, b ) ( aList, bList ) -> ( a :: aList, b :: bList )) ( [], [] ) list + + genSeq : List (Random.Generator a) -> Random.Generator (List a) genSeq generators = generators |> List.foldr (Random.map2 (::)) (Random.constant []) diff --git a/frontend/src/Libs/Maybe.elm b/frontend/src/Libs/Maybe.elm index 21e0da24e..81f964614 100644 --- a/frontend/src/Libs/Maybe.elm +++ b/frontend/src/Libs/Maybe.elm @@ -1,4 +1,4 @@ -module Libs.Maybe exposing (all, andThenZip, any, any2, filter, filterBy, filterNot, has, hasBy, isJust, mapOrElse, merge, onNothing, orElse, resultSeq, toList, toResult, toResultErr, when, zip, zip3) +module Libs.Maybe exposing (all, andThenZip, any, any2, filter, filterBy, filterNot, flipWith, has, hasBy, isJust, mapOrElse, mapT, merge, onNothing, orElse, resultSeq, toList, toResult, toResultErr, unzip, when, zip, zip3) import Libs.Bool as B @@ -32,6 +32,11 @@ onNothing f item = f () +mapT : (a -> ( b, t )) -> Maybe a -> ( Maybe b, Maybe t ) +mapT f maybe = + maybe |> Maybe.map f |> unzip + + mapOrElse : (a -> b) -> b -> Maybe a -> b mapOrElse f default maybe = maybe |> Maybe.map f |> Maybe.withDefault default @@ -92,6 +97,11 @@ zip maybeA maybeB = Maybe.map2 (\a b -> ( a, b )) maybeA maybeB +unzip : Maybe ( a, b ) -> ( Maybe a, Maybe b ) +unzip maybe = + maybe |> Maybe.map (\( a, b ) -> ( Just a, Just b )) |> Maybe.withDefault ( Nothing, Nothing ) + + zip3 : Maybe a -> Maybe b -> Maybe c -> Maybe ( a, b, c ) zip3 maybeA maybeB maybeC = Maybe.map3 (\a b c -> ( a, b, c )) maybeA maybeB maybeC @@ -102,6 +112,16 @@ andThenZip f maybe = maybe |> Maybe.andThen (\a -> f a |> Maybe.map (\b -> ( a, b ))) +flipWith : b -> Maybe a -> Maybe b +flipWith b m = + case m of + Just _ -> + Nothing + + Nothing -> + Just b + + fold : b -> (a -> b) -> Maybe a -> b fold empty transform maybe = case maybe of diff --git a/frontend/src/Libs/Tuple.elm b/frontend/src/Libs/Tuple.elm index c0ce2d044..6b1564277 100644 --- a/frontend/src/Libs/Tuple.elm +++ b/frontend/src/Libs/Tuple.elm @@ -1,4 +1,4 @@ -module Libs.Tuple exposing (apply, nAdd, nDiv, nSub, new) +module Libs.Tuple exposing (append, apply, build, map, mapFirstT, mapSecondT, nAdd, nDiv, nSub, new, setFirst, setSecond) new : a -> b -> ( a, b ) @@ -6,11 +6,46 @@ new a b = ( a, b ) +build : b -> a -> ( a, b ) +build b a = + ( a, b ) + + apply : (a -> b -> c) -> ( a, b ) -> c apply f ( a, b ) = f a b +append : c -> ( a, b ) -> ( a, b, c ) +append c ( a, b ) = + ( a, b, c ) + + +setFirst : x -> ( a, b ) -> ( x, b ) +setFirst x ( _, b ) = + ( x, b ) + + +setSecond : x -> ( a, b ) -> ( a, x ) +setSecond x ( a, _ ) = + ( a, x ) + + +mapFirstT : (a -> ( x, t )) -> ( a, b ) -> ( ( x, b ), t ) +mapFirstT f ( a, b ) = + f a |> (\( x, t ) -> ( ( x, b ), t )) + + +mapSecondT : (b -> ( x, t )) -> ( a, b ) -> ( ( a, x ), t ) +mapSecondT f ( a, b ) = + f b |> (\( y, t ) -> ( ( a, y ), t )) + + +map : (a -> b) -> ( a, a ) -> ( b, b ) +map f ( a, b ) = + ( f a, f b ) + + nAdd : ( number, number ) -> ( number, number ) -> ( number, number ) nAdd ( dx, dy ) ( x, y ) = ( x + dx, y + dy ) @@ -24,3 +59,8 @@ nSub ( dx, dy ) ( x, y ) = nDiv : Float -> ( Float, Float ) -> ( Float, Float ) nDiv factor ( x, y ) = ( x / factor, y / factor ) + + +listSeq : ( List a, List b ) -> List ( a, b ) +listSeq ( xs, ys ) = + List.map2 Tuple.pair xs ys diff --git a/frontend/src/Libs/Tuple3.elm b/frontend/src/Libs/Tuple3.elm index 1fa17d095..73c80e7f8 100644 --- a/frontend/src/Libs/Tuple3.elm +++ b/frontend/src/Libs/Tuple3.elm @@ -1,4 +1,4 @@ -module Libs.Tuple3 exposing (apply, first, mapFirst, mapSecond, mapThird, new, second, third) +module Libs.Tuple3 exposing (apply, build, first, map, mapFirst, mapSecond, mapThird, new, second, setFirst, setSecond, setThird, third) new : a -> b -> c -> ( a, b, c ) @@ -6,6 +6,11 @@ new a b c = ( a, b, c ) +build : b -> c -> a -> ( a, b, c ) +build b c a = + ( a, b, c ) + + apply : (a -> b -> c -> d) -> ( a, b, c ) -> d apply f ( a, b, c ) = f a b c @@ -26,6 +31,21 @@ third ( _, _, c ) = c +setFirst : x -> ( a, b, c ) -> ( x, b, c ) +setFirst x ( _, b, c ) = + ( x, b, c ) + + +setSecond : x -> ( a, b, c ) -> ( a, x, c ) +setSecond x ( a, _, c ) = + ( a, x, c ) + + +setThird : x -> ( a, b, c ) -> ( a, b, x ) +setThird x ( a, b, _ ) = + ( a, b, x ) + + mapFirst : (a -> x) -> ( a, b, c ) -> ( x, b, c ) mapFirst f ( a, b, c ) = ( f a, b, c ) @@ -39,3 +59,8 @@ mapSecond f ( a, b, c ) = mapThird : (c -> x) -> ( a, b, c ) -> ( a, b, x ) mapThird f ( a, b, c ) = ( a, b, f c ) + + +map : (x -> y) -> ( x, x, x ) -> ( y, y, y ) +map f ( a, b, c ) = + ( f a, f b, f c ) diff --git a/frontend/src/Models/DbValue.elm b/frontend/src/Models/DbValue.elm index 107cc1980..be35f2623 100644 --- a/frontend/src/Models/DbValue.elm +++ b/frontend/src/Models/DbValue.elm @@ -192,10 +192,10 @@ viewDbValue value = span [ class "opacity-50 italic" ] [ text "null" ] DbArray a -> - span [] (text "[" :: (a |> List.map viewDbValue |> List.intersperse (text ", ")) |> List.add (text "]")) + span [] (text "[" :: (a |> List.map viewDbValue |> List.intersperse (text ", ")) |> List.insert (text "]")) DbObject o -> - span [] (text "{" :: (o |> Dict.toList |> List.map (\( k, v ) -> span [] [ text (k ++ ": "), viewDbValue v ]) |> List.intersperse (text ", ")) |> List.add (text "}")) + span [] (text "{" :: (o |> Dict.toList |> List.map (\( k, v ) -> span [] [ text (k ++ ": "), viewDbValue v ]) |> List.intersperse (text ", ")) |> List.insert (text "}")) viewRaw : Maybe DbValue -> Html msg diff --git a/frontend/src/Models/Project/ColumnPath.elm b/frontend/src/Models/Project/ColumnPath.elm index 66a7edb80..f19dec68f 100644 --- a/frontend/src/Models/Project/ColumnPath.elm +++ b/frontend/src/Models/Project/ColumnPath.elm @@ -1,4 +1,4 @@ -module Models.Project.ColumnPath exposing (ColumnPath, ColumnPathStr, child, decode, decodeStr, encode, encodeStr, fromString, get, isRoot, merge, name, parent, rootName, show, startsWith, toString, update, withName) +module Models.Project.ColumnPath exposing (ColumnPath, ColumnPathStr, child, decode, decodeStr, encode, encodeStr, fromString, get, isRoot, merge, name, parent, rootName, separator, show, startsWith, toString, update, withName) import Dict exposing (Dict) import Json.Decode as Decode exposing (Decoder, Value) diff --git a/frontend/src/Models/Project/ProjectSettings.elm b/frontend/src/Models/Project/ProjectSettings.elm index ecd5c129b..5db2c31c3 100644 --- a/frontend/src/Models/Project/ProjectSettings.elm +++ b/frontend/src/Models/Project/ProjectSettings.elm @@ -5,10 +5,11 @@ import Json.Encode as Encode exposing (Value) import Libs.Json.Decode as Decode import Libs.Json.Encode as Encode import Libs.List as List +import Libs.Nel as Nel import Libs.Regex as Regex import Libs.String as String import Models.ColumnOrder as ColumnOrder exposing (ColumnOrder) -import Models.Project.ColumnPath as ColumnPath exposing (ColumnPath) +import Models.Project.ColumnPath exposing (ColumnPath) import Models.Project.FindPathSettings as FindPathSettings exposing (FindPathSettings) import Models.Project.SchemaName as SchemaName exposing (SchemaName) import Models.Project.TableId exposing (TableId) @@ -78,11 +79,10 @@ removeTable removedTables = removeColumn : String -> ColumnPath -> Bool removeColumn hiddenColumns = let - hidePaths : List ColumnPath - hidePaths = - hiddenColumns |> String.split "," |> List.map String.trim |> List.filterNot String.isEmpty |> List.map ColumnPath.fromString + ( regexHide, stringHide ) = + hiddenColumns |> String.split "," |> List.map String.trim |> List.filterNot String.isEmpty |> List.partition (Regex.match "[+*?^$()[]{}|\\]") in - \path -> hidePaths |> List.any (\hidePath -> path |> ColumnPath.startsWith hidePath) + Nel.toList >> String.join "." >> (\path -> (stringHide |> List.any (\h -> path |> String.startsWith h)) || (regexHide |> List.any (\h -> path |> Regex.match h))) hideColumn : HiddenColumns -> ErdColumn -> Bool diff --git a/frontend/src/Models/Project/Source.elm b/frontend/src/Models/Project/Source.elm index fc50272d1..fdea5e979 100644 --- a/frontend/src/Models/Project/Source.elm +++ b/frontend/src/Models/Project/Source.elm @@ -1,4 +1,4 @@ -module Models.Project.Source exposing (Source, addRelations, aml, databaseUrl, decode, encode, getColumn, getTable, refreshWith, toInfo) +module Models.Project.Source exposing (Source, addRelations, aml, databaseUrl, decode, encode, getColumn, getTable, refreshWith, removeRelations, toInfo) import Array exposing (Array) import Conf @@ -6,6 +6,7 @@ import DataSources.AmlMiner.AmlGenerator as AmlGenerator import Dict exposing (Dict) import Json.Decode as Decode import Json.Encode as Encode exposing (Value) +import Libs.Array as Array import Libs.Dict as Dict import Libs.Json.Decode as Decode import Libs.Json.Encode as Encode @@ -26,6 +27,7 @@ import Models.Project.Table as Table exposing (Table) import Models.Project.TableId exposing (TableId) import Models.SourceInfo exposing (SourceInfo) import Services.Lenses exposing (mapContent, mapRelations, setUpdatedAt) +import Set exposing (Set) import Time @@ -103,7 +105,7 @@ addRelations now rels source = (\content -> rels |> List.map (\r -> AmlGenerator.relation r.src r.ref) - |> List.add "" + |> List.insert "" |> Array.fromList |> Array.append (if Array.get (Array.length content - 1) content == Just "" then @@ -117,6 +119,21 @@ addRelations now rels source = |> setUpdatedAt now +removeRelations : List { src : ColumnRef, ref : ColumnRef } -> Source -> Source +removeRelations rels source = + source + |> mapContent + (\content -> + let + amlRels : Set String + amlRels = + rels |> List.map (\r -> AmlGenerator.relation r.src r.ref) |> Set.fromList + in + content |> Array.filterNot (\line -> amlRels |> Set.member line) + ) + |> mapRelations (List.filterNot (\r -> rels |> List.member { src = r.src, ref = r.ref })) + + encode : Source -> Value encode value = Encode.notNullObject diff --git a/frontend/src/Pages/Embed.elm b/frontend/src/Pages/Embed.elm index e1e6465b5..38de77cc0 100644 --- a/frontend/src/Pages/Embed.elm +++ b/frontend/src/Pages/Embed.elm @@ -25,6 +25,7 @@ import PagesComponents.Organization_.Project_.Models.EmbedMode as EmbedMode expo import PagesComponents.Organization_.Project_.Models.ErdConf as ErdConf import PagesComponents.Organization_.Project_.Subscriptions as Subscriptions import PagesComponents.Organization_.Project_.Updates as Updates +import PagesComponents.Organization_.Project_.Updates.Extra as Extra import PagesComponents.Organization_.Project_.Views as Views import Ports exposing (JsMsg(..)) import Request @@ -48,7 +49,7 @@ page shared req = in Page.element { init = init query - , update = Updates.update query.layout shared.zone shared.now urlInfos shared.organizations shared.projects + , update = \msg model -> Updates.update query.layout shared.zone shared.now urlInfos shared.organizations shared.projects msg model |> Extra.apply Batch , view = Views.view (Request.pushRoute Route.NotFound req) req.url urlInfos shared , subscriptions = Subscriptions.subscriptions } @@ -99,10 +100,10 @@ init query = -- org id is not used to get the project ^^ ++ ((query.projectId |> Maybe.map (\id -> [ Ports.getProject OrganizationId.zero id query.token ])) |> Maybe.orElse (query.projectUrl |> Maybe.map (\url -> [ Http.get { url = url, expect = Http.decodeJson (Result.toMaybe >> GotProject "load" >> JsMessage) Project.decode } ])) - |> Maybe.orElse (query.databaseSource |> Maybe.map (\url -> [ T.send (url |> DatabaseSource.GetSchema |> EmbedSourceParsingDialog.EmbedDatabaseSource |> EmbedSourceParsingMsg), T.sendAfter 1 (ModalOpen Conf.ids.sourceParsingDialog) ])) - |> Maybe.orElse (query.sqlSource |> Maybe.map (\url -> [ T.send (url |> SqlSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedSqlSource |> EmbedSourceParsingMsg), T.sendAfter 1 (ModalOpen Conf.ids.sourceParsingDialog) ])) - |> Maybe.orElse (query.prismaSource |> Maybe.map (\url -> [ T.send (url |> PrismaSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedPrismaSource |> EmbedSourceParsingMsg), T.sendAfter 1 (ModalOpen Conf.ids.sourceParsingDialog) ])) - |> Maybe.orElse (query.jsonSource |> Maybe.map (\url -> [ T.send (url |> JsonSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedJsonSource |> EmbedSourceParsingMsg), T.sendAfter 1 (ModalOpen Conf.ids.sourceParsingDialog) ])) + |> Maybe.orElse (query.databaseSource |> Maybe.map (\url -> [ url |> DatabaseSource.GetSchema |> EmbedSourceParsingDialog.EmbedDatabaseSource |> EmbedSourceParsingMsg |> T.send, ModalOpen Conf.ids.sourceParsingDialog |> T.sendAfter 1 ])) + |> Maybe.orElse (query.sqlSource |> Maybe.map (\url -> [ url |> SqlSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedSqlSource |> EmbedSourceParsingMsg |> T.send, ModalOpen Conf.ids.sourceParsingDialog |> T.sendAfter 1 ])) + |> Maybe.orElse (query.prismaSource |> Maybe.map (\url -> [ url |> PrismaSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedPrismaSource |> EmbedSourceParsingMsg |> T.send, ModalOpen Conf.ids.sourceParsingDialog |> T.sendAfter 1 ])) + |> Maybe.orElse (query.jsonSource |> Maybe.map (\url -> [ url |> JsonSource.GetRemoteFile |> EmbedSourceParsingDialog.EmbedJsonSource |> EmbedSourceParsingMsg |> T.send, ModalOpen Conf.ids.sourceParsingDialog |> T.sendAfter 1 ])) |> Maybe.withDefault [] ) ) diff --git a/frontend/src/Pages/NotFound.elm b/frontend/src/Pages/NotFound.elm index aad8d53ad..0748276b2 100644 --- a/frontend/src/Pages/NotFound.elm +++ b/frontend/src/Pages/NotFound.elm @@ -9,10 +9,11 @@ import Html exposing (Html) import Html.Lazy as Lazy import Libs.Task as T import Page +import PagesComponents.Organization_.Project_.Updates.Extra as Extra import Ports exposing (JsMsg(..)) import Request exposing (Request) import Services.Backend as Backend -import Services.Lenses exposing (mapToastsCmd) +import Services.Lenses exposing (mapToastsT) import Services.Toasts as Toasts import Shared import Track @@ -90,7 +91,7 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Toast message -> - model |> mapToastsCmd (Toasts.update Toast message) + model |> mapToastsT (Toasts.update Toast message) |> Extra.unpackT JsMessage message -> model |> handleJsMessage message diff --git a/frontend/src/Pages/Organization_/Project_.elm b/frontend/src/Pages/Organization_/Project_.elm index 12879a276..87f299e5d 100644 --- a/frontend/src/Pages/Organization_/Project_.elm +++ b/frontend/src/Pages/Organization_/Project_.elm @@ -14,6 +14,7 @@ import PagesComponents.Organization_.Project_.Models as Models exposing (Msg(..) import PagesComponents.Organization_.Project_.Models.ErdConf as ErdConf import PagesComponents.Organization_.Project_.Subscriptions as Subscriptions import PagesComponents.Organization_.Project_.Updates as Updates +import PagesComponents.Organization_.Project_.Updates.Extra as Extra import PagesComponents.Organization_.Project_.Views as Views import Ports import Request @@ -33,7 +34,7 @@ page shared req = in Page.element { init = init req.params urlToken urlSave - , update = Updates.update urlLayout shared.zone shared.now urlInfos shared.organizations shared.projects + , update = \msg model -> Updates.update urlLayout shared.zone shared.now urlInfos shared.organizations shared.projects msg model |> Extra.apply Batch , view = Views.view (Navigation.load (Backend.organizationUrl urlInfos.organization)) req.url urlInfos shared , subscriptions = Subscriptions.subscriptions } @@ -64,6 +65,6 @@ init params token save = } , Ports.listenHotkeys Conf.hotkeys , Ports.getProject params.organization params.project token - , Bool.cond save (T.sendAfter 1000 TriggerSaveProject) Cmd.none + , Bool.cond save (TriggerSaveProject |> T.sendAfter 1000) Cmd.none ] ) diff --git a/frontend/src/PagesComponents/Create/Init.elm b/frontend/src/PagesComponents/Create/Init.elm index a866e5855..0ba454b0f 100644 --- a/frontend/src/PagesComponents/Create/Init.elm +++ b/frontend/src/PagesComponents/Create/Init.elm @@ -28,6 +28,6 @@ init urlOrganization = , html = Just "h-full" , body = Just "h-full" } - , T.send InitProject + , InitProject |> T.send ] ) diff --git a/frontend/src/PagesComponents/Create/Updates.elm b/frontend/src/PagesComponents/Create/Updates.elm index 0bc703848..7642ff38e 100644 --- a/frontend/src/PagesComponents/Create/Updates.elm +++ b/frontend/src/PagesComponents/Create/Updates.elm @@ -16,12 +16,13 @@ import Models.Project.Source as Source exposing (Source) import Models.Project.SourceId as SourceId import Models.ProjectInfo exposing (ProjectInfo) import PagesComponents.Create.Models exposing (Model, Msg(..)) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra import Ports exposing (JsMsg(..)) import Random import Request import Services.DatabaseSource as DatabaseSource import Services.JsonSource as JsonSource -import Services.Lenses exposing (mapDatabaseSourceMCmd, mapJsonSourceMCmd, mapPrismaSourceMCmd, mapSqlSourceMCmd, mapToastsCmd) +import Services.Lenses exposing (mapDatabaseSourceMT, mapJsonSourceMT, mapPrismaSourceMT, mapSqlSourceMT, mapToastsT) import Services.PrismaSource as PrismaSource import Services.SqlSource as SqlSource import Services.Toasts as Toasts @@ -59,16 +60,16 @@ update req now projects projectsLoaded urlOrganization msg model = ( model, InitProject |> T.sendAfter 500 ) DatabaseSourceMsg message -> - model |> mapDatabaseSourceMCmd (DatabaseSource.update DatabaseSourceMsg now Nothing message) + model |> mapDatabaseSourceMT (DatabaseSource.update DatabaseSourceMsg now Nothing message) |> Extra.unpackTM SqlSourceMsg message -> - model |> mapSqlSourceMCmd (SqlSource.update SqlSourceMsg now Nothing message) + model |> mapSqlSourceMT (SqlSource.update SqlSourceMsg now Nothing message) |> Extra.unpackTM PrismaSourceMsg message -> - model |> mapPrismaSourceMCmd (PrismaSource.update PrismaSourceMsg now Nothing message) + model |> mapPrismaSourceMT (PrismaSource.update PrismaSourceMsg now Nothing message) |> Extra.unpackTM JsonSourceMsg message -> - model |> mapJsonSourceMCmd (JsonSource.update JsonSourceMsg now Nothing message) + model |> mapJsonSourceMT (JsonSource.update JsonSourceMsg now Nothing message) |> Extra.unpackTM AmlSourceMsg storage name -> ( model, SourceId.generator |> Random.generate (Source.aml Conf.constants.virtualRelationSourceName now >> Project.create projects name >> CreateProjectTmp storage) ) @@ -83,7 +84,7 @@ update req now projects projectsLoaded urlOrganization msg model = ) Toast message -> - model |> mapToastsCmd (Toasts.update Toast message) + model |> mapToastsT (Toasts.update Toast message) |> Extra.unpackT JsMessage message -> model |> handleJsMessage req urlOrganization message diff --git a/frontend/src/PagesComponents/New/Init.elm b/frontend/src/PagesComponents/New/Init.elm index 66e69dfdb..daa0449f1 100644 --- a/frontend/src/PagesComponents/New/Init.elm +++ b/frontend/src/PagesComponents/New/Init.elm @@ -46,14 +46,14 @@ init urlOrganization query = } , Backend.getSamples GotSamples ] - ++ ((query |> Dict.get "database" |> Maybe.map (\value -> [ T.send (InitTab TabDatabase), T.sendAfter 1 (DatabaseSourceMsg (DatabaseSource.GetSchema value)) ])) - |> Maybe.orElse (query |> Dict.get "sql" |> Maybe.map (\value -> [ T.send (InitTab TabSql), T.sendAfter 1 (SqlSourceMsg (SqlSource.GetRemoteFile value)) ])) - |> Maybe.orElse (query |> Dict.get "prisma" |> Maybe.map (\value -> [ T.send (InitTab TabPrisma), T.sendAfter 1 (PrismaSourceMsg (PrismaSource.GetRemoteFile value)) ])) - |> Maybe.orElse (query |> Dict.get "json" |> Maybe.map (\value -> [ T.send (InitTab TabJson), T.sendAfter 1 (JsonSourceMsg (JsonSource.GetRemoteFile value)) ])) - |> Maybe.orElse (query |> Dict.get "empty" |> Maybe.map (\_ -> [ T.send (InitTab TabEmptyProject) ])) - |> Maybe.orElse (query |> Dict.get "project" |> Maybe.map (\value -> [ T.send (InitTab TabProject), T.sendAfter 1 (ProjectSourceMsg (ProjectSource.GetRemoteFile value)) ])) - |> Maybe.orElse (query |> Dict.get "sample" |> Maybe.map (\_ -> [ T.send (InitTab TabSamples) ])) - |> Maybe.withDefault [ T.send (InitTab TabDatabase) ] + ++ ((query |> Dict.get "database" |> Maybe.map (\value -> [ InitTab TabDatabase |> T.send, DatabaseSourceMsg (DatabaseSource.GetSchema value) |> T.sendAfter 1 ])) + |> Maybe.orElse (query |> Dict.get "sql" |> Maybe.map (\value -> [ InitTab TabSql |> T.send, SqlSourceMsg (SqlSource.GetRemoteFile value) |> T.sendAfter 1 ])) + |> Maybe.orElse (query |> Dict.get "prisma" |> Maybe.map (\value -> [ InitTab TabPrisma |> T.send, PrismaSourceMsg (PrismaSource.GetRemoteFile value) |> T.sendAfter 1 ])) + |> Maybe.orElse (query |> Dict.get "json" |> Maybe.map (\value -> [ InitTab TabJson |> T.send, JsonSourceMsg (JsonSource.GetRemoteFile value) |> T.sendAfter 1 ])) + |> Maybe.orElse (query |> Dict.get "empty" |> Maybe.map (\_ -> [ InitTab TabEmptyProject |> T.send ])) + |> Maybe.orElse (query |> Dict.get "project" |> Maybe.map (\value -> [ InitTab TabProject |> T.send, ProjectSourceMsg (ProjectSource.GetRemoteFile value) |> T.sendAfter 1 ])) + |> Maybe.orElse (query |> Dict.get "sample" |> Maybe.map (\_ -> [ InitTab TabSamples |> T.send ])) + |> Maybe.withDefault [ InitTab TabDatabase |> T.send ] ) ) ) diff --git a/frontend/src/PagesComponents/New/Models.elm b/frontend/src/PagesComponents/New/Models.elm index e1044ed42..a9666978b 100644 --- a/frontend/src/PagesComponents/New/Models.elm +++ b/frontend/src/PagesComponents/New/Models.elm @@ -87,5 +87,5 @@ confirm title content message = , message = content , confirm = "Yes!" , cancel = "Nope" - , onConfirm = T.send message + , onConfirm = message |> T.send } diff --git a/frontend/src/PagesComponents/New/Updates.elm b/frontend/src/PagesComponents/New/Updates.elm index 5818fffb2..14ae9e878 100644 --- a/frontend/src/PagesComponents/New/Updates.elm +++ b/frontend/src/PagesComponents/New/Updates.elm @@ -18,13 +18,14 @@ import Models.Project.SourceId as SourceId import Models.ProjectInfo exposing (ProjectInfo) import Models.SourceInfo as SourceInfo import PagesComponents.New.Models exposing (Model, Msg(..), Tab(..)) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra import Ports exposing (JsMsg(..)) import Random import Request import Services.Backend as Backend import Services.DatabaseSource as DatabaseSource import Services.JsonSource as JsonSource -import Services.Lenses exposing (mapDatabaseSourceMCmd, mapJsonSourceMCmd, mapOpenedDialogs, mapPrismaSourceMCmd, mapProjectSourceMCmd, mapSampleSourceMCmd, mapSqlSourceMCmd, mapToastsCmd, setConfirm) +import Services.Lenses exposing (mapDatabaseSourceMT, mapJsonSourceMT, mapOpenedDialogs, mapPrismaSourceMT, mapProjectSourceMTW, mapSampleSourceMTW, mapSqlSourceMT, mapToastsT, setConfirm) import Services.PrismaSource as PrismaSource import Services.ProjectSource as ProjectSource import Services.SampleSource as SampleSource @@ -87,7 +88,7 @@ update req now projects urlOrganization msg model = ) DatabaseSourceMsg message -> - (model |> mapDatabaseSourceMCmd (DatabaseSource.update DatabaseSourceMsg now Nothing message)) + (model |> mapDatabaseSourceMT (DatabaseSource.update DatabaseSourceMsg now Nothing message) |> Extra.unpackTM) |> Tuple.mapSecond (\cmd -> case message of @@ -99,23 +100,23 @@ update req now projects urlOrganization msg model = ) SqlSourceMsg message -> - (model |> mapSqlSourceMCmd (SqlSource.update SqlSourceMsg now Nothing message)) + (model |> mapSqlSourceMT (SqlSource.update SqlSourceMsg now Nothing message) |> Extra.unpackTM) |> Tuple.mapSecond (\cmd -> B.cond (message == SqlSource.BuildSource) (Cmd.batch [ cmd, Ports.confetti "create-project-btn" ]) cmd) PrismaSourceMsg message -> - (model |> mapPrismaSourceMCmd (PrismaSource.update PrismaSourceMsg now Nothing message)) + (model |> mapPrismaSourceMT (PrismaSource.update PrismaSourceMsg now Nothing message) |> Extra.unpackTM) |> Tuple.mapSecond (\cmd -> B.cond (message == PrismaSource.BuildSource) (Cmd.batch [ cmd, Ports.confetti "create-project-btn" ]) cmd) JsonSourceMsg message -> - (model |> mapJsonSourceMCmd (JsonSource.update JsonSourceMsg now Nothing message)) + (model |> mapJsonSourceMT (JsonSource.update JsonSourceMsg now Nothing message) |> Extra.unpackTM) |> Tuple.mapSecond (\cmd -> B.cond (message == JsonSource.BuildSource) (Cmd.batch [ cmd, Ports.confetti "create-project-btn" ]) cmd) ProjectSourceMsg message -> - (model |> mapProjectSourceMCmd (ProjectSource.update ProjectSourceMsg message)) + (model |> mapProjectSourceMTW (ProjectSource.update ProjectSourceMsg message) Cmd.none) |> Tuple.mapSecond (\cmd -> B.cond (message == ProjectSource.BuildProject) (Cmd.batch [ cmd, Ports.confetti "create-project-btn" ]) cmd) SampleSourceMsg message -> - (model |> mapSampleSourceMCmd (SampleSource.update SampleSourceMsg message)) + (model |> mapSampleSourceMTW (SampleSource.update SampleSourceMsg message) Cmd.none) |> Tuple.mapSecond (\cmd -> B.cond (message == SampleSource.BuildProject) (Cmd.batch [ cmd, Ports.confetti "create-project-btn" ]) cmd) CreateProjectTmp project -> @@ -128,10 +129,10 @@ update req now projects urlOrganization msg model = ( model |> Dropdown.update id, Cmd.none ) Toast message -> - model |> mapToastsCmd (Toasts.update Toast message) + model |> mapToastsT (Toasts.update Toast message) |> Extra.unpackT ConfirmOpen confirm -> - ( model |> setConfirm (Just { id = Conf.ids.confirmDialog, content = confirm }), T.sendAfter 1 (ModalOpen Conf.ids.confirmDialog) ) + ( model |> setConfirm (Just { id = Conf.ids.confirmDialog, content = confirm }), ModalOpen Conf.ids.confirmDialog |> T.sendAfter 1 ) ConfirmAnswer answer cmd -> ( model |> setConfirm Nothing, B.cond answer cmd Cmd.none ) @@ -140,7 +141,7 @@ update req now projects urlOrganization msg model = ( model |> mapOpenedDialogs (\dialogs -> id :: dialogs), Ports.autofocusWithin id ) ModalClose message -> - ( model |> mapOpenedDialogs (List.drop 1), T.sendAfter Conf.ui.closeDuration message ) + ( model |> mapOpenedDialogs (List.drop 1), message |> T.sendAfter Conf.ui.closeDuration ) JsMessage message -> model |> handleJsMessage req now urlOrganization message @@ -154,7 +155,7 @@ handleJsMessage req now urlOrganization msg model = case msg of GotLocalFile kind file content -> if kind == ProjectSource.kind then - ( model, T.send (content |> ProjectSource.GotFile |> ProjectSourceMsg) ) + ( model, content |> ProjectSource.GotFile |> ProjectSourceMsg |> T.send ) else if kind == SqlSource.kind then ( model, SourceId.generator |> Random.generate (\sourceId -> content |> SqlSource.GotFile (SourceInfo.sqlLocal now sourceId file) |> SqlSourceMsg) ) @@ -173,7 +174,7 @@ handleJsMessage req now urlOrganization msg model = ( model, Request.pushRoute (Route.Organization___Project_ { organization = urlOrganization |> Maybe.withDefault OrganizationId.zero, project = ProjectId.zero }) req ) else - ( model, T.send (project |> SampleSource.GotProject |> SampleSourceMsg) ) + ( model, project |> SampleSource.GotProject |> SampleSourceMsg |> T.send ) GotDatabaseSchema schema -> ( model, Ok schema |> DatabaseSource.GotSchema |> DatabaseSourceMsg |> T.send ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/AmlSidebar.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/AmlSidebar.elm index add401eb4..de5a25128 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/AmlSidebar.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/AmlSidebar.elm @@ -18,7 +18,7 @@ import Libs.List as List import Libs.Maybe as Maybe import Libs.Models.HtmlId exposing (HtmlId) import Libs.Tailwind as Tw exposing (focus) -import Libs.Task as T +import Libs.Tuple as Tuple import Models.Position as Position import Models.Project.ColumnId as ColumnId import Models.Project.ColumnPath as ColumnPath @@ -35,8 +35,10 @@ import PagesComponents.Organization_.Project_.Models.ErdTable as ErdTable import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint(..)) import PagesComponents.Organization_.Project_.Models.ShowColumns as ShowColumns -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyCmd) -import Services.Lenses exposing (mapAmlSidebarM, mapErdM, setAmlSidebar, setContent, setErrors, setSelected, setUpdatedAt) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Table exposing (hideTable, showColumns, showTable) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyM) +import Services.Lenses exposing (mapAmlSidebarM, mapAmlSidebarMTM, mapErdM, mapErdMT, mapSelectedMT, setAmlSidebar, setContent, setErrors, setSelected, setUpdatedAt) import Set exposing (Set) import Time import Track @@ -57,17 +59,16 @@ type alias Model x = init : Maybe SourceId -> Maybe Erd -> AmlSidebar -init id erd = +init sourceId erd = let - selectedId : Maybe SourceId - selectedId = - id - |> Maybe.orElse (erd |> Maybe.andThen (.sources >> List.find (\s -> s.enabled && SourceKind.isUser s.kind)) |> Maybe.map .id) + selected : Maybe SourceId + selected = + sourceId |> Maybe.orElse (erd |> Maybe.andThen (.sources >> List.find (\s -> s.enabled && SourceKind.isUser s.kind)) |> Maybe.map .id) in { id = Conf.ids.amlSidebarDialog - , selected = selectedId + , selected = selected |> Maybe.andThen (buildSelected erd) , errors = [] - , otherSourcesTableIdsCache = getOtherSourcesTableIds selectedId erd + , otherSourcesTableIdsCache = getOtherSourcesTableIds selected erd } @@ -75,34 +76,33 @@ init id erd = -- UPDATE -update : Time.Posix -> AmlSidebarMsg -> Model x -> ( Model x, Cmd Msg ) +update : Time.Posix -> AmlSidebarMsg -> Model x -> ( Model x, Extra Msg ) update now msg model = case msg of AOpen id -> - ( model |> setAmlSidebar (Just (init id model.erd)), Track.sourceEditorOpened model.erd ) + ( model |> setAmlSidebar (Just (init id model.erd)), Track.sourceEditorOpened model.erd |> Extra.cmd ) AClose -> - ( model |> setAmlSidebar Nothing, Track.sourceEditorClosed model.erd ) + ( model |> setAmlSidebar Nothing, Track.sourceEditorClosed model.erd |> Extra.cmd ) AToggle -> - ( model, T.send (AmlSidebarMsg (Bool.cond (model.amlSidebar == Nothing) (AOpen Nothing) AClose)) ) + ( model, Bool.cond (model.amlSidebar == Nothing) (AOpen Nothing) AClose |> AmlSidebarMsg |> Extra.msg ) - AChangeSource source -> - ( model |> mapAmlSidebarM (setSelected source) |> setOtherSourcesTableIdsCache source - , Cmd.none - ) + AChangeSource sourceId -> + ( model |> mapAmlSidebarM (setSelected (sourceId |> Maybe.andThen (buildSelected model.erd))) |> setOtherSourcesTableIdsCache sourceId, Extra.none ) AUpdateSource id value -> - model.erd - |> Maybe.andThen (.sources >> List.findBy .id id) - |> Maybe.map (\s -> model |> updateSource now s value |> setDirtyCmd) - |> Maybe.withDefault ( model |> mapAmlSidebarM (setErrors [ { row = 0, col = 0, problem = "Invalid source" } ]), Cmd.none ) + (model.erd |> Maybe.andThen (.sources >> List.findBy .id id)) + |> Maybe.map (\s -> model |> updateSource now s value |> setDirty) + |> Maybe.withDefault ( model |> mapAmlSidebarM (setErrors [ { row = 0, col = 0, problem = "Invalid source" } ]), Extra.none ) ASourceUpdated id -> - ( model, model.erd |> Maybe.andThen (.sources >> List.findBy .id id >> Maybe.map (Track.sourceRefreshed model.erd)) |> Maybe.withDefault Cmd.none ) + (model.erd |> Maybe.andThen (.sources >> List.findBy .id id)) + |> Maybe.map (\source -> model |> mapAmlSidebarMTM (mapSelectedMT (Tuple.mapSecondT (\old -> source |> contentStr |> (\new -> ( new, Extra.new (Track.sourceRefreshed model.erd source) (( AUpdateSource source.id old, AUpdateSource source.id new ) |> Tuple.map AmlSidebarMsg) ))))) |> Extra.defaultT) + |> Maybe.withDefault ( model, Extra.none ) -updateSource : Time.Posix -> Source -> String -> Model x -> ( Model x, Cmd Msg ) +updateSource : Time.Posix -> Source -> String -> Model x -> ( Model x, Extra Msg ) updateSource now source input model = let tableLayouts : List ErdTableLayout @@ -148,18 +148,18 @@ updateSource now source input model = ) in if List.nonEmpty errors then - ( model |> mapErdM (Erd.mapSource source.id (setContent content >> setUpdatedAt now)) |> mapAmlSidebarM (setErrors errors), Cmd.none ) + ( model |> mapAmlSidebarM (setErrors errors) |> mapErdM (Erd.mapSource source.id (setContent content >> setUpdatedAt now)), Extra.none ) else - ( model |> mapErdM (Erd.mapSource source.id (Source.refreshWith parsed)) |> mapAmlSidebarM (setErrors []) - , Cmd.batch - (List.map T.send - ((toShow |> List.map (\( id, hint ) -> ShowTable id hint "aml")) - ++ (toHide |> List.map HideTable) - ++ (updated |> List.map (\t -> ShowColumns t.id (ShowColumns.List (amlColumns |> Dict.getOrElse t.id [])))) - ) - ) - ) + let + apply : List a -> (a -> Model x -> ( Model x, Extra Msg )) -> ( Model x, Extra Msg ) -> ( Model x, Extra Msg ) + apply items f m = + items |> List.foldl (\a ( curModel, curExtra ) -> curModel |> f a |> Tuple.mapSecond (Extra.combine curExtra >> Extra.dropHistory)) m + in + ( model |> mapAmlSidebarM (setErrors []) |> mapErdM (Erd.mapSource source.id (Source.refreshWith parsed)), Extra.none ) + |> apply toShow (\( id, hint ) -> mapErdMT (showTable now id hint "aml") >> setDirtyM) + |> apply toHide (\id -> mapErdMT (hideTable now id) >> setDirtyM) + |> apply updated (\t -> mapErdMT (showColumns now t.id (ShowColumns.List (amlColumns |> Dict.getOrElse t.id []))) >> setDirtyM) associateTables : List Table -> List Table -> List ( Table, Maybe Table ) @@ -173,7 +173,7 @@ associateTables removed added = setSource : Maybe Source -> AmlSidebar -> AmlSidebar setSource source model = - model |> setSelected (source |> Maybe.map .id) + model |> setSelected (source |> Maybe.map (\s -> ( s.id, s |> contentStr ))) setOtherSourcesTableIdsCache : Maybe SourceId -> Model x -> Model x @@ -181,6 +181,11 @@ setOtherSourcesTableIdsCache sourceId model = model |> mapAmlSidebarM (\v -> { v | otherSourcesTableIdsCache = getOtherSourcesTableIds sourceId model.erd }) +buildSelected : Maybe Erd -> SourceId -> Maybe ( SourceId, String ) +buildSelected erd sourceId = + erd |> Maybe.andThen (.sources >> List.findBy .id sourceId) |> Maybe.map (\s -> ( s.id, s |> contentStr )) + + contentSplit : String -> Array String contentSplit input = input |> String.split "\n" |> Array.fromList @@ -218,7 +223,7 @@ view erd model = selectedSource : Maybe Source selectedSource = - model.selected |> Maybe.andThen (\id -> userSources |> List.find (\s -> s.id == id)) + model.selected |> Maybe.andThen (\( id, _ ) -> userSources |> List.findBy .id id) warnings : List String warnings = diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/DetailsSidebar.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/DetailsSidebar.elm index 03f302654..79cae8668 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/DetailsSidebar.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/DetailsSidebar.elm @@ -16,7 +16,6 @@ import Libs.Models.DatabaseUrl exposing (DatabaseUrl) import Libs.Models.HtmlId exposing (HtmlId) import Libs.Models.Notes exposing (Notes) import Libs.Models.Tag as Tag exposing (Tag) -import Libs.Task as T import Models.Project.ColumnId as ColumnId exposing (ColumnId) import Models.Project.ColumnPath as ColumnPath exposing (ColumnPath) import Models.Project.ColumnRef exposing (ColumnRef) @@ -36,6 +35,7 @@ import PagesComponents.Organization_.Project_.Models.ErdTable as ErdTable exposi import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.NotesMsg exposing (NotesMsg(..)) import PagesComponents.Organization_.Project_.Models.TagsMsg exposing (TagsMsg(..)) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Lenses exposing (setEditNotes, setSearch, setView) import Task @@ -99,50 +99,50 @@ init v = -- UPDATE -update : (String -> msg) -> (NotesMsg -> msg) -> (TagsMsg -> msg) -> Erd -> Msg -> Maybe Model -> ( Maybe Model, Cmd msg ) +update : (String -> msg) -> (NotesMsg -> msg) -> (TagsMsg -> msg) -> Erd -> Msg -> Maybe Model -> ( Maybe Model, Extra msg ) update noop notesMsg tagsMsg erd msg model = case msg of Toggle -> - model |> Maybe.mapOrElse (\_ -> ( Nothing, Track.detailSidebarClosed erd )) ( listView |> init |> Just, Track.detailSidebarOpened "table-list" erd ) + model |> Maybe.mapOrElse (\_ -> ( Nothing, Track.detailSidebarClosed erd )) ( listView |> init |> Just, Track.detailSidebarOpened "table-list" erd ) |> Extra.cmdT Close -> - ( Nothing, Track.detailSidebarClosed erd ) + ( Nothing, Track.detailSidebarClosed erd |> Extra.cmd ) SearchUpdate search -> - ( model |> Maybe.map (setSearch search), Cmd.none ) + ( model |> Maybe.map (setSearch search), Extra.none ) ShowList -> - ( model |> setViewM listView, Track.detailSidebarOpened "table-list" erd ) + ( model |> setViewM listView, Track.detailSidebarOpened "table-list" erd |> Extra.cmd ) ShowSchema schema -> - ( model |> setViewM (schemaView erd schema), Track.detailSidebarOpened "schema" erd ) + ( model |> setViewM (schemaView erd schema), Track.detailSidebarOpened "schema" erd |> Extra.cmd ) ShowTable table -> - ( model |> setViewM (tableView erd table), Cmd.batch (Track.detailSidebarOpened "table" erd :: (erd.sources |> filterTableDbSources table |> List.map (Ports.getTableStats table))) ) + ( model |> setViewM (tableView erd table), (Track.detailSidebarOpened "table" erd :: (erd.sources |> filterTableDbSources table |> List.map (Ports.getTableStats table))) |> Extra.cmdL ) ShowColumn column -> - ( model |> setViewM (columnView erd column), Cmd.batch (Track.detailSidebarOpened "column" erd :: (erd.sources |> filterColumnDbSources column |> List.map (Ports.getColumnStats column))) ) + ( model |> setViewM (columnView erd column), (Track.detailSidebarOpened "column" erd :: (erd.sources |> filterColumnDbSources column |> List.map (Ports.getColumnStats column))) |> Extra.cmdL ) ToggleCollapse id -> - ( model |> Maybe.map (\m -> { m | openedCollapse = Bool.cond (m.openedCollapse == id) "" id }), Cmd.none ) + ( model |> Maybe.map (\m -> { m | openedCollapse = Bool.cond (m.openedCollapse == id) "" id }), Extra.none ) EditNotes id content -> - ( model |> Maybe.map (\m -> { m | editNotes = Just content }), Dom.focus id |> Task.attempt (\_ -> noop "focus-notes-input") ) + ( model |> Maybe.map (\m -> { m | editNotes = Just content }), Dom.focus id |> Task.attempt (\_ -> noop "focus-notes-input") |> Extra.cmd ) EditNotesUpdate content -> - ( model |> Maybe.map (\m -> { m | editNotes = m.editNotes |> Maybe.map (\_ -> content) }), Cmd.none ) + ( model |> Maybe.map (\m -> { m | editNotes = m.editNotes |> Maybe.map (\_ -> content) }), Extra.none ) SaveNotes table column initialNotes updatedNotes -> - ( model |> Maybe.map (\m -> { m | editNotes = Nothing }), NSave table column initialNotes updatedNotes |> notesMsg |> T.send ) + ( model |> Maybe.map (\m -> { m | editNotes = Nothing }), NSave table column initialNotes updatedNotes |> notesMsg |> Extra.msg ) EditTags id tags -> - ( model |> Maybe.map (\m -> { m | editTags = tags |> Tag.tagsToString |> Just }), Dom.focus id |> Task.attempt (\_ -> noop "focus-tags-input") ) + ( model |> Maybe.map (\m -> { m | editTags = tags |> Tag.tagsToString |> Just }), Dom.focus id |> Task.attempt (\_ -> noop "focus-tags-input") |> Extra.cmd ) EditTagsUpdate content -> - ( model |> Maybe.map (\m -> { m | editTags = m.editTags |> Maybe.map (\_ -> content) }), Cmd.none ) + ( model |> Maybe.map (\m -> { m | editTags = m.editTags |> Maybe.map (\_ -> content) }), Extra.none ) SaveTags tableId columnPath initialTags updatedTags -> - ( model |> Maybe.map (\m -> { m | editTags = Nothing }), TSave tableId columnPath initialTags updatedTags |> tagsMsg |> T.send ) + ( model |> Maybe.map (\m -> { m | editTags = Nothing }), TSave tableId columnPath initialTags updatedTags |> tagsMsg |> Extra.msg ) setViewM : View -> Maybe Model -> Maybe Model diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/EmbedSourceParsingDialog.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/EmbedSourceParsingDialog.elm index 73a7e8849..e7825ce95 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/EmbedSourceParsingDialog.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/EmbedSourceParsingDialog.elm @@ -14,9 +14,10 @@ import Libs.Result as Result import Libs.Tailwind as Tw import Models.Project.Source exposing (Source) import Models.ProjectInfo exposing (ProjectInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.DatabaseSource as DatabaseSource import Services.JsonSource as JsonSource -import Services.Lenses exposing (mapDatabaseSourceMCmd, mapJsonSourceMCmd, mapPrismaSourceMCmd, mapSqlSourceMCmd) +import Services.Lenses exposing (mapDatabaseSourceMT, mapJsonSourceMT, mapPrismaSourceMT, mapSqlSourceMT) import Services.PrismaSource as PrismaSource import Services.SqlSource as SqlSource import Time @@ -76,20 +77,20 @@ init sourceParsed modalClose noop databaseSource sqlSource prismaSource jsonSour -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Extra msg ) update wrap now project msg model = case msg of EmbedDatabaseSource message -> - model |> mapDatabaseSourceMCmd (DatabaseSource.update (EmbedDatabaseSource >> wrap) now project message) + model |> mapDatabaseSourceMT (DatabaseSource.update (EmbedDatabaseSource >> wrap) now project message) |> Extra.defaultT EmbedSqlSource message -> - model |> mapSqlSourceMCmd (SqlSource.update (EmbedSqlSource >> wrap) now project message) + model |> mapSqlSourceMT (SqlSource.update (EmbedSqlSource >> wrap) now project message) |> Extra.defaultT EmbedPrismaSource message -> - model |> mapPrismaSourceMCmd (PrismaSource.update (EmbedPrismaSource >> wrap) now project message) + model |> mapPrismaSourceMT (PrismaSource.update (EmbedPrismaSource >> wrap) now project message) |> Extra.defaultT EmbedJsonSource message -> - model |> mapJsonSourceMCmd (JsonSource.update (EmbedJsonSource >> wrap) now project message) + model |> mapJsonSourceMT (JsonSource.update (EmbedJsonSource >> wrap) now project message) |> Extra.defaultT diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/ExportDialog.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/ExportDialog.elm index a3878a1e2..d944dc029 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/ExportDialog.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/ExportDialog.elm @@ -8,7 +8,8 @@ import Libs.Task as T import Models.ProjectRef exposing (ProjectRef) import Models.UrlInfos exposing (UrlInfos) import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd) -import Services.Lenses exposing (mapBodyCmd, mapMCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import Services.Lenses exposing (mapBodyT, mapMT) dialogId : HtmlId @@ -31,17 +32,17 @@ init = { id = dialogId, body = ExportDialogBody.init dialogId } -update : (Msg -> msg) -> (HtmlId -> msg) -> UrlInfos -> Erd -> Msg -> Maybe Model -> ( Maybe Model, Cmd msg ) +update : (Msg -> msg) -> (HtmlId -> msg) -> UrlInfos -> Erd -> Msg -> Maybe Model -> ( Maybe Model, Extra msg ) update wrap modalOpen urlInfos erd msg model = case msg of Open -> - ( Just init, Cmd.batch [ T.sendAfter 1 (modalOpen dialogId) ] ) + ( Just init, modalOpen dialogId |> T.sendAfter 1 |> Extra.cmd ) Close -> - ( Nothing, Cmd.none ) + ( Nothing, Extra.none ) BodyMsg message -> - model |> mapMCmd (mapBodyCmd (ExportDialogBody.update (BodyMsg >> wrap) urlInfos erd message)) + model |> mapMT (mapBodyT (ExportDialogBody.update (BodyMsg >> wrap) urlInfos erd message)) |> Extra.defaultT view : (Msg -> msg) -> (Cmd msg -> msg) -> (msg -> msg) -> Bool -> ProjectRef -> Model -> Html msg diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSaveDialog.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSaveDialog.elm index 07be2ada4..4f9a2abdc 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSaveDialog.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSaveDialog.elm @@ -12,6 +12,7 @@ import Models.Project.ProjectName exposing (ProjectName) import Models.Project.ProjectStorage exposing (ProjectStorage) import Models.User exposing (User) import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.Backend as Backend import Url exposing (Url) @@ -31,19 +32,19 @@ type Msg | BodyMsg ProjectSaveDialogBody.Msg -update : (HtmlId -> msg) -> Msg -> Maybe Model -> ( Maybe Model, Cmd msg ) +update : (HtmlId -> msg) -> Msg -> Maybe Model -> ( Maybe Model, Extra msg ) update modalOpen msg model = case msg of Open name orga -> ( ProjectSaveDialogBody.init dialogId name orga |> Just - , Cmd.batch [ T.sendAfter 1 (modalOpen dialogId) ] + , modalOpen dialogId |> T.sendAfter 1 |> Extra.cmd ) Close -> - ( Nothing, Cmd.none ) + ( Nothing, Extra.none ) BodyMsg m -> - model |> Maybe.mapOrElse (ProjectSaveDialogBody.update m >> Tuple.mapFirst Just) ( model, Cmd.none ) + model |> Maybe.mapOrElse (ProjectSaveDialogBody.update m >> Tuple.mapFirst Just) ( model, Extra.none ) view : (Msg -> msg) -> (msg -> msg) -> (ProjectName -> Organization -> ProjectStorage -> msg) -> Url -> Maybe User -> List Organization -> Bool -> Erd -> Model -> Html msg diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSharing.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSharing.elm index 2d791e4ff..668860f27 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSharing.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/ProjectSharing.elm @@ -39,6 +39,7 @@ import Models.UrlInfos exposing (UrlInfos) import PagesComponents.Organization_.Project_.Models.EmbedKind as EmbedKind exposing (EmbedKind) import PagesComponents.Organization_.Project_.Models.EmbedMode as EmbedMode exposing (EmbedModeId) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Backend as Backend import Services.DatabaseSource as DatabaseSource @@ -74,6 +75,7 @@ type Msg | Close | KindUpdate EmbedKind | ContentUpdate String + | LayoutUpdate LayoutName | EnableTokenForm | DisableTokenForm | GotTokens (Result Backend.Error (List ProjectToken)) @@ -84,7 +86,6 @@ type Msg | RevokeToken ProjectToken | TokenRevoked (Result Backend.Error ()) | TokenUpdate (Maybe ProjectToken) - | LayoutUpdate LayoutName | ModeUpdate EmbedModeId @@ -126,75 +127,75 @@ initTokenForm = -- UPDATE -update : (Msg -> msg) -> (HtmlId -> msg) -> (Toasts.Msg -> msg) -> Time.Zone -> Time.Posix -> Maybe Erd -> Msg -> Maybe Model -> ( Maybe Model, Cmd msg ) +update : (Msg -> msg) -> (HtmlId -> msg) -> (Toasts.Msg -> msg) -> Time.Zone -> Time.Posix -> Maybe Erd -> Msg -> Maybe Model -> ( Maybe Model, Extra msg ) update wrap modalOpen toast zone now erd msg model = case msg of Open -> - ( Just (init Conf.ids.sharingDialog erd), Cmd.batch [ T.sendAfter 1 (modalOpen Conf.ids.sharingDialog) ] ) + ( Just (init Conf.ids.sharingDialog erd), modalOpen Conf.ids.sharingDialog |> T.sendAfter 1 |> Extra.cmd ) Close -> - ( Nothing, Cmd.none ) + ( Nothing, Extra.none ) KindUpdate kind -> - ( model |> Maybe.map (\s -> { s | kind = kind, content = "", tokenForm = Nothing }), Cmd.none ) + ( model |> Maybe.map (\s -> { s | kind = kind, content = "", tokenForm = Nothing }), Extra.none ) ContentUpdate content -> - ( model |> Maybe.map (\s -> { s | content = content }), Cmd.none ) + ( model |> Maybe.map (\s -> { s | content = content }), Extra.none ) + + LayoutUpdate layout -> + ( model |> Maybe.map (\s -> { s | layout = layout }), Extra.none ) EnableTokenForm -> ( model |> Maybe.map (setTokenForm (Just initTokenForm)) , if erd |> Erd.getOrganizationM Nothing |> .plan |> .privateLinks then - erd |> Maybe.mapOrElse (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) Cmd.none + erd |> Maybe.map (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) |> Extra.cmdM else - Track.planLimit .privateLinks erd + Track.planLimit .privateLinks erd |> Extra.cmd ) DisableTokenForm -> - ( model |> Maybe.map (setTokenForm Nothing), Cmd.none ) + ( model |> Maybe.map (setTokenForm Nothing), Extra.none ) GotTokens (Ok tokens) -> - ( model |> Maybe.map (setTokens tokens), Cmd.none ) + ( model |> Maybe.map (setTokens tokens), Extra.none ) GotTokens (Err err) -> - ( model, err |> Backend.errorToString |> Toasts.create "warning" |> toast |> T.send ) + ( model, err |> Backend.errorToString |> Toasts.create "warning" |> toast |> Extra.msg ) TokenNameUpdate name -> - ( model |> Maybe.map (mapTokenFormM (setName name)), Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (setName name)), Extra.none ) TokenExpireUpdate expire -> - ( model |> Maybe.map (mapTokenFormM (setExpire expire)), Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (setExpire expire)), Extra.none ) CreateToken form -> ( model |> Maybe.map (mapTokenFormM (\f -> { f | loading = True, error = Nothing })) - , erd |> Maybe.mapOrElse (\e -> Backend.createProjectToken form.name (form.expire |> Maybe.map (\i -> Time.add i 1 zone now)) e.project (TokenCreated >> wrap)) Cmd.none + , erd |> Maybe.map (\e -> Backend.createProjectToken form.name (form.expire |> Maybe.map (\i -> Time.add i 1 zone now)) e.project (TokenCreated >> wrap)) |> Extra.cmdM ) TokenCreated (Ok _) -> ( model |> Maybe.map (mapTokenFormM (\f -> { f | name = "", expire = Nothing, loading = False, error = Nothing })) - , erd |> Maybe.mapOrElse (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) Cmd.none + , erd |> Maybe.map (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) |> Extra.cmdM ) TokenCreated (Err err) -> - ( model |> Maybe.map (mapTokenFormM (\f -> { f | loading = False, error = err |> Backend.errorToString |> Just })), Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (\f -> { f | loading = False, error = err |> Backend.errorToString |> Just })), Extra.none ) RevokeToken token -> - ( model |> Maybe.map (mapTokenFormM (\f -> { f | error = Nothing })), erd |> Maybe.mapOrElse (\e -> Backend.revokeProjectToken token e.project (TokenRevoked >> wrap)) Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (\f -> { f | error = Nothing })), erd |> Maybe.map (\e -> Backend.revokeProjectToken token e.project (TokenRevoked >> wrap)) |> Extra.cmdM ) TokenRevoked (Ok _) -> - ( model, erd |> Maybe.mapOrElse (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) Cmd.none ) + ( model, erd |> Maybe.map (\e -> Backend.getProjectTokens e.project (GotTokens >> wrap)) |> Extra.cmdM ) TokenRevoked (Err err) -> - ( model |> Maybe.map (mapTokenFormM (\f -> { f | error = err |> Backend.errorToString |> Just })), Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (\f -> { f | error = err |> Backend.errorToString |> Just })), Extra.none ) TokenUpdate token -> - ( model |> Maybe.map (mapTokenFormM (setToken token)), Cmd.none ) - - LayoutUpdate layout -> - ( model |> Maybe.map (\s -> { s | layout = layout }), Cmd.none ) + ( model |> Maybe.map (mapTokenFormM (setToken token)), Extra.none ) ModeUpdate mode -> - ( model |> Maybe.map (\s -> { s | mode = mode }), Cmd.none ) + ( model |> Maybe.map (\s -> { s | mode = mode }), Extra.none ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Components/SourceUpdateDialog.elm b/frontend/src/PagesComponents/Organization_/Project_/Components/SourceUpdateDialog.elm index af3fafe40..4727b2ebf 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Components/SourceUpdateDialog.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Components/SourceUpdateDialog.elm @@ -23,10 +23,11 @@ import Libs.Task as T import Models.Project.Source exposing (Source) import Models.Project.SourceKind exposing (SourceKind(..)) import Models.ProjectInfo exposing (ProjectInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.AmlSource as AmlSource import Services.DatabaseSource as DatabaseSource import Services.JsonSource as JsonSource -import Services.Lenses exposing (mapAmlSourceCmd, mapDatabaseSourceCmd, mapJsonSourceCmd, mapMCmd, mapPrismaSourceCmd, mapSqlSourceCmd) +import Services.Lenses exposing (mapAmlSourceT, mapDatabaseSourceT, mapJsonSourceT, mapMT, mapPrismaSourceT, mapSqlSourceT) import Services.PrismaSource as PrismaSource import Services.SourceDiff as SourceDiff import Services.SqlSource as SqlSource @@ -77,32 +78,32 @@ init noop dialogId source = } -update : (Msg -> msg) -> (HtmlId -> msg) -> (String -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Maybe (Model msg) -> ( Maybe (Model msg), Cmd msg ) +update : (Msg -> msg) -> (HtmlId -> msg) -> (String -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Maybe (Model msg) -> ( Maybe (Model msg), Extra msg ) update wrap modalOpen noop now project msg model = case msg of Open source -> - ( Just (init noop Conf.ids.sourceUpdateDialog source), T.sendAfter 1 (modalOpen Conf.ids.sourceUpdateDialog) ) + ( Just (init noop Conf.ids.sourceUpdateDialog source), modalOpen Conf.ids.sourceUpdateDialog |> T.sendAfter 1 |> Extra.cmd ) Close -> - ( Nothing, Cmd.none ) + ( Nothing, Extra.none ) DatabaseSourceMsg message -> - model |> mapMCmd (mapDatabaseSourceCmd (DatabaseSource.update (DatabaseSourceMsg >> wrap) now project message)) + model |> mapMT (mapDatabaseSourceT (DatabaseSource.update (DatabaseSourceMsg >> wrap) now project message)) |> Extra.defaultT SqlSourceMsg message -> - model |> mapMCmd (mapSqlSourceCmd (SqlSource.update (SqlSourceMsg >> wrap) now project message)) + model |> mapMT (mapSqlSourceT (SqlSource.update (SqlSourceMsg >> wrap) now project message)) |> Extra.defaultT PrismaSourceMsg message -> - model |> mapMCmd (mapPrismaSourceCmd (PrismaSource.update (PrismaSourceMsg >> wrap) now project message)) + model |> mapMT (mapPrismaSourceT (PrismaSource.update (PrismaSourceMsg >> wrap) now project message)) |> Extra.defaultT JsonSourceMsg message -> - model |> mapMCmd (mapJsonSourceCmd (JsonSource.update (JsonSourceMsg >> wrap) now project message)) + model |> mapMT (mapJsonSourceT (JsonSource.update (JsonSourceMsg >> wrap) now project message)) |> Extra.defaultT AmlSourceMsg message -> - model |> mapMCmd (mapAmlSourceCmd (AmlSource.update (AmlSourceMsg >> wrap) now project message)) + model |> mapMT (mapAmlSourceT (AmlSource.update (AmlSourceMsg >> wrap) now project message)) |> Extra.defaultT UpdateTab kind -> - ( model |> Maybe.map (\m -> { m | newSourceTab = kind }), Cmd.none ) + ( model |> Maybe.map (\m -> { m | newSourceTab = kind }), Extra.none ) view : (Msg -> msg) -> (Source -> msg) -> (msg -> msg) -> (String -> msg) -> Time.Zone -> Time.Posix -> Bool -> Model msg -> Html msg diff --git a/frontend/src/PagesComponents/Organization_/Project_/Models.elm b/frontend/src/PagesComponents/Organization_/Project_/Models.elm index db41d1062..0f52a7623 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Models.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Models.elm @@ -1,6 +1,7 @@ module PagesComponents.Organization_.Project_.Models exposing (AmlSidebar, AmlSidebarMsg(..), ConfirmDialog, ContextMenu, FindPathMsg(..), GroupEdit, GroupMsg(..), HelpDialog, HelpMsg(..), LayoutMsg(..), MemoEdit, MemoMsg(..), ModalDialog, Model, Msg(..), NavbarModel, NotesDialog, ProjectSettingsDialog, ProjectSettingsMsg(..), PromptDialog, SchemaAnalysisDialog, SchemaAnalysisMsg(..), SearchModel, VirtualRelation, VirtualRelationMsg(..), confirm, confirmDanger, emptyModel, prompt, simplePrompt) import Components.Atoms.Icon exposing (Icon(..)) +import Components.Organisms.Table exposing (TableHover) import Components.Organisms.TableRow as TableRow exposing (TableRowHover) import Components.Slices.DataExplorer as DataExplorer import Components.Slices.ProPlan as ProPlan @@ -16,17 +17,18 @@ import Libs.Models.HtmlId exposing (HtmlId) import Libs.Models.Notes exposing (Notes) import Libs.Tailwind as Tw exposing (Color) import Libs.Task as T -import Models.Area as Area import Models.ColumnOrder exposing (ColumnOrder) import Models.DbSourceInfo exposing (DbSourceInfo) import Models.ErdProps as ErdProps exposing (ErdProps) import Models.Organization exposing (Organization) import Models.Position as Position +import Models.Project.CanvasProps exposing (CanvasProps) import Models.Project.ColumnId exposing (ColumnId) 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) @@ -35,7 +37,7 @@ import Models.Project.Source exposing (Source) import Models.Project.SourceId exposing (SourceId, SourceIdStr) import Models.Project.SourceName exposing (SourceName) import Models.Project.TableId exposing (TableId) -import Models.Project.TableRow as TableRow +import Models.Project.TableRow as TableRow exposing (TableRow) import Models.Project.TableStats exposing (TableStats) import Models.ProjectInfo exposing (ProjectInfo) import Models.RelationStyle exposing (RelationStyle) @@ -48,9 +50,12 @@ import PagesComponents.Organization_.Project_.Components.SourceUpdateDialog as S import PagesComponents.Organization_.Project_.Models.CursorMode as CursorMode exposing (CursorMode) import PagesComponents.Organization_.Project_.Models.DragState exposing (DragState) 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) import PagesComponents.Organization_.Project_.Models.FindPathDialog exposing (FindPathDialog) import PagesComponents.Organization_.Project_.Models.HideColumns exposing (HideColumns) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) @@ -59,6 +64,7 @@ import PagesComponents.Organization_.Project_.Models.NotesMsg exposing (NotesMsg import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint) import PagesComponents.Organization_.Project_.Models.ShowColumns exposing (ShowColumns) import PagesComponents.Organization_.Project_.Models.TagsMsg exposing (TagsMsg) +import PagesComponents.Organization_.Project_.Views.Erd.SelectionBox as SelectionBox import PagesComponents.Organization_.Project_.Views.Modals.NewLayout as NewLayout import Ports exposing (JsMsg) import Services.Toasts as Toasts @@ -76,13 +82,10 @@ type alias Model = , erd : Maybe Erd , tableStats : Dict TableId (Dict SourceIdStr (Result String TableStats)) , columnStats : Dict ColumnId (Dict SourceIdStr (Result String ColumnStats)) - - -- TODO: merge `hoverTable` & `hoverColumn` into `hoverTable`, like `hoverTableRow` - , hoverTable : Maybe TableId - , hoverColumn : Maybe ColumnRef + , hoverTable : Maybe TableHover , hoverTableRow : Maybe TableRowHover , cursorMode : CursorMode - , selectionBox : Maybe Area.Canvas + , selectionBox : Maybe SelectionBox.Model , newLayout : Maybe NewLayout.Model , editNotes : Maybe NotesDialog , editTags : Maybe String @@ -112,6 +115,8 @@ type alias Model = , confirm : Maybe ConfirmDialog , prompt : Maybe PromptDialog , openedDialogs : List HtmlId + , history : List ( Msg, Msg ) + , future : List ( Msg, Msg ) } @@ -127,7 +132,6 @@ emptyModel = , tableStats = Dict.empty , columnStats = Dict.empty , hoverTable = Nothing - , hoverColumn = Nothing , hoverTableRow = Nothing , cursorMode = CursorMode.Select , selectionBox = Nothing @@ -158,6 +162,8 @@ emptyModel = , confirm = Nothing , prompt = Nothing , openedDialogs = [] + , history = [] + , future = [] } @@ -184,7 +190,7 @@ type alias MemoEdit = type alias AmlSidebar = - { id : HtmlId, selected : Maybe SourceId, errors : List AmlSchemaError, otherSourcesTableIdsCache : Set TableId } + { id : HtmlId, selected : Maybe ( SourceId, String ), errors : List AmlSchemaError, otherSourcesTableIdsCache : Set TableId } type alias VirtualRelation = @@ -196,7 +202,7 @@ type alias SchemaAnalysisDialog = type alias ProjectSettingsDialog = - { id : HtmlId, sourceNameEdit : Maybe SourceId } + { id : HtmlId, sourceNameEdit : Maybe ( SourceId, String ) } type alias HelpDialog = @@ -234,38 +240,50 @@ type Msg | ShowTables (List TableId) (Maybe PositionHint) String | ShowAllTables String | HideTable TableId + | UnHideTable_ Int ErdTableLayout | ShowRelatedTables TableId | HideRelatedTables TableId | ToggleTableCollapse TableId - | ShowColumn ColumnRef + | ShowColumn Int ColumnRef | HideColumn ColumnRef | ShowColumns TableId ShowColumns | HideColumns TableId HideColumns | SortColumns TableId ColumnOrder + | SetColumns_ TableId (List ErdColumnProps) | ToggleNestedColumn TableId ColumnPath Bool | ToggleHiddenColumns TableId | SelectItem HtmlId Bool + | SelectItems_ (List HtmlId) | SelectAll + | CanvasPosition Position.Diagram | TableMove TableId Delta | TablePosition TableId Position.Grid + | TableRowPosition TableRow.Id Position.Grid + | MemoPosition MemoId Position.Grid | TableOrder TableId Int - | TableColor TableId Color + | TableColor TableId Color Bool | MoveColumn ColumnRef Int - | ToggleHoverTable TableId Bool - | ToggleHoverColumn ColumnRef Bool + | HoverTable TableHover Bool | HoverTableRow TableRowHover Bool | CreateUserSource SourceName | CreateUserSourceWithId Source | CreateRelations (List { src : ColumnRef, ref : ColumnRef }) + | RemoveRelations_ SourceId (List { src : ColumnRef, ref : ColumnRef }) | IgnoreRelation ColumnRef + | UnIgnoreRelation_ ColumnRef | NewLayoutMsg NewLayout.Msg | LayoutMsg LayoutMsg + | FitToScreen + | SetView_ CanvasProps + | ArrangeTables + | SetLayout_ ErdLayout | NotesMsg NotesMsg | TagsMsg TagsMsg | GroupMsg GroupMsg | MemoMsg MemoMsg | ShowTableRow DbSourceInfo RowQuery (Maybe TableRow.SuccessState) (Maybe PositionHint) String | DeleteTableRow TableRow.Id + | UnDeleteTableRow_ Int TableRow | TableRowMsg TableRow.Id TableRow.Msg | AmlSidebarMsg AmlSidebarMsg | DetailsSidebarMsg DetailsSidebar.Msg @@ -282,8 +300,6 @@ type Msg | ProPlanColors ProPlan.ColorsModel ProPlan.ColorsMsg | HelpMsg HelpMsg | CursorMode CursorMode - | FitToScreen - | ArrangeTables | Fullscreen (Maybe HtmlId) | OnWheel WheelEvent | Zoom ZoomDelta @@ -298,7 +314,7 @@ type Msg | ContextMenuClose | DragStart DragId Position.Viewport | DragMove Position.Viewport - | DragEnd Position.Viewport + | DragEnd Bool Position.Viewport | DragCancel | Toast Toasts.Msg | ConfirmOpen (Confirm Msg) @@ -310,6 +326,8 @@ type Msg | ModalClose Msg | CustomModalOpen (Msg -> HtmlId -> Html Msg) | CustomModalClose + | Undo + | Redo | JsMessage JsMsg | Batch (List Msg) | Send (Cmd Msg) @@ -317,28 +335,31 @@ type Msg type LayoutMsg - = LLoad LayoutName + = LLoad String LayoutName | LDelete LayoutName + | LUnDelete_ LayoutName ErdLayout 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 - = MCreate Position.Canvas + = MCreate Position.Grid | MEdit Memo | MEditUpdate String - | MEditSave + | MEditSave MemoEdit | MSetColor MemoId (Maybe Color) | MDelete MemoId + | MUnDelete Int Memo type AmlSidebarMsg @@ -380,8 +401,9 @@ type ProjectSettingsMsg | PSClose | PSSourceToggle Source | PSSourceNameUpdate SourceId String - | PSSourceNameUpdateDone - | PSSourceDelete Source + | PSSourceNameUpdateDone SourceId String + | PSSourceDelete SourceId + | PSSourceUnDelete_ Int Source | PSSourceUpdate SourceUpdateDialog.Msg | PSSourceSet Source | PSDefaultSchemaUpdate SchemaName @@ -413,7 +435,7 @@ confirm title content message = , message = content , confirm = "Yes!" , cancel = "Nope" - , onConfirm = T.send message + , onConfirm = message |> T.send } @@ -426,7 +448,7 @@ confirmDanger title content message = , message = content , confirm = "Yes!" , cancel = "Nope" - , onConfirm = T.send message + , onConfirm = message |> T.send } diff --git a/frontend/src/PagesComponents/Organization_/Project_/Models/Erd.elm b/frontend/src/PagesComponents/Organization_/Project_/Models/Erd.elm index 24d451fa9..d14eae46e 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Models/Erd.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Models/Erd.elm @@ -1,4 +1,4 @@ -module PagesComponents.Organization_.Project_.Models.Erd exposing (Erd, canChangeColor, canCreateGroup, canCreateLayout, canCreateMemo, create, currentLayout, defaultSchemaM, getColumn, getColumnPos, getLayoutTable, getOrganization, getOrganizationM, getProjectId, getProjectIdM, getProjectRef, getProjectRefM, getTable, isShown, mapCurrentLayout, mapCurrentLayoutWithTime, mapCurrentLayoutWithTimeCmd, mapIgnoredRelations, mapSettings, mapSource, mapSources, setIgnoredRelations, setSettings, setSources, toSchema, unpack, viewportM, viewportToCanvas) +module PagesComponents.Organization_.Project_.Models.Erd exposing (Erd, canChangeColor, canCreateGroup, canCreateLayout, canCreateMemo, create, currentLayout, defaultSchemaM, getColumn, getColumnPos, getLayoutTable, getOrganization, getOrganizationM, getProjectId, getProjectIdM, getProjectRef, getProjectRefM, getTable, isShown, mapCurrentLayout, mapCurrentLayoutT, mapCurrentLayoutTMWithTime, mapCurrentLayoutTWithTime, mapCurrentLayoutWithTime, mapIgnoredRelationsT, mapSettings, mapSource, mapSourceT, mapSources, mapSourcesT, setIgnoredRelations, setSettings, setSources, toSchema, unpack, viewportM, viewportToCanvas) import Conf import Dict exposing (Dict) @@ -42,7 +42,7 @@ import PagesComponents.Organization_.Project_.Models.ErdTable as ErdTable exposi import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.SuggestedRelation exposing (SuggestedRelation) import Services.Analysis.MissingRelations as MissingRelations -import Services.Lenses exposing (mapLayoutsD, mapLayoutsDCmd) +import Services.Lenses exposing (mapLayoutsD, mapLayoutsDT, mapLayoutsDTM) import Set exposing (Set) import Time @@ -131,14 +131,24 @@ mapCurrentLayout transform erd = erd |> mapLayoutsD erd.currentLayout transform +mapCurrentLayoutT : (ErdLayout -> ( ErdLayout, a )) -> Erd -> ( Erd, Maybe a ) +mapCurrentLayoutT transform erd = + erd |> mapLayoutsDT erd.currentLayout transform + + mapCurrentLayoutWithTime : Time.Posix -> (ErdLayout -> ErdLayout) -> Erd -> Erd mapCurrentLayoutWithTime now transform erd = erd |> mapLayoutsD erd.currentLayout (transform >> (\l -> { l | updatedAt = now })) -mapCurrentLayoutWithTimeCmd : Time.Posix -> (ErdLayout -> ( ErdLayout, Cmd msg )) -> Erd -> ( Erd, Cmd msg ) -mapCurrentLayoutWithTimeCmd now transform erd = - erd |> mapLayoutsDCmd erd.currentLayout (transform >> Tuple.mapFirst (\l -> { l | updatedAt = now })) +mapCurrentLayoutTWithTime : Time.Posix -> (ErdLayout -> ( ErdLayout, a )) -> Erd -> ( Erd, Maybe a ) +mapCurrentLayoutTWithTime now transform erd = + erd |> mapLayoutsDT erd.currentLayout (transform >> Tuple.mapFirst (\l -> { l | updatedAt = now })) + + +mapCurrentLayoutTMWithTime : Time.Posix -> (ErdLayout -> ( ErdLayout, Maybe a )) -> Erd -> ( Erd, Maybe a ) +mapCurrentLayoutTMWithTime now transform erd = + erd |> mapLayoutsDTM erd.currentLayout (transform >> Tuple.mapFirst (\l -> { l | updatedAt = now })) getOrganization : Maybe OrganizationId -> Erd -> Organization @@ -364,11 +374,21 @@ mapSources transform erd = setSources (transform erd.sources) erd +mapSourcesT : (List Source -> ( List Source, t )) -> Erd -> ( Erd, t ) +mapSourcesT transform erd = + transform erd.sources |> Tuple.mapFirst (\s -> setSources s erd) + + mapSource : SourceId -> (Source -> Source) -> Erd -> Erd mapSource id transform erd = setSources (List.mapBy .id id transform erd.sources) erd +mapSourceT : SourceId -> (Source -> ( Source, t )) -> Erd -> ( Erd, Maybe t ) +mapSourceT id transform erd = + List.mapByT .id id transform erd.sources |> Tuple.mapBoth (\sources -> setSources sources erd) List.head + + setIgnoredRelations : Dict TableId (List ColumnPath) -> Erd -> Erd setIgnoredRelations ignoredRelations erd = if erd.ignoredRelations == ignoredRelations then @@ -378,9 +398,9 @@ setIgnoredRelations ignoredRelations erd = { erd | ignoredRelations = ignoredRelations } |> recomputeSources -mapIgnoredRelations : (Dict TableId (List ColumnPath) -> Dict TableId (List ColumnPath)) -> Erd -> Erd -mapIgnoredRelations transform erd = - setIgnoredRelations (transform erd.ignoredRelations) erd +mapIgnoredRelationsT : (Dict TableId (List ColumnPath) -> ( Dict TableId (List ColumnPath), a )) -> Erd -> ( Erd, a ) +mapIgnoredRelationsT transform erd = + transform erd.ignoredRelations |> Tuple.mapFirst (\r -> setIgnoredRelations r erd) setSettings : ProjectSettings -> Erd -> Erd diff --git a/frontend/src/PagesComponents/Organization_/Project_/Models/ErdColumnProps.elm b/frontend/src/PagesComponents/Organization_/Project_/Models/ErdColumnProps.elm index d28ae77a2..ba50e4d83 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Models/ErdColumnProps.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Models/ErdColumnProps.elm @@ -1,4 +1,4 @@ -module PagesComponents.Organization_.Project_.Models.ErdColumnProps exposing (ErdColumnProps, ErdColumnPropsFlat, ErdColumnPropsNested(..), add, children, createAll, createChildren, filter, find, flatten, getIndex, initAll, map, mapAll, mapAt, member, nest, remove, unpackAll) +module PagesComponents.Organization_.Project_.Models.ErdColumnProps exposing (ErdColumnProps, ErdColumnPropsFlat, ErdColumnPropsNested(..), children, createAll, createChildren, filter, find, flatten, getIndex, initAll, insertAt, map, mapAll, mapAt, mapAtTE, member, nest, remove, removeWithIndex, unpackAll) import Dict import Libs.List as List @@ -10,6 +10,7 @@ import Models.Project.ColumnPath as ColumnPath exposing (ColumnPath) import Models.Project.ProjectSettings as ProjectSettings exposing (ProjectSettings) import PagesComponents.Organization_.Project_.Models.ErdRelation exposing (ErdRelation) import PagesComponents.Organization_.Project_.Models.ErdTable exposing (ErdTable) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) type alias ErdColumnProps = @@ -134,14 +135,34 @@ remove path columns = ) -add : ColumnPath -> List ErdColumnProps -> List ErdColumnProps -add path columns = +removeWithIndex : ColumnPath -> List ErdColumnProps -> ( List ErdColumnProps, Maybe Int ) +removeWithIndex path columns = + columns + |> List.zipWithIndex + |> List.map + (\( c, i ) -> + if c.name == path.head then + path.tail |> Nel.fromList |> Maybe.map (\p -> c |> mapChildrenT (removeWithIndex p)) |> Maybe.withDefault ( c, Just i ) + + else + ( c, Nothing ) + ) + |> (\result -> + -- remove prop if found at depth of path + ( result |> List.filterMap (\( c, found ) -> found |> Maybe.filter (\_ -> path.tail |> List.isEmpty) |> Maybe.flipWith c) + , result |> List.filterMap Tuple.second |> List.head + ) + ) + + +insertAt : Int -> ColumnPath -> List ErdColumnProps -> List ErdColumnProps +insertAt index path columns = if columns |> List.memberBy .name path.head then columns |> List.map (\c -> if c.name == path.head then - path.tail |> Nel.fromList |> Maybe.mapOrElse (\p -> c |> mapChildren (add p)) c + path.tail |> Nel.fromList |> Maybe.mapOrElse (\p -> c |> mapChildren (insertAt index p)) c else c @@ -149,11 +170,11 @@ add path columns = else columns - ++ [ { name = path.head - , children = ErdColumnPropsNested (path.tail |> Nel.fromList |> Maybe.mapOrElse (\p -> [] |> add p) []) - , highlighted = False - } - ] + |> List.insertAt index + { name = path.head + , children = ErdColumnPropsNested (path.tail |> Nel.fromList |> Maybe.mapOrElse (\p -> [] |> insertAt index p) []) + , highlighted = False + } map : (ColumnPath -> ErdColumnProps -> ErdColumnProps) -> List ErdColumnProps -> List ErdColumnProps @@ -172,6 +193,12 @@ mapAt path f columns = path |> Maybe.mapOrElse (\p -> columns |> List.map (mapChildren (mapAt (p.tail |> Nel.fromList) f))) (f columns) +mapAtTE : Maybe ColumnPath -> (List ErdColumnProps -> ( List ErdColumnProps, Extra a )) -> List ErdColumnProps -> ( List ErdColumnProps, Extra a ) +mapAtTE path f columns = + -- apply `f` on columns under the given path + path |> Maybe.mapOrElse (\p -> columns |> List.mapT (mapChildrenT (mapAtTE (p.tail |> Nel.fromList) f)) |> Tuple.mapSecond Extra.concat) (f columns) + + mapAll : (Maybe ColumnPath -> List ErdColumnProps -> List ErdColumnProps) -> List ErdColumnProps -> List ErdColumnProps mapAll f columns = -- apply `f` everywhere in the nested structure @@ -201,3 +228,8 @@ children column = mapChildren : (List ErdColumnProps -> List ErdColumnProps) -> ErdColumnProps -> ErdColumnProps mapChildren f column = { column | children = column |> children |> f |> ErdColumnPropsNested } + + +mapChildrenT : (List ErdColumnProps -> ( List ErdColumnProps, a )) -> ErdColumnProps -> ( ErdColumnProps, a ) +mapChildrenT f column = + column |> children |> f |> (\( cols, a ) -> ( { column | children = cols |> ErdColumnPropsNested }, a )) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Models/ErdLayout.elm b/frontend/src/PagesComponents/Organization_/Project_/Models/ErdLayout.elm index 31de33f6d..a06362a3d 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Models/ErdLayout.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Models/ErdLayout.elm @@ -1,19 +1,21 @@ -module PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout, create, createMemo, empty, isEmpty, nonEmpty, unpack) +module PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout, ErdLayoutItem, create, createMemo, empty, getSelected, isEmpty, mapSelected, nonEmpty, setSelected, unpack) import Dict exposing (Dict) import Libs.Dict as Dict +import Libs.Models.HtmlId exposing (HtmlId) import Libs.Models.Size exposing (Size) import Models.Position as Position import Models.Project.CanvasProps as CanvasProps exposing (CanvasProps) import Models.Project.Group exposing (Group) import Models.Project.Layout exposing (Layout) -import Models.Project.TableId exposing (TableId) -import Models.Project.TableRow exposing (TableRow) +import Models.Project.TableId as TableId exposing (TableId) +import Models.Project.TableRow as TableRow exposing (TableRow) import Models.Size as Size import PagesComponents.Organization_.Project_.Models.ErdRelation exposing (ErdRelation) import PagesComponents.Organization_.Project_.Models.ErdTableLayout as ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) -import PagesComponents.Organization_.Project_.Models.MemoId exposing (MemoId) +import PagesComponents.Organization_.Project_.Models.MemoId as MemoId exposing (MemoId) +import Services.Lenses as Lenses exposing (mapMemos, mapProps, mapTableRows, mapTables) import Set import Time @@ -29,6 +31,10 @@ type alias ErdLayout = } +type alias ErdLayoutItem = + { id : HtmlId, position : Position.Grid, size : Size.Canvas } + + empty : Time.Posix -> ErdLayout empty now = { canvas = CanvasProps.empty @@ -74,7 +80,30 @@ unpack layout = } -createMemo : ErdLayout -> Position.Canvas -> Memo +getSelected : ErdLayout -> List HtmlId +getSelected layout = + (layout.tables |> List.filter (.props >> .selected) |> List.map (.id >> TableId.toHtmlId)) + ++ (layout.tableRows |> List.filter .selected |> List.map (.id >> TableRow.toHtmlId)) + ++ (layout.memos |> List.filter .selected |> List.map (.id >> MemoId.toHtmlId)) + + +setSelected : List HtmlId -> ErdLayout -> ErdLayout +setSelected htmlIds layout = + layout + |> mapTables (List.map (\t -> t |> mapProps (Lenses.mapSelected (\_ -> htmlIds |> List.member (TableId.toHtmlId t.id))))) + |> mapTableRows (List.map (\r -> r |> Lenses.mapSelected (\_ -> htmlIds |> List.member (TableRow.toHtmlId r.id)))) + |> mapMemos (List.map (\m -> m |> Lenses.mapSelected (\_ -> htmlIds |> List.member (MemoId.toHtmlId m.id)))) + + +mapSelected : (ErdLayoutItem -> Bool -> Bool) -> ErdLayout -> ErdLayout +mapSelected transform layout = + layout + |> mapTables (List.map (\t -> t |> mapProps (Lenses.mapSelected (transform { id = TableId.toHtmlId t.id, position = t.props.position, size = t.props.size })))) + |> mapTableRows (List.map (\r -> r |> Lenses.mapSelected (transform { id = TableRow.toHtmlId r.id, position = r.position, size = r.size }))) + |> mapMemos (List.map (\m -> m |> Lenses.mapSelected (transform { id = MemoId.toHtmlId m.id, position = m.position, size = m.size }))) + + +createMemo : ErdLayout -> Position.Grid -> Memo createMemo layout position = let id : MemoId @@ -83,7 +112,7 @@ createMemo layout position = in { id = id , content = "" - , position = position |> Position.moveCanvas { dx = -75, dy = -75 } |> Position.onGrid + , position = position |> Position.moveGrid { dx = -75, dy = -75 } , size = Size 150 150 |> Size.canvas , color = Nothing , selected = False diff --git a/frontend/src/PagesComponents/Organization_/Project_/Subscriptions.elm b/frontend/src/PagesComponents/Organization_/Project_/Subscriptions.elm index 4087d5879..98cc539a1 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Subscriptions.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Subscriptions.elm @@ -21,7 +21,7 @@ subscriptions model = |> Maybe.mapOrElse (\_ -> [ Browser.Events.onMouseMove (Mouse.eventDecoder |> Decode.map (Position.fromEventViewport >> DragMove)) - , Browser.Events.onMouseUp (Mouse.eventDecoder |> Decode.map (Position.fromEventViewport >> DragEnd)) + , Browser.Events.onMouseUp (Mouse.eventDecoder |> Decode.map (Position.fromEventViewport >> DragEnd False)) ] ) [] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates.elm index ab73186ca..851b05615 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates.elm @@ -16,7 +16,7 @@ import Libs.Json.Decode as Decode import Libs.List as List import Libs.Maybe as Maybe import Libs.Models exposing (SizeChange) -import Libs.Models.Delta exposing (Delta) +import Libs.Models.Delta as Delta exposing (Delta) import Libs.Models.ZoomLevel exposing (ZoomLevel) import Libs.Nel as Nel import Libs.Task as T @@ -46,18 +46,19 @@ 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, 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) -import PagesComponents.Organization_.Project_.Models.ErdColumnProps as ErdColumnProps +import PagesComponents.Organization_.Project_.Models.ErdColumnProps as ErdColumnProps exposing (ErdColumnProps) import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.ErdTableLayout as ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) import PagesComponents.Organization_.Project_.Models.MemoId as MemoId import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint(..)) -import PagesComponents.Organization_.Project_.Updates.Canvas exposing (arrangeTables, fitCanvas, handleWheel, zoomCanvas) +import PagesComponents.Organization_.Project_.Updates.Canvas exposing (arrangeTables, fitCanvas, handleWheel, squashViewHistory, zoomCanvas) import PagesComponents.Organization_.Project_.Updates.Drag exposing (handleDrag) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import PagesComponents.Organization_.Project_.Updates.FindPath exposing (handleFindPath) import PagesComponents.Organization_.Project_.Updates.Groups exposing (handleGroups) import PagesComponents.Organization_.Project_.Updates.Help exposing (handleHelp) @@ -68,10 +69,10 @@ import PagesComponents.Organization_.Project_.Updates.Notes exposing (handleNote import PagesComponents.Organization_.Project_.Updates.Project exposing (createProject, moveProject, triggerSaveProject, updateProject) import PagesComponents.Organization_.Project_.Updates.ProjectSettings exposing (handleProjectSettings) import PagesComponents.Organization_.Project_.Updates.Source as Source -import PagesComponents.Organization_.Project_.Updates.Table exposing (goToTable, hideColumn, hideColumns, hideRelatedTables, hideTable, hoverColumn, hoverNextColumn, mapTablePropOrSelected, showAllTables, showColumn, showColumns, showRelatedTables, showTable, showTables, sortColumns, toggleNestedColumn) -import PagesComponents.Organization_.Project_.Updates.TableRow exposing (mapTableRowOrSelectedCmd, moveToTableRow, showTableRow) +import PagesComponents.Organization_.Project_.Updates.Table exposing (goToTable, hideColumn, hideColumns, hideRelatedTables, hideTable, hoverColumn, hoverNextColumn, mapTablePropOrSelected, mapTablePropOrSelectedTE, showAllTables, showColumn, showColumns, showRelatedTables, showTable, showTables, sortColumns, toggleNestedColumn, unHideTable) +import PagesComponents.Organization_.Project_.Updates.TableRow exposing (deleteTableRow, mapTableRowOrSelected, moveToTableRow, showTableRow, unDeleteTableRow) import PagesComponents.Organization_.Project_.Updates.Tags exposing (handleTags) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyM) import PagesComponents.Organization_.Project_.Updates.VirtualRelation exposing (handleVirtualRelation) import PagesComponents.Organization_.Project_.Views as Views import PagesComponents.Organization_.Project_.Views.Modals.NewLayout as NewLayout @@ -80,7 +81,7 @@ import Random import Services.Backend as Backend import Services.DatabaseSource as DatabaseSource import Services.JsonSource as JsonSource -import Services.Lenses exposing (mapAmlSidebarM, mapCanvas, mapColumns, mapContextMenuM, mapDataExplorerCmd, mapDetailsSidebarCmd, mapEmbedSourceParsingMCmd, mapErdM, mapErdMCmd, mapExportDialogCmd, mapHoverTable, mapMemos, mapMobileMenuOpen, mapNavbar, mapOpened, mapOpenedDialogs, mapOrganizationM, mapPlan, mapPosition, mapProject, mapPromptM, mapProps, mapSaveCmd, mapSchemaAnalysisM, mapSearch, mapSelected, mapSharingCmd, mapShowHiddenColumns, mapTableRows, mapTableRowsCmd, mapTables, mapTablesCmd, mapToastsCmd, setActive, setCanvas, setCollapsed, setColor, setColors, setConfirm, setContextMenu, setCurrentLayout, setCursorMode, setDragging, setHoverColumn, setHoverTable, setHoverTableRow, setInput, setLast, setLayoutOnLoad, setModal, setName, setOpenedDropdown, setOpenedPopover, setPosition, setPrompt, setSchemaAnalysis, setSelected, setShow, setSize, setTables, setText) +import Services.Lenses exposing (mapAmlSidebarM, mapCanvasT, mapColorT, mapColumnsT, mapContextMenuM, mapDataExplorerT, mapDetailsSidebarT, mapEmbedSourceParsingMT, mapErdM, mapErdMT, mapErdMTM, mapErdMTW, mapExportDialogT, mapHoverTable, mapMemos, mapMemosT, mapMobileMenuOpen, mapModalM, mapNavbar, mapOpened, mapOpenedDialogs, mapOrganizationM, mapPlan, mapPosition, mapPositionT, mapProject, mapProjectT, mapPromptM, mapProps, mapPropsT, mapSaveT, mapSchemaAnalysisM, mapSearch, mapSharingT, mapShowHiddenColumns, mapTableRows, mapTableRowsT, mapTables, mapTablesL, mapTablesT, mapToastsT, setActive, setCanvas, setCollapsed, setColors, setColumns, setConfirm, setContent, setContextMenu, setCurrentLayout, setCursorMode, setDragging, setHoverTable, setHoverTableRow, setInput, setLast, setLayoutOnLoad, setModal, setName, setOpenedDropdown, setOpenedPopover, setPosition, setPrompt, setSchemaAnalysis, setShow, setSize, setTables, setText) import Services.PrismaSource as PrismaSource import Services.SqlSource as SqlSource import Services.Toasts as Toasts @@ -89,17 +90,17 @@ import Time import Track -update : Maybe LayoutName -> Time.Zone -> Time.Posix -> UrlInfos -> List Organization -> List ProjectInfo -> Msg -> Model -> ( Model, Cmd Msg ) +update : Maybe LayoutName -> Time.Zone -> Time.Posix -> UrlInfos -> List Organization -> List ProjectInfo -> Msg -> Model -> ( Model, Extra Msg ) update urlLayout zone now urlInfos organizations projects msg model = case msg of ToggleMobileMenu -> - ( model |> mapNavbar (mapMobileMenuOpen not), Cmd.none ) + ( model |> mapNavbar (mapMobileMenuOpen not), Extra.none ) SearchUpdated search -> - ( model |> mapNavbar (mapSearch (setText search >> setActive 0)), Cmd.none ) + ( model |> mapNavbar (mapSearch (setText search >> setActive 0)), Extra.none ) SearchClicked kind table -> - ( model, Cmd.batch [ ShowTable table Nothing "search" |> T.send, Track.searchClicked kind model.erd ] ) + ( model, Extra.cmdL [ ShowTable table Nothing "search" |> T.send, Track.searchClicked kind model.erd ] ) TriggerSaveProject -> model |> triggerSaveProject urlInfos organizations @@ -114,138 +115,219 @@ update urlLayout zone now urlInfos organizations projects msg model = model |> moveProject storage RenameProject name -> - model |> mapErdM (mapProject (setName name)) |> setDirty + model |> mapErdMT (mapProjectT (\p -> ( p |> setName name, Extra.history ( RenameProject p.name, RenameProject name ) ))) |> setDirtyM DeleteProject project -> - ( model, Ports.deleteProject project ((project.organization |> Maybe.map .id) |> Backend.organizationUrl |> Just) ) + ( model, Ports.deleteProject project ((project.organization |> Maybe.map .id) |> Backend.organizationUrl |> Just) |> Extra.cmd ) GoToTable id -> - model |> mapErdMCmd (goToTable now id model.erdElem) |> setDirtyCmd + model |> mapErdMT (goToTable now id model.erdElem) |> setDirtyM ShowTable id hint from -> if model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .tables) [] |> List.any (\t -> t.id == id) then - ( model, GoToTable id |> T.send ) + ( model, GoToTable id |> Extra.msg ) else - model |> mapErdMCmd (showTable now id hint from) |> setDirtyCmd + model |> mapErdMT (showTable now id hint from) |> setDirtyM ShowTables ids hint from -> - model |> mapErdMCmd (showTables now ids hint from) |> setDirtyCmd + model |> mapErdMT (showTables now ids hint from) |> setDirtyM ShowAllTables from -> - model |> mapErdMCmd (showAllTables now from) |> setDirtyCmd + model |> mapErdMT (showAllTables now from) |> setDirtyM HideTable id -> - model |> mapErdM (hideTable now id) |> mapHoverTable (\h -> B.cond (h == Just id) Nothing h) |> setDirty + model |> mapErdMT (hideTable now id) |> Tuple.mapFirst (mapHoverTable (Maybe.filter (\( t, _ ) -> t /= id))) |> setDirtyM + + UnHideTable_ index table -> + if model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .tables) [] |> List.any (\t -> t.id == table.id) then + ( model, GoToTable table.id |> Extra.msg ) + + else + model |> mapErdMT (unHideTable now index table) |> setDirtyM ShowRelatedTables id -> - model |> mapErdMCmd (showRelatedTables id) |> setDirtyCmd + model |> mapErdMT (showRelatedTables now id) |> setDirtyM HideRelatedTables id -> - model |> mapErdMCmd (hideRelatedTables id) |> setDirtyCmd + model |> mapErdMT (hideRelatedTables now id) |> setDirtyM ToggleTableCollapse id -> - let - collapsed : Bool - collapsed = - model.erd |> Maybe.andThen (Erd.currentLayout >> .tables >> List.findBy .id id) |> Maybe.mapOrElse (.props >> .collapsed) False - in - model |> mapErdMCmd (\erd -> erd |> Erd.mapCurrentLayoutWithTimeCmd now (mapTablesCmd (mapTablePropOrSelected erd.settings.defaultSchema id (mapProps (setCollapsed (not collapsed)))))) |> setDirtyCmd + model + |> mapErdMTM + (\erd -> + erd + |> Erd.mapCurrentLayoutTWithTime now + (mapTablesT + (\tables -> + let + collapsed : Bool + collapsed = + tables |> List.findBy .id id |> Maybe.mapOrElse (.props >> .collapsed) False |> not + in + tables |> mapTablePropOrSelected erd.settings.defaultSchema id (mapProps (setCollapsed collapsed)) + ) + ) + ) + |> setDirtyM + |> Extra.addHistoryT ( ToggleTableCollapse id, ToggleTableCollapse id ) - ShowColumn { table, column } -> - model |> mapErdM (showColumn now table column) |> setDirty + ShowColumn index column -> + model |> mapErdMT (showColumn now index column) |> setDirtyM - HideColumn { table, column } -> - model |> mapErdM (hideColumn now table column) |> hoverNextColumn table column |> setDirty + HideColumn column -> + model |> mapErdMT (hideColumn now column) |> Tuple.mapFirst (hoverNextColumn column) |> setDirtyM ShowColumns id kind -> - model |> mapErdMCmd (showColumns now id kind) |> setDirtyCmd + model |> mapErdMT (showColumns now id kind) |> setDirtyM HideColumns id kind -> - model |> mapErdMCmd (hideColumns now id kind) |> setDirtyCmd + model |> mapErdMT (hideColumns now id kind) |> setDirtyM SortColumns id kind -> - model |> mapErdMCmd (sortColumns now id kind) |> setDirtyCmd + model |> mapErdMT (sortColumns now id kind) |> setDirtyM + + SetColumns_ id columns -> + -- no undo action as triggered only from undo ^^ + ( model |> mapErdM (Erd.mapCurrentLayout (mapTablesL .id id (setColumns columns))), Extra.none ) |> setDirty ToggleNestedColumn table path open -> - model |> mapErdM (toggleNestedColumn now table path open) |> setDirty + ( model |> mapErdM (toggleNestedColumn now table path open), Extra.history ( ToggleNestedColumn table path (not open), ToggleNestedColumn table path open ) ) |> setDirty ToggleHiddenColumns id -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id id (mapProps (mapShowHiddenColumns not))))) |> setDirty + ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id id (mapProps (mapShowHiddenColumns not))))), Extra.history ( ToggleHiddenColumns id, ToggleHiddenColumns id ) ) |> setDirty SelectItem htmlId ctrl -> if model.dragging |> Maybe.any DragState.hasMoved then - ( model, Cmd.none ) + ( model, Extra.none ) else - model - |> mapErdM - (Erd.mapCurrentLayoutWithTime now - (mapTables (List.map (\t -> t |> mapProps (mapSelected (\s -> B.cond (TableId.toHtmlId t.id == htmlId) (not s) (B.cond ctrl s False))))) - >> mapTableRows (List.map (\r -> r |> mapSelected (\s -> B.cond (TableRow.toHtmlId r.id == htmlId) (not s) (B.cond ctrl s False)))) - >> mapMemos (List.map (\m -> m |> mapSelected (\s -> B.cond (MemoId.toHtmlId m.id == htmlId) (not s) (B.cond ctrl s False)))) - ) - ) - |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (\l -> ( l |> ErdLayout.mapSelected (\i s -> B.cond (i.id == htmlId) (not s) (B.cond ctrl s False)), Extra.history ( SelectItems_ (ErdLayout.getSelected l), msg ) ))) |> setDirtyM + + SelectItems_ htmlIds -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (\l -> ( l |> ErdLayout.setSelected htmlIds, Extra.history ( SelectItems_ (ErdLayout.getSelected l), msg ) ))) |> setDirtyM SelectAll -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.map (mapProps (setSelected True))) >> mapTableRows (List.map (setSelected True)) >> mapMemos (List.map (setSelected True)))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (\l -> ( l |> ErdLayout.mapSelected (\_ _ -> True), Extra.history ( SelectItems_ (ErdLayout.getSelected l), msg ) ))) |> setDirtyM + + CanvasPosition position -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapCanvasT (mapPositionT (\p -> ( position, Extra.history ( CanvasPosition p, msg ) ))))) |> Extra.defaultT TableMove id delta -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id id (mapProps (mapPosition (Position.moveGrid delta)))))) |> setDirty + ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id id (mapProps (mapPosition (Position.moveGrid delta)))))), Extra.history ( TableMove id (Delta.negate delta), msg ) ) |> setDirty TablePosition id position -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id id (mapProps (setPosition position))))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapTablesT (List.mapByTE .id id (mapPropsT (mapPositionT (\p -> ( position, Extra.history ( TablePosition id p, msg ) ))))))) |> setDirtyM + + TableRowPosition id position -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapTableRowsT (List.mapByTE .id id (mapPositionT (\p -> ( position, Extra.history ( TableRowPosition id p, msg ) )))))) |> setDirtyM + + MemoPosition id position -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapMemosT (List.mapByTE .id id (mapPositionT (\p -> ( position, Extra.history ( MemoPosition id p, msg ) )))))) |> setDirtyM TableOrder id index -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTables (\tables -> tables |> List.moveBy .id id (List.length tables - 1 - index)))) |> setDirty + model + |> mapErdMTM + (Erd.mapCurrentLayoutTWithTime now + (mapTablesT + (\tables -> + (List.length tables - 1 - max index 0) + |> (\newPos -> + (tables |> List.findIndexBy .id id) + |> Maybe.filter (\pos -> pos /= newPos) + |> Maybe.map (\pos -> ( tables |> List.moveIndex pos newPos, Extra.history ( TableOrder id (List.length tables - 1 - pos), msg ) )) + |> Maybe.withDefault ( tables, Extra.none ) + ) + ) + ) + ) + |> setDirtyM - TableColor id color -> + TableColor id color extendToSelected -> let project : ProjectRef project = model.erd |> Erd.getProjectRefM urlInfos in if model.erd |> Erd.canChangeColor then - model |> mapErdMCmd (\erd -> erd |> Erd.mapCurrentLayoutWithTimeCmd now (mapTablesCmd (mapTablePropOrSelected erd.settings.defaultSchema id (mapProps (setColor color))))) |> setDirtyCmd + model |> mapErdMTM (\erd -> erd |> Erd.mapCurrentLayoutTWithTime now (mapTablesT (mapTablePropOrSelectedTE erd.settings.defaultSchema extendToSelected id (\t -> t |> mapPropsT (mapColorT (\c -> ( color, Extra.history ( TableColor t.id c False, TableColor t.id color False ) ))))))) |> setDirtyM else - ( model, Cmd.batch [ ProPlan.colorsModalBody project ProPlanColors ProPlan.colorsInit |> CustomModalOpen |> T.send, Track.planLimit .tableColor model.erd ] ) + ( model, Extra.cmdL [ ProPlan.colorsModalBody project ProPlanColors ProPlan.colorsInit |> CustomModalOpen |> T.send, Track.planLimit .tableColor model.erd ] ) MoveColumn column position -> - model |> mapErdM (\erd -> erd |> Erd.mapCurrentLayoutWithTime now (mapTables (List.mapBy .id column.table (mapColumns (ErdColumnProps.mapAt (column.column |> ColumnPath.parent) (List.moveBy .name (column.column |> Nel.last) position)))))) |> setDirty - - ToggleHoverTable table on -> - ( model |> setHoverTable (B.cond on (Just table) Nothing), Cmd.none ) + model + |> mapErdMTM + (\erd -> + erd + |> Erd.mapCurrentLayoutTWithTime now + (mapTablesT + (List.mapByTE .id + column.table + (mapColumnsT + (ErdColumnProps.mapAtTE + (column.column |> ColumnPath.parent) + (\cols -> + (cols |> List.findIndexBy .name (column.column |> Nel.last)) + |> Maybe.filter (\pos -> pos /= position) + |> Maybe.map (\pos -> ( cols |> List.moveIndex pos position, Extra.history ( MoveColumn column pos, msg ) )) + |> Maybe.withDefault ( cols, Extra.none ) + ) + ) + ) + ) + ) + ) + |> setDirtyM - ToggleHoverColumn column on -> - ( model |> setHoverColumn (B.cond on (Just column) Nothing) |> mapErdM (\e -> e |> Erd.mapCurrentLayoutWithTime now (mapTables (hoverColumn column on e))), Cmd.none ) + HoverTable ( table, col ) on -> + ( model |> setHoverTable (B.cond on (Just ( table, col )) (col |> Maybe.map (\_ -> ( table, Nothing )))) |> mapErdM (\e -> e |> Erd.mapCurrentLayoutWithTime now (mapTables (hoverColumn ( table, col ) on e))), Extra.none ) HoverTableRow ( table, col ) on -> - ( model |> setHoverTableRow (B.cond on (Just ( table, col )) (col |> Maybe.map (\_ -> ( table, Nothing )))), Cmd.none ) + ( model |> setHoverTableRow (B.cond on (Just ( table, col )) (col |> Maybe.map (\_ -> ( table, Nothing )))), Extra.none ) CreateUserSource name -> - ( model, SourceId.generator |> Random.generate (Source.aml name now >> CreateUserSourceWithId) ) + ( model, SourceId.generator |> Random.generate (Source.aml name now >> CreateUserSourceWithId) |> Extra.cmd ) CreateUserSourceWithId source -> - model - |> mapErdM (Erd.mapSources (List.add source)) - |> (\updated -> updated |> mapAmlSidebarM (AmlSidebar.setSource (updated.erd |> Maybe.andThen (.sources >> List.last)))) + ( model + |> mapErdM (Erd.mapSources (List.insert source)) + |> (\newModel -> newModel |> mapAmlSidebarM (AmlSidebar.setSource (newModel.erd |> Maybe.andThen (.sources >> List.last)))) |> AmlSidebar.setOtherSourcesTableIdsCache (Just source.id) + , Extra.history ( Batch [ ProjectSettingsMsg (PSSourceDelete source.id), AmlSidebarMsg (AChangeSource (model.amlSidebar |> Maybe.andThen (.selected >> Maybe.map Tuple.first))) ], msg ) + ) |> setDirty CreateRelations rels -> - model |> mapErdMCmd (Source.createRelations now rels) |> setDirtyCmd + model |> mapErdMT (Source.createRelations now rels) |> setDirtyM + + RemoveRelations_ source rels -> + model |> mapErdMT (Source.deleteRelations source rels) |> setDirtyM IgnoreRelation col -> - model |> mapErdM (Erd.mapIgnoredRelations (Dict.update col.table (Maybe.mapOrElse (List.add col.column) [ col.column ] >> List.uniqueBy ColumnPath.toString >> Just))) |> setDirty + model |> mapErdMT (Erd.mapIgnoredRelationsT (Dict.updateT col.table (\cols -> ( cols |> Maybe.mapOrElse (List.insert col.column) [ col.column ] >> List.uniqueBy ColumnPath.toString >> Just, Extra.history ( UnIgnoreRelation_ col, msg ) )))) |> Extra.defaultT + + UnIgnoreRelation_ col -> + model |> mapErdMT (Erd.mapIgnoredRelationsT (Dict.updateT col.table (\cols -> ( cols |> Maybe.map (List.filter (\c -> c /= col.column)), Extra.history ( IgnoreRelation col, msg ) )))) |> Extra.defaultT NewLayoutMsg message -> - model |> NewLayout.update ModalOpen Toast CustomModalOpen now urlInfos message + model |> NewLayout.update NewLayoutMsg Batch ModalOpen Toast CustomModalOpen (LLoad "" >> LayoutMsg) (LDelete >> LayoutMsg) now urlInfos message LayoutMsg message -> model |> handleLayout message + FitToScreen -> + model |> mapErdMT (fitCanvas model.erdElem) |> Extra.defaultT + + SetView_ canvas -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapCanvasT (\c -> ( canvas, Extra.history ( SetView_ c, SetView_ canvas ) )))) |> Extra.defaultT + + ArrangeTables -> + model |> mapErdMT (arrangeTables now model.erdElem) |> Extra.defaultT + + SetLayout_ layout -> + model |> mapErdMTM (Erd.mapCurrentLayoutT (\l -> ( layout, Extra.new (Ports.observeLayout layout) ( SetLayout_ l, SetLayout_ layout ) ))) |> setDirtyM + GroupMsg message -> model |> handleGroups now urlInfos message @@ -260,23 +342,26 @@ update urlLayout zone now urlInfos organizations projects msg model = ShowTableRow source query previous hint from -> (model.erd |> Maybe.andThen (Erd.currentLayout >> .tableRows >> List.find (\r -> r.source == source.id && r.table == query.table && r.primaryKey == query.primaryKey))) - |> Maybe.map (\r -> model |> mapErdMCmd (moveToTableRow now model.erdElem r)) - |> Maybe.withDefault (model |> mapErdMCmd (showTableRow now source query previous hint from) |> setDirtyCmd) + |> Maybe.map (\r -> model |> mapErdMT (moveToTableRow now model.erdElem r) |> Extra.defaultT) + |> Maybe.withDefault (model |> mapErdMT (showTableRow now source query previous hint from) |> setDirtyM) DeleteTableRow id -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapTableRows (List.removeBy .id id))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (deleteTableRow id)) |> setDirtyM + + UnDeleteTableRow_ index tableRow -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (unDeleteTableRow index tableRow)) |> setDirtyM TableRowMsg id message -> - model |> mapErdMCmd (\e -> e |> Erd.mapCurrentLayoutWithTimeCmd now (mapTableRowsCmd (mapTableRowOrSelectedCmd id message (TableRow.update DropdownToggle Toast now e.project e.sources model.openedDropdown message)))) + model |> mapErdMTM (\e -> e |> Erd.mapCurrentLayoutTWithTime now (mapTableRowsT (mapTableRowOrSelected id message (TableRow.update (TableRowMsg id) DropdownToggle Toast (DeleteTableRow id) (UnDeleteTableRow_ 0) now e.project e.sources model.openedDropdown message)))) |> setDirtyM AmlSidebarMsg message -> model |> AmlSidebar.update now message DetailsSidebarMsg message -> - model.erd |> Maybe.mapOrElse (\erd -> model |> mapDetailsSidebarCmd (DetailsSidebar.update Noop NotesMsg TagsMsg erd message)) ( model, Cmd.none ) + model.erd |> Maybe.mapOrElse (\erd -> model |> mapDetailsSidebarT (DetailsSidebar.update Noop NotesMsg TagsMsg erd message)) ( model, Extra.none ) DataExplorerMsg message -> - model.erd |> Maybe.mapOrElse (\erd -> model |> mapDataExplorerCmd (DataExplorer.update DataExplorerMsg Toast erd.project erd.sources message)) ( model, Cmd.none ) + model.erd |> Maybe.mapOrElse (\erd -> model |> mapDataExplorerT (DataExplorer.update DataExplorerMsg Toast erd.project erd.sources message)) ( model, Extra.none ) VirtualRelationMsg message -> model |> handleVirtualRelation message @@ -285,142 +370,152 @@ update urlLayout zone now urlInfos organizations projects msg model = model |> handleFindPath message SchemaAnalysisMsg SAOpen -> - ( model |> setSchemaAnalysis (Just { id = Conf.ids.schemaAnalysisDialog, opened = "" }), Cmd.batch [ T.sendAfter 1 (ModalOpen Conf.ids.schemaAnalysisDialog), Track.dbAnalysisOpened model.erd ] ) + ( model |> setSchemaAnalysis (Just { id = Conf.ids.schemaAnalysisDialog, opened = "" }), Extra.cmdL [ T.sendAfter 1 (ModalOpen Conf.ids.schemaAnalysisDialog), Track.dbAnalysisOpened model.erd ] ) SchemaAnalysisMsg (SASectionToggle section) -> - ( model |> mapSchemaAnalysisM (mapOpened (\opened -> B.cond (opened == section) "" section)), Cmd.none ) + ( model |> mapSchemaAnalysisM (mapOpened (\opened -> B.cond (opened == section) "" section)), Extra.none ) SchemaAnalysisMsg SAClose -> - ( model |> setSchemaAnalysis Nothing, Cmd.none ) + ( model |> setSchemaAnalysis Nothing, Extra.none ) ExportDialogMsg message -> - model.erd |> Maybe.mapOrElse (\erd -> model |> mapExportDialogCmd (ExportDialog.update ExportDialogMsg ModalOpen urlInfos erd message)) ( model, Cmd.none ) + model.erd |> Maybe.mapOrElse (\erd -> model |> mapExportDialogT (ExportDialog.update ExportDialogMsg ModalOpen urlInfos erd message)) ( model, Extra.none ) SharingMsg message -> - model |> mapSharingCmd (ProjectSharing.update SharingMsg ModalOpen Toast zone now model.erd message) + model |> mapSharingT (ProjectSharing.update SharingMsg ModalOpen Toast zone now model.erd message) ProjectSaveMsg message -> - model |> mapSaveCmd (ProjectSaveDialog.update ModalOpen message) + model |> mapSaveT (ProjectSaveDialog.update ModalOpen message) ProjectSettingsMsg message -> model |> handleProjectSettings now message EmbedSourceParsingMsg message -> - model |> mapEmbedSourceParsingMCmd (EmbedSourceParsingDialog.update EmbedSourceParsingMsg now (model.erd |> Maybe.map .project) message) + model |> mapEmbedSourceParsingMT (EmbedSourceParsingDialog.update EmbedSourceParsingMsg now (model.erd |> Maybe.map .project) message) |> Extra.defaultT SourceParsed source -> - ( model, source |> Project.create projects source.name |> Ok |> Just |> GotProject "load" |> JsMessage |> T.send ) + ( model, source |> Project.create projects source.name |> Ok |> Just |> GotProject "load" |> JsMessage |> Extra.msg ) ProPlanColors _ ProPlan.EnableTableChangeColor -> - ( model |> mapErdM (mapProject (mapOrganizationM (mapPlan (setColors True)))), Ports.fireworks ) + ( model |> mapErdM (mapProject (mapOrganizationM (mapPlan (setColors True)))), Ports.fireworks |> Extra.cmd ) ProPlanColors state message -> - state |> ProPlan.colorsUpdate ProPlanColors message |> Tuple.mapFirst (\s -> { model | modal = model.modal |> Maybe.map (\m -> { m | content = ProPlan.colorsModalBody (model.erd |> Erd.getProjectRefM urlInfos) ProPlanColors s }) }) + state |> ProPlan.colorsUpdate ProPlanColors message |> Tuple.mapFirst (\s -> model |> mapModalM (setContent (ProPlan.colorsModalBody (model.erd |> Erd.getProjectRefM urlInfos) ProPlanColors s))) HelpMsg message -> model |> handleHelp message CursorMode mode -> - ( model |> setCursorMode mode, Cmd.none ) - - FitToScreen -> - model |> mapErdMCmd (fitCanvas model.erdElem) - - ArrangeTables -> - model |> mapErdMCmd (arrangeTables now model.erdElem) |> setDirtyCmd + ( model |> setCursorMode mode, Extra.none ) Fullscreen id -> - ( model, Ports.fullscreen id ) + ( model, Ports.fullscreen id |> Extra.cmd ) OnWheel event -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapCanvas (handleWheel event model.erdElem))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapCanvasT (handleWheel event model.erdElem))) |> setDirtyM |> squashViewHistory Zoom delta -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapCanvas (zoomCanvas delta model.erdElem))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapCanvasT (zoomCanvas delta model.erdElem))) |> setDirtyM |> squashViewHistory Focus id -> - ( model, Ports.focus id ) + ( model, Ports.focus id |> Extra.cmd ) DropdownToggle id -> - ( model |> Dropdown.update id, Cmd.none ) + ( model |> Dropdown.update id, Extra.none ) DropdownOpen id -> - ( model |> setOpenedDropdown id, Cmd.none ) + ( model |> setOpenedDropdown id, Extra.none ) DropdownClose -> - ( model |> setOpenedDropdown "", Cmd.none ) + ( model |> setOpenedDropdown "", Extra.none ) PopoverOpen id -> - ( model |> setOpenedPopover id, Cmd.none ) + ( model |> setOpenedPopover id, Extra.none ) ContextMenuCreate content event -> - ( model |> setContextMenu (Just { content = content, position = event.clientPos, show = False }), T.sendAfter 1 ContextMenuShow ) + ( model |> setContextMenu (Just { content = content, position = event.clientPos, show = False }), ContextMenuShow |> T.sendAfter 1 |> Extra.cmd ) ContextMenuShow -> - ( model |> mapContextMenuM (setShow True), Cmd.none ) + ( model |> mapContextMenuM (setShow True), Extra.none ) ContextMenuClose -> - ( model |> setContextMenu Nothing, Cmd.none ) + ( model |> setContextMenu Nothing, Extra.none ) DragStart id pos -> model.dragging - |> Maybe.mapOrElse (\d -> ( model, "Already dragging " ++ d.id |> Toasts.info |> Toast |> T.send )) - ({ id = id, init = pos, last = pos } |> (\d -> model |> setDragging (Just d) |> handleDrag now d False)) + |> Maybe.mapOrElse (\d -> ( model, "Already dragging " ++ d.id |> Toasts.info |> Toast |> Extra.msg )) + ({ id = id, init = pos, last = pos } |> (\d -> model |> setDragging (Just d) |> handleDrag now d False False)) DragMove pos -> model.dragging |> Maybe.map (setLast pos) - |> Maybe.mapOrElse (\d -> model |> setDragging (Just d) |> handleDrag now d False) ( model, Cmd.none ) + |> Maybe.mapOrElse (\d -> model |> setDragging (Just d) |> handleDrag now d False False) ( model, Extra.none ) - DragEnd pos -> + DragEnd cancel pos -> model.dragging |> Maybe.map (setLast pos) - |> Maybe.mapOrElse (\d -> model |> setDragging Nothing |> handleDrag now d True) ( model, Cmd.none ) + |> Maybe.mapOrElse (\d -> model |> setDragging Nothing |> handleDrag now d True cancel) ( model, Extra.none ) DragCancel -> - ( model |> setDragging Nothing, Cmd.none ) + ( model |> setDragging Nothing, Extra.none ) Toast message -> - model |> mapToastsCmd (Toasts.update Toast message) + model |> mapToastsT (Toasts.update Toast message) ConfirmOpen confirm -> - ( model |> setConfirm (Just { id = Conf.ids.confirmDialog, content = confirm }), T.sendAfter 1 (ModalOpen Conf.ids.confirmDialog) ) + ( model |> setConfirm (Just { id = Conf.ids.confirmDialog, content = confirm }), ModalOpen Conf.ids.confirmDialog |> T.sendAfter 1 |> Extra.cmd ) ConfirmAnswer answer cmd -> - ( model |> setConfirm Nothing, B.cond answer cmd Cmd.none ) + ( model |> setConfirm Nothing, B.cond answer (Extra.cmd cmd) Extra.none ) PromptOpen prompt input -> - ( model |> setPrompt (Just { id = Conf.ids.promptDialog, content = prompt, input = input }), T.sendAfter 1 (ModalOpen Conf.ids.promptDialog) ) + ( model |> setPrompt (Just { id = Conf.ids.promptDialog, content = prompt, input = input }), ModalOpen Conf.ids.promptDialog |> T.sendAfter 1 |> Extra.cmd ) PromptUpdate input -> - ( model |> mapPromptM (setInput input), Cmd.none ) + ( model |> mapPromptM (setInput input), Extra.none ) PromptAnswer cmd -> - ( model |> setPrompt Nothing, cmd ) + ( model |> setPrompt Nothing, Extra.cmd cmd ) ModalOpen id -> - ( model |> mapOpenedDialogs (\dialogs -> id :: dialogs), Ports.autofocusWithin id ) + ( model |> mapOpenedDialogs (\dialogs -> id :: dialogs), Ports.autofocusWithin id |> Extra.cmd ) ModalClose message -> - ( model |> mapOpenedDialogs (List.drop 1), T.sendAfter Conf.ui.closeDuration message ) + ( model |> mapOpenedDialogs (List.drop 1), message |> T.sendAfter Conf.ui.closeDuration |> Extra.cmd ) CustomModalOpen content -> - ( model |> setModal (Just { id = Conf.ids.customDialog, content = content }), T.sendAfter 1 (ModalOpen Conf.ids.customDialog) ) + ( model |> setModal (Just { id = Conf.ids.customDialog, content = content }), ModalOpen Conf.ids.customDialog |> T.sendAfter 1 |> Extra.cmd ) CustomModalClose -> - ( model |> setModal Nothing, Cmd.none ) + ( model |> setModal Nothing, Extra.none ) + + Undo -> + case model.history of + [] -> + ( model, "Can't undo, action history is empty" |> Toasts.info |> Toast |> Extra.msg ) + + ( back, next ) :: history -> + update urlLayout zone now urlInfos organizations projects back { model | history = history, future = ( back, next ) :: model.future } |> Tuple.mapSecond Extra.dropHistory + + Redo -> + case model.future of + [] -> + ( model, "Can't redo, no future action" |> Toasts.info |> Toast |> Extra.msg ) + + ( back, next ) :: future -> + update urlLayout zone now urlInfos organizations projects next { model | history = ( back, next ) :: model.history, future = future } |> Tuple.mapSecond Extra.dropHistory JsMessage message -> - model |> handleJsMessage now urlLayout message + model |> handleJsMessage now urlLayout message |> Tuple.mapSecond Extra.cmd Batch messages -> - ( model, Cmd.batch (messages |> List.map T.send) ) + messages |> List.foldl (\curMsg ( curModel, curExtra ) -> update urlLayout zone now urlInfos organizations projects curMsg curModel |> Tuple.mapSecond (Extra.combine curExtra)) ( model, Extra.none ) Send cmd -> - ( model, cmd ) + ( model, Extra.cmd cmd ) Noop _ -> - ( model, Cmd.none ) + ( model, Extra.none ) handleJsMessage : Time.Posix -> Maybe LayoutName -> JsMsg -> Model -> ( Model, Cmd Msg ) @@ -522,37 +617,37 @@ handleJsMessage now urlLayout msg model = ( model, message |> Toasts.create level |> Toast |> T.send ) GotTableShow id hint -> - ( model, T.send (ShowTable id (hint |> Maybe.map PlaceAt) "port") ) + ( model, ShowTable id (hint |> Maybe.map PlaceAt) "port" |> T.send ) GotTableHide id -> - ( model, T.send (HideTable id) ) + ( model, HideTable id |> T.send ) GotTableToggleColumns id -> - ( model, T.send (ToggleTableCollapse id) ) + ( model, ToggleTableCollapse id |> T.send ) GotTablePosition id pos -> - ( model, T.send (TablePosition id pos) ) + ( model, TablePosition id pos |> T.send ) GotTableMove id delta -> - ( model, T.send (TableMove id delta) ) + ( model, TableMove id delta |> T.send ) GotTableSelect id -> - ( model, T.send (SelectItem (TableId.toHtmlId id) False) ) + ( model, SelectItem (TableId.toHtmlId id) False |> T.send ) GotTableColor id color -> - ( model, T.send (TableColor id color) ) + ( model, TableColor id color True |> T.send ) GotColumnShow ref -> - ( model, T.send (ShowColumn ref) ) + ( model, ShowColumn 1000 ref |> T.send ) GotColumnHide ref -> - ( model, T.send (HideColumn ref) ) + ( model, HideColumn ref |> T.send ) GotColumnMove ref index -> - ( model, T.send (MoveColumn ref index) ) + ( model, MoveColumn ref index |> T.send ) GotFitToScreen -> - ( model, T.send FitToScreen ) + ( model, FitToScreen |> T.send ) Error json err -> ( model, Cmd.batch [ "Unable to decode JavaScript message: " ++ Decode.errorToString err ++ " in " ++ Encode.encode 0 json |> Toasts.error |> Toast |> T.send, Track.jsonError "js_message" err ] ) @@ -583,14 +678,14 @@ updateSizes changes model = ) in newModel - |> mapErdMCmd + |> mapErdMTW (\e -> if e.layoutOnLoad /= "" && newModel.erdElem.size /= Size.zeroViewport && (e |> Erd.currentLayout |> .tables |> List.length) > 0 then if e.layoutOnLoad == "fit" then - e |> fitCanvas newModel.erdElem + e |> fitCanvas newModel.erdElem |> Extra.unpackT else if e.layoutOnLoad == "arrange" then - e |> arrangeTables Time.zero newModel.erdElem + e |> arrangeTables Time.zero newModel.erdElem |> Extra.unpackT else ( e, Cmd.none ) @@ -598,6 +693,7 @@ updateSizes changes model = else ( e, Cmd.none ) ) + Cmd.none updateMemos : ZoomLevel -> List SizeChange -> List Memo -> List Memo diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Canvas.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Canvas.elm index 069a92036..361c0ab4d 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Canvas.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Canvas.elm @@ -1,4 +1,4 @@ -module PagesComponents.Organization_.Project_.Updates.Canvas exposing (arrangeTables, computeFit, fitCanvas, handleWheel, performZoom, zoomCanvas) +module PagesComponents.Organization_.Project_.Updates.Canvas exposing (arrangeTables, computeFit, fitCanvas, handleWheel, performZoom, squashViewHistory, zoomCanvas) import Conf import Dagre as D @@ -11,7 +11,6 @@ import Libs.Maybe as Maybe import Libs.Models.Delta as Delta exposing (Delta) import Libs.Models.Position as Position import Libs.Models.ZoomLevel exposing (ZoomLevel) -import Libs.Task as T import Libs.Tuple3 as Tuple3 import Models.Area as Area import Models.ErdProps exposing (ErdProps) @@ -20,40 +19,42 @@ import Models.Project.CanvasProps as CanvasProps exposing (CanvasProps) import Models.Project.TableId exposing (TableId) import Models.Project.TableRow as TableRow exposing (TableRow) import Models.Size as Size -import PagesComponents.Organization_.Project_.Models exposing (Msg(..)) +import PagesComponents.Organization_.Project_.Models exposing (Model, Msg(..)) import PagesComponents.Organization_.Project_.Models.DiagramObject as DiagramObject exposing (DiagramObject) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.ErdTableLayout as ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) import PagesComponents.Organization_.Project_.Models.MemoId exposing (MemoId) -import Services.Lenses exposing (mapCanvas, mapMemos, mapPosition, mapProps, mapTableRows, mapTables, setLayoutOnLoad, setPosition, setZoom) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import Services.Lenses exposing (mapMemos, mapPosition, mapProps, mapTableRows, mapTables, setCanvas, setLayoutOnLoad, setPosition) import Services.Toasts as Toasts import Time -handleWheel : WheelEvent -> ErdProps -> CanvasProps -> CanvasProps +handleWheel : WheelEvent -> ErdProps -> CanvasProps -> ( CanvasProps, Extra Msg ) handleWheel event erdElem canvas = if event.ctrl then canvas |> performZoom erdElem (-event.delta.dy * Conf.canvas.zoom.speed * canvas.zoom) event.clientPos else { canvas | position = canvas.position |> Position.moveDiagram (event.delta |> Delta.negate |> Delta.adjust canvas.zoom) } + |> (\new -> ( new, Extra.history ( SetView_ canvas, SetView_ new ) )) -zoomCanvas : Float -> ErdProps -> CanvasProps -> CanvasProps +zoomCanvas : Float -> ErdProps -> CanvasProps -> ( CanvasProps, Extra Msg ) zoomCanvas delta erdElem canvas = canvas |> performZoom erdElem delta (erdElem |> Area.centerViewport) -fitCanvas : ErdProps -> Erd -> ( Erd, Cmd Msg ) +fitCanvas : ErdProps -> Erd -> ( Erd, Extra Msg ) fitCanvas erdElem erd = (erd |> Erd.currentLayout |> objectsToFit) - |> Maybe.map (\( tables, ( rows, memos, groups ) ) -> ( erd |> setLayoutOnLoad "" |> Erd.mapCurrentLayout (fitCanvasAlgo erdElem tables rows memos groups), Cmd.none )) - |> Maybe.withDefault ( erd, "No table to fit into the canvas" |> Toasts.create "warning" |> Toast |> T.send ) + |> Maybe.map (\( tables, ( rows, memos, groups ) ) -> erd |> setLayoutOnLoad "" |> Erd.mapCurrentLayoutT (fitCanvasAlgo erdElem tables rows memos groups) |> Extra.defaultT) + |> Maybe.withDefault ( erd, "No table to fit into the canvas" |> Toasts.create "warning" |> Toast |> Extra.msg ) -fitCanvasAlgo : ErdProps -> List TableId -> List TableRow.Id -> List MemoId -> List Area.Canvas -> ErdLayout -> ErdLayout +fitCanvasAlgo : ErdProps -> List TableId -> List TableRow.Id -> List MemoId -> List Area.Canvas -> ErdLayout -> ( ErdLayout, Extra Msg ) fitCanvasAlgo erdElem tables rows memos groups layout = -- WARNING: the computation looks good but the diagram changes on resize due to table header size change -- (see headerTextSize in frontend/src/Components/Organisms/Table.elm:177) @@ -69,25 +70,43 @@ fitCanvasAlgo erdElem tables rows memos groups layout = let ( newZoom, centerOffset ) = computeFit (layout.canvas |> CanvasProps.viewport erdElem) Conf.constants.canvasMargins contentArea layout.canvas.zoom + + canvas : CanvasProps + canvas = + { position = Position.zeroDiagram, zoom = newZoom } in - layout - |> mapCanvas (setPosition Position.zeroDiagram >> setZoom newZoom) - |> mapTables (List.map (mapProps (mapPosition (centerOffset |> Position.moveGrid)))) - |> mapTableRows (List.map (mapPosition (centerOffset |> Position.moveGrid))) - |> mapMemos (List.map (mapPosition (centerOffset |> Position.moveGrid))) + ( layout + |> setCanvas canvas + |> mapTables (List.map (mapProps (mapPosition (Position.moveGrid centerOffset)))) + |> mapTableRows (List.map (mapPosition (Position.moveGrid centerOffset))) + |> mapMemos (List.map (mapPosition (Position.moveGrid centerOffset))) + , Extra.history ( SetView_ (layout.canvas |> mapPosition (Position.moveDiagram (Delta.negate centerOffset))), SetView_ canvas ) + ) ) - |> Maybe.withDefault layout + |> Maybe.withDefault ( layout, Extra.none ) -arrangeTables : Time.Posix -> ErdProps -> Erd -> ( Erd, Cmd Msg ) +arrangeTables : Time.Posix -> ErdProps -> Erd -> ( Erd, Extra Msg ) arrangeTables now erdElem erd = -- TODO: toggle this on show all tables if layout was empty before, see frontend/src/PagesComponents/Organization_/Project_/Updates/Table.elm:106#showAllTables (erd |> Erd.currentLayout |> objectsToFit) - |> Maybe.map (\( tables, ( rows, memos, groups ) ) -> ( erd |> setLayoutOnLoad "" |> Erd.mapCurrentLayoutWithTime now (arrangeTablesAlgo tables rows memos >> fitCanvasAlgo erdElem tables rows memos groups), Cmd.none )) - |> Maybe.withDefault ( erd, "No table to arrange in the canvas" |> Toasts.create "warning" |> Toast |> T.send ) + |> Maybe.map + (\( tables, ( rows, memos, groups ) ) -> + erd + |> setLayoutOnLoad "" + |> Erd.mapCurrentLayoutTWithTime now + (\layout -> + layout + |> arrangeTablesAlgo tables rows memos + |> Tuple.mapFirst (fitCanvasAlgo erdElem tables rows memos groups) + |> (\( ( l, e2 ), e1 ) -> ( l, Extra.combine e1 e2 |> Extra.setHistory ( SetLayout_ layout, SetLayout_ l ) )) + ) + |> Extra.defaultT + ) + |> Maybe.withDefault ( erd, "No table to arrange in the canvas" |> Toasts.create "warning" |> Toast |> Extra.msg ) -arrangeTablesAlgo : List TableId -> List TableRow.Id -> List MemoId -> ErdLayout -> ErdLayout +arrangeTablesAlgo : List TableId -> List TableRow.Id -> List MemoId -> ErdLayout -> ( ErdLayout, Extra Msg ) arrangeTablesAlgo tables rows memos layout = let nodes : List (Graph.Node DiagramObject) @@ -150,6 +169,7 @@ arrangeTablesAlgo tables rows memos layout = |> mapTables (List.map (\t -> tableNodeId |> Dict.get t.id |> Maybe.andThen getPosition |> Maybe.mapOrElse (\p -> t |> mapProps (setPosition p)) t)) |> mapTableRows (List.map (\r -> tableRowNodeId |> Dict.get r.id |> Maybe.andThen getPosition |> Maybe.mapOrElse (\p -> r |> setPosition p) r)) |> mapMemos (List.map (\m -> memoNodeId |> Dict.get m.id |> Maybe.andThen getPosition |> Maybe.mapOrElse (\p -> m |> setPosition p) m)) + |> (\l -> ( l, Extra.history ( SetLayout_ layout, SetLayout_ l ) )) objectsToFit : ErdLayout -> Maybe ( List TableId, ( List TableRow.Id, List MemoId, List Area.Canvas ) ) @@ -175,7 +195,7 @@ objectsToFit layout = Nothing -performZoom : ErdProps -> Float -> Position.Viewport -> CanvasProps -> CanvasProps +performZoom : ErdProps -> Float -> Position.Viewport -> CanvasProps -> ( CanvasProps, Extra Msg ) performZoom erdElem delta target canvas = -- to zoom on target (center or cursor), works only if origin is top left (CSS: "transform-origin: top left;") let @@ -193,6 +213,7 @@ performZoom erdElem delta target canvas = { position = canvas.position |> Position.moveDiagram (targetDelta |> Delta.negate) |> Position.roundDiagram , zoom = newZoom } + |> (\newCanvas -> ( newCanvas, Extra.history ( SetView_ canvas, SetView_ newCanvas ) )) computeFit : Area.Canvas -> Float -> Area.Canvas -> ZoomLevel -> ( ZoomLevel, Delta ) @@ -241,3 +262,13 @@ computeZoom erdViewport padding contentArea zoom = (zoom * min grow.dx grow.dy) |> clamp Conf.canvas.zoom.min 1 in newZoom + + +squashViewHistory : ( Model, Extra Msg ) -> ( Model, Extra Msg ) +squashViewHistory ( model, e ) = + case ( model.history, e.history ) of + ( ( SetView_ first, SetView_ _ ) :: rest, [ ( SetView_ _, SetView_ last ) ] ) -> + ( { model | history = rest }, e |> Extra.setHistory ( SetView_ first, SetView_ last ) ) + + _ -> + ( model, e ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Drag.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Drag.elm index 2461e4507..b98f25873 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Drag.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Drag.elm @@ -1,9 +1,11 @@ module PagesComponents.Organization_.Project_.Updates.Drag exposing (handleDrag, moveCanvas, moveInLayout) import Conf +import Dict exposing (Dict) import Libs.List as List import Libs.Maybe as Maybe import Libs.Models.Delta as Delta exposing (Delta) +import Libs.Models.HtmlId exposing (HtmlId) import Libs.Models.ZoomLevel exposing (ZoomLevel) import Models.Area as Area import Models.ErdProps exposing (ErdProps) @@ -11,20 +13,21 @@ import Models.Position as Position import Models.Project.CanvasProps as CanvasProps exposing (CanvasProps) import Models.Project.TableId as TableId exposing (TableId) import Models.Project.TableRow as TableRow exposing (TableRow) -import PagesComponents.Organization_.Project_.Models exposing (Model) +import PagesComponents.Organization_.Project_.Models as Msg exposing (Model, Msg(..)) import PagesComponents.Organization_.Project_.Models.DragState exposing (DragState) import PagesComponents.Organization_.Project_.Models.Erd as Erd -import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout) +import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.ErdTableLayout exposing (ErdTableLayout) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) -import PagesComponents.Organization_.Project_.Models.MemoId as MemoId -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty) -import Services.Lenses exposing (mapCanvas, mapErdM, mapMemos, mapPosition, mapProps, mapTableRows, mapTables, setSelected, setSelectionBox) +import PagesComponents.Organization_.Project_.Models.MemoId as MemoId exposing (MemoId) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyM) +import Services.Lenses exposing (mapCanvasT, mapErdM, mapErdMTM, mapMemos, mapProps, mapSelectionBox, mapTableRows, mapTables, setArea, setPosition, setSelectionBox) import Time -handleDrag : Time.Posix -> DragState -> Bool -> Model -> ( Model, Cmd msg ) -handleDrag now drag isEnd model = +handleDrag : Time.Posix -> DragState -> Bool -> Bool -> Model -> ( Model, Extra Msg ) +handleDrag now drag isEnd cancel model = let canvas : CanvasProps canvas = @@ -32,45 +35,60 @@ handleDrag now drag isEnd model = in if drag.id == Conf.ids.erd then if isEnd && drag.init /= drag.last then - ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapCanvas (moveCanvas drag))), Cmd.none ) + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapCanvasT (moveCanvas drag))) |> Extra.defaultT else - ( model, Cmd.none ) + ( model, Extra.none ) else if drag.id == Conf.ids.selectionBox then + let + currentlySelected : List HtmlId + currentlySelected = + model.erd |> Maybe.mapOrElse (Erd.currentLayout >> ErdLayout.getSelected) [] + in if isEnd then - ( model |> setSelectionBox Nothing, Cmd.none ) + let + previouslySelected : List HtmlId + previouslySelected = + model.selectionBox |> Maybe.mapOrElse .previouslySelected [] + in + if cancel then + ( model |> setSelectionBox Nothing |> mapErdM (Erd.mapCurrentLayout (ErdLayout.setSelected previouslySelected)), Extra.none ) + + else + ( model |> setSelectionBox Nothing + , if previouslySelected /= currentlySelected then + Extra.history ( SelectItems_ previouslySelected, SelectItems_ currentlySelected ) + + else + Extra.none + ) else ( drag |> buildSelectionArea model.erdElem canvas |> (\area -> model - |> setSelectionBox (Just area) - |> mapErdM - (Erd.mapCurrentLayoutWithTime now - (mapTables (List.map (mapProps (\p -> p |> setSelected (Area.overlapCanvas area { position = p.position |> Position.offGrid, size = p.size })))) - >> mapTableRows (List.map (\r -> r |> setSelected (Area.overlapCanvas area { position = r.position |> Position.offGrid, size = r.size }))) - >> mapMemos (List.map (\m -> m |> setSelected (Area.overlapCanvas area { position = m.position |> Position.offGrid, size = m.size }))) - ) - ) + |> mapSelectionBox (Maybe.map (setArea area) >> Maybe.withDefault { area = area, previouslySelected = currentlySelected } >> Just) + |> mapErdM (Erd.mapCurrentLayoutWithTime now (ErdLayout.mapSelected (\i _ -> Area.overlapCanvas area { position = i.position |> Position.offGrid, size = i.size }))) ) - , Cmd.none + , Extra.none ) else if isEnd && drag.init /= drag.last then - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (moveInLayout drag canvas.zoom)) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (moveInLayout drag canvas.zoom)) |> setDirtyM else - ( model, Cmd.none ) + ( model, Extra.none ) -moveCanvas : DragState -> CanvasProps -> CanvasProps +moveCanvas : DragState -> CanvasProps -> ( CanvasProps, Extra Msg ) moveCanvas drag canvas = - canvas |> mapPosition (Position.moveDiagram (buildDelta drag 1)) + (canvas.position |> Position.moveDiagram (buildDelta drag 1)) + |> (\newPos -> ( canvas |> setPosition newPos, Extra.history ( Msg.CanvasPosition canvas.position, Msg.CanvasPosition newPos ) )) -moveInLayout : DragState -> ZoomLevel -> ErdLayout -> ErdLayout +moveInLayout : DragState -> ZoomLevel -> ErdLayout -> ( ErdLayout, Extra Msg ) moveInLayout drag zoom layout = let dragSelected : Bool @@ -82,38 +100,33 @@ moveInLayout drag zoom layout = delta : Delta delta = buildDelta drag zoom + + shouldMove : id -> (id -> HtmlId) -> { p | selected : Bool, position : Position.Grid } -> (id -> Position.Grid -> Msg) -> Maybe ( id, ( Position.Grid, ( Msg, Msg ) ) ) + shouldMove id toHtmlId props move = + if drag.id == toHtmlId id || (dragSelected && props.selected) then + props.position |> Position.moveGrid delta |> (\newPos -> Just ( id, ( newPos, ( move id props.position, move id newPos ) ) )) + + else + Nothing + + moveTables : Dict TableId ( Position.Grid, ( Msg, Msg ) ) + moveTables = + layout.tables |> List.filterMap (\t -> shouldMove t.id TableId.toHtmlId t.props Msg.TablePosition) |> Dict.fromList + + moveTableRows : Dict TableRow.Id ( Position.Grid, ( Msg, Msg ) ) + moveTableRows = + layout.tableRows |> List.filterMap (\r -> shouldMove r.id TableRow.toHtmlId r Msg.TableRowPosition) |> Dict.fromList + + moveMemos : Dict MemoId ( Position.Grid, ( Msg, Msg ) ) + moveMemos = + layout.memos |> List.filterMap (\m -> shouldMove m.id MemoId.toHtmlId m Msg.MemoPosition) |> Dict.fromList in - layout - |> mapTables - (List.map - (\t -> - if drag.id == TableId.toHtmlId t.id || (dragSelected && t.props.selected) then - t |> mapProps (mapPosition (Position.moveGrid delta)) - - else - t - ) - ) - |> mapTableRows - (List.map - (\r -> - if drag.id == TableRow.toHtmlId r.id || (dragSelected && r.selected) then - r |> mapPosition (Position.moveGrid delta) - - else - r - ) - ) - |> mapMemos - (List.map - (\m -> - if drag.id == MemoId.toHtmlId m.id || (dragSelected && m.selected) then - m |> mapPosition (Position.moveGrid delta) - - else - m - ) - ) + ( layout + |> mapTables (List.map (\t -> moveTables |> Dict.get t.id |> Maybe.mapOrElse (\( pos, _ ) -> t |> mapProps (setPosition pos)) t)) + |> mapTableRows (List.map (\r -> moveTableRows |> Dict.get r.id |> Maybe.mapOrElse (\( pos, _ ) -> r |> setPosition pos) r)) + |> mapMemos (List.map (\m -> moveMemos |> Dict.get m.id |> Maybe.mapOrElse (\( pos, _ ) -> m |> setPosition pos) m)) + , (Dict.values moveTables ++ Dict.values moveTableRows ++ Dict.values moveMemos) |> List.map Tuple.second |> Extra.historyL + ) buildDelta : DragState -> ZoomLevel -> Delta diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Extra.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Extra.elm new file mode 100644 index 000000000..c0a2ef474 --- /dev/null +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Extra.elm @@ -0,0 +1,158 @@ +module PagesComponents.Organization_.Project_.Updates.Extra exposing (Extra, addCmd, addCmdT, addHistoryT, apply, cmd, cmdL, cmdM, cmdML, cmdT, combine, concat, defaultT, dropHistory, history, historyL, historyM, msg, msgM, msgR, new, newCL, newHL, newLL, none, setHistory, unpackT, unpackTM) + +import Task + + +type alias Extra msg = + { cmd : Cmd msg + , history : List ( msg, msg ) + } + + +none : Extra msg +none = + { cmd = Cmd.none, history = [] } + + +new : Cmd msg -> ( msg, msg ) -> Extra msg +new c h = + { cmd = c, history = [ h ] } + + +newCL : List (Cmd msg) -> ( msg, msg ) -> Extra msg +newCL c h = + { cmd = Cmd.batch c, history = [ h ] } + + +newHL : Cmd msg -> List ( msg, msg ) -> Extra msg +newHL c h = + { cmd = c, history = h } + + +newLL : List (Cmd msg) -> List ( msg, msg ) -> Extra msg +newLL c h = + { cmd = Cmd.batch c, history = h } + + +cmd : Cmd msg -> Extra msg +cmd c = + { cmd = c, history = [] } + + +cmdM : Maybe (Cmd msg) -> Extra msg +cmdM c = + c |> Maybe.map cmd |> Maybe.withDefault none + + +cmdL : List (Cmd msg) -> Extra msg +cmdL c = + { cmd = Cmd.batch c, history = [] } + + +cmdT : ( a, Cmd msg ) -> ( a, Extra msg ) +cmdT ( a, c ) = + ( a, cmd c ) + + +cmdML : Maybe (List (Cmd msg)) -> Extra msg +cmdML c = + c |> Maybe.map cmdL |> Maybe.withDefault none + + +msg : msg -> Extra msg +msg m = + { cmd = m |> Task.succeed |> Task.perform identity, history = [] } + + +msgM : Maybe msg -> Extra msg +msgM m = + m |> Maybe.map msg |> Maybe.withDefault none + + +msgR : Result e msg -> Extra msg +msgR m = + m |> Result.map msg |> Result.withDefault none + + +history : ( msg, msg ) -> Extra msg +history h = + { cmd = Cmd.none, history = [ h ] } + + +historyM : Maybe ( msg, msg ) -> Extra msg +historyM h = + h |> Maybe.map history |> Maybe.withDefault none + + +historyL : List ( msg, msg ) -> Extra msg +historyL h = + { cmd = Cmd.none, history = h } + + +addCmd : Cmd msg -> Extra msg -> Extra msg +addCmd c e = + { e | cmd = Cmd.batch [ e.cmd, c ] } + + +addCmdT : Cmd msg -> ( a, Extra msg ) -> ( a, Extra msg ) +addCmdT c ( a, e ) = + ( a, e |> addCmd c ) + + +addHistoryT : ( msg, msg ) -> ( a, Extra msg ) -> ( a, Extra msg ) +addHistoryT h ( a, e ) = + ( a, { e | history = e.history ++ [ h ] } ) + + +setHistory : ( msg, msg ) -> Extra msg -> Extra msg +setHistory h e = + { e | history = [ h ] } + + +dropHistory : Extra msg -> Extra msg +dropHistory e = + { e | history = [] } + + +defaultT : ( a, Maybe (Extra msg) ) -> ( a, Extra msg ) +defaultT ( a, e ) = + ( a, e |> Maybe.withDefault none ) + + +combine : Extra msg -> Extra msg -> Extra msg +combine a b = + { cmd = Cmd.batch [ a.cmd, b.cmd ], history = a.history ++ b.history } + + +concat : List (Extra msg) -> Extra msg +concat extras = + { cmd = extras |> List.map .cmd |> Cmd.batch, history = extras |> List.map .history |> List.concat } + + +unpackT : ( a, Extra msg ) -> ( a, Cmd msg ) +unpackT ( a, e ) = + ( a, e.cmd ) + + +unpackTM : ( a, Maybe (Extra msg) ) -> ( a, Cmd msg ) +unpackTM ( a, eM ) = + eM |> Maybe.map (\e -> ( a, e.cmd )) |> Maybe.withDefault ( a, Cmd.none ) + + +apply : (List msg -> msg) -> ( { m | history : List ( msg, msg ), future : List ( msg, msg ) }, Extra msg ) -> ( { m | history : List ( msg, msg ), future : List ( msg, msg ) }, Cmd msg ) +apply batch ( model, e ) = + case e.history of + [] -> + ( model, e.cmd ) + + one :: [] -> + ( { model | history = one :: model.history |> List.take 100, future = [] }, e.cmd ) + + many -> + ( { model | history = (many |> tupleList |> Tuple.mapBoth batch batch) :: model.history |> List.take 100, future = [] }, e.cmd ) + + +tupleList : List ( a, b ) -> ( List a, List b ) +tupleList list = + -- from List.tupleSeq but avoid dependency on List module + List.foldr (\( a, b ) ( aList, bList ) -> ( a :: aList, b :: bList )) ( [], [] ) list diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/FindPath.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/FindPath.elm index fbf96bec2..18da8c9f1 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/FindPath.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/FindPath.elm @@ -22,7 +22,7 @@ import PagesComponents.Organization_.Project_.Models.FindPathResult exposing (Fi import PagesComponents.Organization_.Project_.Models.FindPathState as FindPathState exposing (FindPathState(..)) import PagesComponents.Organization_.Project_.Models.FindPathStep exposing (FindPathStep) import PagesComponents.Organization_.Project_.Models.FindPathStepDir exposing (FindPathStepDir(..)) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.Lenses exposing (mapErdM, mapFindPathM, mapOpened, mapResult, mapSettings, mapShowSettings, setFindPath, setFrom, setResult, setTo) import Track @@ -36,7 +36,7 @@ type alias Model x = } -handleFindPath : FindPathMsg -> Model x -> ( Model x, Cmd Msg ) +handleFindPath : FindPathMsg -> Model x -> ( Model x, Extra Msg ) handleFindPath msg model = case msg of FPOpen from to -> @@ -51,36 +51,35 @@ handleFindPath msg model = } ) |> mapErdM (mapSettings ProjectSettings.fillFindPath) - , Cmd.batch [ T.sendAfter 1 (ModalOpen Conf.ids.findPathDialog), Track.findPathOpened model.erd ] + , Extra.cmdL [ T.sendAfter 1 (ModalOpen Conf.ids.findPathDialog), Track.findPathOpened model.erd ] ) - |> setDirtyCmd FPToggleSettings -> - ( model |> mapFindPathM (mapShowSettings not), Cmd.none ) + ( model |> mapFindPathM (mapShowSettings not), Extra.none ) FPUpdateFrom from -> - ( model |> mapFindPathM (setFrom from >> setResult Empty), Cmd.none ) + ( model |> mapFindPathM (setFrom from >> setResult Empty), Extra.none ) FPUpdateTo to -> - ( model |> mapFindPathM (setTo to >> setResult Empty), Cmd.none ) + ( model |> mapFindPathM (setTo to >> setResult Empty), Extra.none ) FPSearch -> Maybe.zip model.findPath model.erd |> Maybe.andThen (\( fp, erd ) -> Maybe.zip3 (Just erd) (erd |> Erd.getTable (TableId.parse fp.from)) (erd |> Erd.getTable (TableId.parse fp.to))) - |> Maybe.mapOrElse (\( erd, from, to ) -> ( model |> mapFindPathM (setResult Searching), T.sendAfter 300 (FindPathMsg (FPCompute erd.tables erd.relations from.id to.id erd.settings.findPath)) )) - ( model, Cmd.none ) + |> Maybe.map (\( erd, from, to ) -> ( model |> mapFindPathM (setResult Searching), FindPathMsg (FPCompute erd.tables erd.relations from.id to.id erd.settings.findPath) |> T.sendAfter 300 |> Extra.cmd )) + |> Maybe.withDefault ( model, Extra.none ) FPCompute tables relations from to settings -> - computeFindPath tables relations from to settings |> (\result -> ( model |> mapFindPathM (setResult (Found result)), Track.findPathResults model.erd result )) + computeFindPath tables relations from to settings |> (\result -> ( model |> mapFindPathM (setResult (Found result)), Track.findPathResults model.erd result |> Extra.cmd )) FPToggleResult index -> - ( model |> mapFindPathM (mapResult (FindPathState.map (mapOpened (\o -> B.cond (o == Just index) Nothing (Just index))))), Cmd.none ) + ( model |> mapFindPathM (mapResult (FindPathState.map (mapOpened (\o -> B.cond (o == Just index) Nothing (Just index))))), Extra.none ) FPSettingsUpdate settings -> - model |> mapErdM (mapSettings (setFindPath settings)) |> setDirty + ( model |> mapErdM (mapSettings (setFindPath settings)), Extra.none ) FPClose -> - ( model |> setFindPath Nothing, Cmd.none ) + ( model |> setFindPath Nothing, Extra.none ) computeFindPath : Dict TableId ErdTable -> List ErdRelation -> TableId -> TableId -> FindPathSettings -> FindPathResult diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Groups.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Groups.elm index f38982726..c997ff1dc 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Groups.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Groups.elm @@ -15,9 +15,9 @@ 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.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyM) +import Services.Lenses exposing (mapColorT, mapEditGroupM, mapErdM, mapErdMTM, mapGroups, mapGroupsT, mapTables, setContent, setEditGroup, setName) import Task import Time import Track @@ -32,44 +32,77 @@ type alias Model x = } -handleGroups : Time.Posix -> UrlInfos -> GroupMsg -> Model x -> ( Model x, Cmd Msg ) +handleGroups : Time.Posix -> UrlInfos -> GroupMsg -> Model x -> ( Model x, Extra 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") |> Extra.cmd ) GEditUpdate name -> - ( model |> mapEditGroupM (setContent name), Cmd.none ) + ( model |> mapEditGroupM (setContent name), Extra.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))))) + , Extra.history ( GroupMsg (GRemoveTables index tables), GroupMsg msg ) + ) + |> setDirty 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))))) + , Extra.history ( GroupMsg (GAddTables index tables), GroupMsg msg ) + ) + |> setDirty 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 + |> mapErdMTM + (Erd.mapCurrentLayoutTWithTime now + (mapGroupsT + (\groups -> + (groups |> List.get index) + |> Maybe.map (\g -> ( groups |> List.removeAt index, Extra.history ( GroupMsg (GUnDelete index g), GroupMsg msg ) )) + |> Maybe.withDefault ( groups, Extra.none ) + ) + ) + ) + |> setDirtyM + + GUnDelete index group -> + model |> mapErdMTM (Erd.mapCurrentLayoutTWithTime now (mapGroupsT (\groups -> ( groups |> List.insertAt index group, Extra.history ( GroupMsg (GDelete index), GroupMsg msg ) )))) |> Extra.defaultT + + +createGroup : Time.Posix -> UrlInfos -> List TableId -> Model x -> ( Model x, Extra Msg ) createGroup now urlInfos tables model = if tables |> List.isEmpty then - ( model, Cmd.none ) + ( model, Extra.none ) else if model.erd |> Erd.canCreateGroup then - ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (\l -> l |> mapGroups (List.add (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)) + , Extra.new (Track.groupCreated model.erd) ( GroupMsg (GDelete (List.length groups)), GroupMsg (GCreate tables) ) + ) + ) + ) + ) + |> Extra.defaultT 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.map (\erd -> [ erd |> Erd.getProjectRef urlInfos |> ProPlan.groupsModalBody |> CustomModalOpen |> T.send, Track.planLimit .groups (Just erd) ]) |> Extra.cmdML ) groupColor : ErdLayout -> List TableId -> Color @@ -85,7 +118,7 @@ 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, Extra Msg ) setGroupColor now urlInfos index color model = let project : ProjectRef @@ -93,22 +126,25 @@ setGroupColor now urlInfos index color model = 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 |> mapErdMTM (Erd.mapCurrentLayoutTMWithTime now (mapGroupsT (List.mapAtT index (mapColorT (\c -> ( color, Extra.history ( GroupMsg (GSetColor index c), GroupMsg (GSetColor index color) ) )))))) |> Extra.defaultT else - ( model, Cmd.batch [ ProPlan.colorsModalBody project ProPlanColors ProPlan.colorsInit |> CustomModalOpen |> T.send, Track.planLimit .tableColor model.erd ] ) + ( model, Extra.cmdL [ 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, Extra 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, Extra.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)))) + , Extra.new (Track.groupRenamed edit.content model.erd) ( GroupMsg (GEditSave { edit | content = groupName }), GroupMsg (GEditSave edit) ) + ) + |> setDirty diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Help.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Help.elm index 03ccd148e..e55f3a167 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Help.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Help.elm @@ -5,6 +5,7 @@ import Libs.Bool as B import Libs.Task as T import PagesComponents.Organization_.Project_.Models exposing (HelpDialog, HelpMsg(..), Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Track @@ -12,17 +13,17 @@ type alias Model x = { x | help : Maybe HelpDialog, erd : Maybe Erd } -handleHelp : HelpMsg -> Model x -> ( Model x, Cmd Msg ) +handleHelp : HelpMsg -> Model x -> ( Model x, Extra Msg ) handleHelp msg model = case msg of HOpen section -> - ( { model | help = Just { id = Conf.ids.helpDialog, openedSection = section } }, Cmd.batch [ T.sendAfter 1 (ModalOpen Conf.ids.helpDialog), Track.docOpened "navbar_top" model.erd ] ) + ( { model | help = Just { id = Conf.ids.helpDialog, openedSection = section } }, Extra.cmdL [ T.sendAfter 1 (ModalOpen Conf.ids.helpDialog), Track.docOpened "navbar_top" model.erd ] ) HClose -> - ( { model | help = Nothing }, Cmd.none ) + ( { model | help = Nothing }, Extra.none ) HToggle section -> - ( model |> setHelp (setOpenedSection (\s -> B.cond (s == section) "" section)), Cmd.none ) + ( model |> setHelp (setOpenedSection (\s -> B.cond (s == section) "" section)), Extra.none ) setHelp : (h -> h) -> { item | help : Maybe h } -> { item | help : Maybe h } diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Hotkey.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Hotkey.elm index e0fe530ed..de838d07a 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Hotkey.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Hotkey.elm @@ -5,13 +5,13 @@ import Components.Slices.DataExplorer as DataExplorer import Components.Slices.DataExplorerQuery as DataExplorerQuery import Components.Slices.NewLayoutBody as NewLayoutBody import Conf -import Libs.Bool as Bool import Libs.List as List import Libs.Maybe as Maybe import Libs.Models.Delta exposing (Delta) import Libs.Task as T import Libs.Tuple as Tuple import Models.Area as Area +import Models.Position as Position import Models.Project.CanvasProps as CanvasProps import Models.Project.ColumnPath as ColumnPath exposing (ColumnPath) import Models.Project.ColumnRef exposing (ColumnRef) @@ -75,7 +75,7 @@ handleHotkey _ model hotkey = "save" -> if model.conf.save then - ( model, T.send TriggerSaveProject ) + ( model, TriggerSaveProject |> T.send ) else ( model, "Can't save in read-only mode" |> Toasts.warning |> Toast |> T.send ) @@ -105,36 +105,34 @@ handleHotkey _ model hotkey = ( model, moveTablesOrder -1000 model ) "select-all" -> - ( model, T.send SelectAll ) + ( model, SelectAll |> T.send ) "create-layout" -> ( model, NewLayoutBody.Create |> NewLayout.Open |> NewLayoutMsg |> T.send ) "create-virtual-relation" -> - ( model, T.send (VirtualRelationMsg (model.virtualRelation |> Maybe.mapOrElse (\_ -> VRCancel) (VRCreate (model |> currentColumn)))) ) + ( model, VirtualRelationMsg (model.virtualRelation |> Maybe.mapOrElse (\_ -> VRCancel) (VRCreate (model |> currentColumn))) |> T.send ) "find-path" -> - ( model, T.send (FindPathMsg (model.findPath |> Maybe.mapOrElse (\_ -> FPClose) (FPOpen model.hoverTable Nothing))) ) + ( model, FindPathMsg (model.findPath |> Maybe.mapOrElse (\_ -> FPClose) (FPOpen (currentTable model) Nothing)) |> T.send ) "reset-zoom" -> - ( model, T.send (Zoom (1 - (model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .canvas >> .zoom) 0))) ) + ( model, Zoom (1 - (model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .canvas >> .zoom) 0)) |> T.send ) "fit-to-screen" -> - ( model, T.send FitToScreen ) + ( model, FitToScreen |> T.send ) "undo" -> - -- TODO: implement undo - ( model, "Undo action not handled yet" |> Toasts.info |> Toast |> T.send ) + ( model, Undo |> T.send ) "redo" -> - -- TODO: implement redo - ( model, "Redo action not handled yet" |> Toasts.info |> Toast |> T.send ) + ( model, Redo |> T.send ) "cancel" -> ( model, cancelElement model ) "help" -> - ( model, T.send (HelpMsg (model.help |> Maybe.mapOrElse (\_ -> HClose) (HOpen ""))) ) + ( model, HelpMsg (model.help |> Maybe.mapOrElse (\_ -> HClose) (HOpen "")) |> T.send ) _ -> ( model, "Unhandled hotkey '" ++ hotkey ++ "'" |> Toasts.warning |> Toast |> T.send ) @@ -142,26 +140,27 @@ handleHotkey _ model hotkey = notesElement : Model -> Cmd Msg notesElement model = - (model |> currentColumnRow |> Maybe.andThen (getColumnRow model) |> Maybe.map (\( r, c ) -> NOpen r.table (Just c.path) |> NotesMsg |> T.send)) - |> Maybe.orElse (model |> currentTableRow |> Maybe.andThen (getTableRow model) |> Maybe.map (\r -> NOpen r.table Nothing |> NotesMsg |> T.send)) - |> Maybe.orElse (model |> currentColumn |> Maybe.map (\r -> NOpen r.table (Just r.column) |> NotesMsg |> T.send)) - |> Maybe.orElse (model |> currentTable |> Maybe.map (\r -> NOpen r Nothing |> NotesMsg |> T.send)) - |> Maybe.withDefault ("Can't find an element with notes :(" |> Toasts.info |> Toast |> T.send) + (model |> currentColumnRow |> Maybe.andThen (getColumnRow model) |> Maybe.map (\( r, c ) -> NOpen r.table (Just c.path) |> NotesMsg)) + |> Maybe.orElse (model |> currentTableRow |> Maybe.andThen (getTableRow model) |> Maybe.map (\r -> NOpen r.table Nothing |> NotesMsg)) + |> Maybe.orElse (model |> currentColumn |> Maybe.map (\r -> NOpen r.table (Just r.column) |> NotesMsg)) + |> Maybe.orElse (model |> currentTable |> Maybe.map (\r -> NOpen r Nothing |> NotesMsg)) + |> Maybe.withDefault ("Can't find an element with notes :(" |> Toasts.info |> Toast) + |> T.send createMemo : Model -> Cmd Msg createMemo model = - model.erd |> Maybe.mapOrElse (\erd -> erd |> Erd.currentLayout |> .canvas |> CanvasProps.viewport model.erdElem |> Area.centerCanvas |> MCreate |> MemoMsg |> T.send) Cmd.none + model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .canvas >> CanvasProps.viewport model.erdElem >> Area.centerCanvas >> Position.onGrid >> MCreate >> MemoMsg >> T.send) Cmd.none createGroup : Model -> Cmd Msg createGroup model = - model.erd |> Maybe.mapOrElse (\erd -> erd |> Erd.currentLayout |> .tables |> List.filter (\t -> t.props.selected) |> List.map .id |> GCreate |> GroupMsg |> T.send) Cmd.none + model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .tables >> List.filter (.props >> .selected) >> List.map .id >> GCreate >> GroupMsg >> T.send) Cmd.none collapseElement : Model -> Cmd Msg collapseElement model = - (model |> currentTableRow |> Maybe.andThen (getTableRow model) |> Maybe.map (\r -> Bool.cond r.collapsed TableRow.Expand TableRow.Collapse |> TableRowMsg r.id |> T.send)) + (model |> currentTableRow |> Maybe.andThen (getTableRow model) |> Maybe.map (\r -> r.collapsed |> not |> TableRow.SetCollapsed |> TableRowMsg r.id |> T.send)) |> Maybe.orElse (model |> currentTable |> Maybe.map (ToggleTableCollapse >> T.send)) |> Maybe.withDefault ("Can't find an element to collapse :(" |> Toasts.info |> Toast |> T.send) @@ -181,7 +180,7 @@ shrinkElement model = showElement : Model -> Cmd Msg showElement model = (model |> currentColumnRow |> Maybe.map (\( id, col ) -> TableRow.ShowColumn (ColumnPath.toString col) |> TableRowMsg id |> T.send)) - |> Maybe.orElse (model |> currentColumn |> Maybe.map (ShowColumn >> T.send)) + |> Maybe.orElse (model |> currentColumn |> Maybe.map (ShowColumn 1000 >> T.send)) |> Maybe.orElse (model |> currentTable |> Maybe.map (\t -> ShowTable t Nothing "hotkey" |> T.send)) |> Maybe.withDefault ("Can't find an element to show :(" |> Toasts.info |> Toast |> T.send) @@ -192,18 +191,18 @@ hideElement model = |> Maybe.orElse (model |> currentTableRow |> Maybe.map (DeleteTableRow >> T.send)) |> Maybe.orElse (model |> currentColumn |> Maybe.map (HideColumn >> T.send)) |> Maybe.orElse (model |> currentTable |> Maybe.map (HideTable >> T.send)) - |> Maybe.orElse (model |> selectedItems |> Maybe.map (\( tables, rows, memos ) -> Cmd.batch ((tables |> List.map (HideTable >> T.send)) ++ (rows |> List.map (DeleteTableRow >> T.send)) ++ (memos |> List.map (MDelete >> MemoMsg >> T.send))))) + |> Maybe.orElse (model |> selectedItems |> Maybe.map (\( tables, rows, memos ) -> ((tables |> List.map HideTable) ++ (rows |> List.map DeleteTableRow) ++ (memos |> List.map (MDelete >> MemoMsg))) |> Batch |> T.send)) |> Maybe.withDefault ("Can't find an element to hide :(" |> Toasts.info |> Toast |> T.send) currentTable : Model -> Maybe TableId currentTable model = - model.hoverTable + model.hoverTable |> Maybe.map Tuple.first currentColumn : Model -> Maybe ColumnRef currentColumn model = - model.hoverColumn + model.hoverTable |> Maybe.andThen (\( t, col ) -> col |> Maybe.map (\c -> { table = t, column = c })) currentColumnRow : Model -> Maybe ( TableRow.Id, ColumnPath ) @@ -243,7 +242,8 @@ getColumnRow model ( id, col ) = cancelElement : Model -> Cmd Msg cancelElement model = -- FIXME: keep a list of cancel actions so they can be canceled in order, but they need to be removed when not cancelable anymore :/ - (model.contextMenu |> Maybe.map (\_ -> ContextMenuClose)) + (model.dragging |> Maybe.map (\d -> DragEnd True d.init)) + |> Maybe.orElse (model.contextMenu |> Maybe.map (\_ -> ContextMenuClose)) |> Maybe.orElse (model.confirm |> Maybe.map (\c -> ModalClose (ConfirmAnswer False c.content.onConfirm))) |> Maybe.orElse (model.prompt |> Maybe.map (\_ -> ModalClose (PromptAnswer Cmd.none))) |> Maybe.orElse (model.modal |> Maybe.map (\_ -> ModalClose CustomModalClose)) @@ -274,8 +274,8 @@ cancelElement model = ) |> Maybe.orElse (model.detailsSidebar |> Maybe.map (\_ -> DetailsSidebarMsg DetailsSidebar.Close)) |> Maybe.orElse (model.amlSidebar |> Maybe.map (\_ -> AmlSidebarMsg AClose)) - |> Maybe.map T.send - |> Maybe.withDefault ("Nothing to cancel" |> Toasts.info |> Toast |> T.send) + |> Maybe.withDefault ("Nothing to cancel" |> Toasts.info |> Toast) + |> T.send moveTables : Delta -> Model -> Maybe (Cmd Msg) @@ -286,7 +286,7 @@ moveTables delta model = model.erd |> Maybe.mapOrElse (Erd.currentLayout >> .tables >> List.filter (.props >> .selected)) [] in if List.nonEmpty selectedTables then - Cmd.batch (selectedTables |> List.map (\t -> T.send (TableMove t.id delta))) |> Just + selectedTables |> List.map (\t -> TableMove t.id delta) |> Batch |> T.send |> Just else Nothing @@ -349,11 +349,12 @@ moveTablesOrder delta model = tables |> List.indexedMap Tuple.new |> List.filter (\( _, t ) -> t.props.selected) in if List.nonEmpty selectedTables then - Cmd.batch (selectedTables |> List.map (\( i, t ) -> T.send (TableOrder t.id (List.length tables - 1 - i + delta)))) + selectedTables |> List.map (\( i, t ) -> TableOrder t.id (List.length tables - 1 - i + delta)) |> Batch |> T.send else (model.hoverTable - |> Maybe.andThen (\id -> tables |> List.findIndexBy .id id |> Maybe.map (\i -> ( id, i ))) - |> Maybe.map (\( id, i ) -> T.send (TableOrder id (List.length tables - 1 - i + delta))) + |> Maybe.andThen (\( id, _ ) -> tables |> List.findIndexBy .id id |> Maybe.map (\i -> ( id, i ))) + |> Maybe.map (\( id, i ) -> TableOrder id (List.length tables - 1 - i + delta)) ) - |> Maybe.withDefault ("Can't find an element to move :(" |> Toasts.info |> Toast |> T.send) + |> Maybe.withDefault ("Can't find an element to move :(" |> Toasts.info |> Toast) + |> T.send diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm index ba9d0ee1a..505566706 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Layout.elm @@ -3,14 +3,15 @@ module PagesComponents.Organization_.Project_.Updates.Layout exposing (Model, ha import Dict import Libs.List as List import Libs.Maybe as Maybe -import Libs.Task as T 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.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyM) import Ports -import Services.Lenses exposing (mapErdMCmd, 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, Extra Msg ) handleLayout msg model = case msg of - LLoad name -> - model |> mapErdMCmd (loadLayout name) + LLoad onLoad name -> + model |> mapErdMT (loadLayout onLoad name) |> Extra.defaultT LDelete name -> - model |> mapErdMCmd (deleteLayout name) |> setDirtyCmd + model |> mapErdMT (deleteLayout name) |> setDirtyM + LUnDelete_ name layout -> + model |> mapErdMT (unDeleteLayout name layout) |> setDirtyM -loadLayout : LayoutName -> Erd -> ( Erd, Cmd Msg ) -loadLayout name erd = - erd.layouts - |> Dict.get name + +loadLayout : String -> LayoutName -> Erd -> ( Erd, Extra 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 + , Extra.newCL + [ Ports.observeLayout layout, Track.layoutLoaded erd.project layout ] + ( LayoutMsg (LLoad onLoad erd.currentLayout), LayoutMsg (LLoad onLoad name) ) ) ) - ( erd, Cmd.none ) + ( erd, Extra.none ) -deleteLayout : LayoutName -> Erd -> ( Erd, Cmd Msg ) +deleteLayout : LayoutName -> Erd -> ( Erd, Extra Msg ) deleteLayout name erd = (erd.layouts |> Dict.get name) |> Maybe.map @@ -60,10 +65,27 @@ 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 + , Extra.new (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 |> Extra.msg ) else - ( erd |> mapLayouts (Dict.remove name), Track.layoutDeleted erd.project layout ) + ( erd |> mapLayouts (Dict.remove name) + , Extra.new (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 |> Extra.msg ) + + +unDeleteLayout : LayoutName -> ErdLayout -> Erd -> ( Erd, Extra Msg ) +unDeleteLayout name layout erd = + (erd.layouts |> Dict.get name) + |> Maybe.map (\_ -> ( erd, "'" ++ name ++ "' layout already exists" |> Toasts.error |> Toast |> Extra.msg )) + |> Maybe.withDefault + ( erd |> mapLayouts (Dict.insert name layout) + , Extra.history ( 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/Memo.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Memo.elm index ba4d2c395..97964fc49 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Memo.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Memo.elm @@ -12,13 +12,13 @@ import Models.UrlInfos exposing (UrlInfos) import PagesComponents.Organization_.Project_.Models exposing (MemoEdit, MemoMsg(..), Msg(..)) 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_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) import PagesComponents.Organization_.Project_.Models.MemoId as MemoId exposing (MemoId) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyM) import Ports -import Services.Lenses exposing (mapEditMemoM, mapErdM, mapMemos, mapMemosL, setColor, setContent, setEditMemo) -import Services.Toasts as Toasts +import Services.Lenses exposing (mapColorT, mapContentT, mapEditMemoM, mapErdM, mapErdMTM, mapMemos, mapMemosLT, mapMemosT, setContent, setEditMemo) import Task import Time import Track @@ -34,49 +34,52 @@ type alias Model x = } -handleMemo : Time.Posix -> UrlInfos -> MemoMsg -> Model x -> ( Model x, Cmd Msg ) +handleMemo : Time.Posix -> UrlInfos -> MemoMsg -> Model x -> ( Model x, Extra Msg ) handleMemo now urlInfos msg model = case msg of MCreate pos -> - model.erd |> Maybe.mapOrElse (\erd -> model |> createMemo now pos urlInfos erd) ( model, Cmd.none ) + model.erd |> Maybe.mapOrElse (\erd -> model |> createMemo now pos urlInfos erd) ( model, Extra.none ) MEdit memo -> model |> editMemo False memo MEditUpdate content -> - ( model |> mapEditMemoM (setContent content), Cmd.none ) + ( model |> mapEditMemoM (setContent content), Extra.none ) - MEditSave -> - model.editMemo |> Maybe.mapOrElse (\edit -> model |> saveMemo now edit) ( model, "No memo to save" |> Toasts.create "warning" |> Toast |> T.send ) + MEditSave edit -> + model |> saveMemo now edit MSetColor id color -> - model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemosL .id id (setColor color))) |> setDirty + model |> mapErdMTM (Erd.mapCurrentLayoutTMWithTime now (mapMemosLT .id id (mapColorT (\c -> ( color, Extra.history ( MemoMsg (MSetColor id c), MemoMsg (MSetColor id color) ) ))))) |> Extra.defaultT MDelete id -> model |> deleteMemo now id False + MUnDelete index memo -> + ( model |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemos (List.insertAt index memo >> List.sortBy .id))), Ports.observeMemoSize memo.id |> Extra.cmd ) -createMemo : Time.Posix -> Position.Canvas -> UrlInfos -> Erd -> Model x -> ( Model x, Cmd Msg ) + +createMemo : Time.Posix -> Position.Grid -> UrlInfos -> Erd -> Model x -> ( Model x, Extra Msg ) createMemo now position urlInfos erd model = if model.erd |> Erd.canCreateMemo then ErdLayout.createMemo (erd |> Erd.currentLayout) position |> (\memo -> model - |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemos (List.append [ memo ]))) + |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemos (List.append [ memo ] >> List.sortBy .id))) |> editMemo True memo - |> Tuple.mapSecond (\cmd -> Cmd.batch [ cmd, Ports.observeMemoSize memo.id ]) + |> Extra.addCmdT (Ports.observeMemoSize memo.id) ) else - ( model, Cmd.batch [ erd |> Erd.getProjectRef urlInfos |> ProPlan.memosModalBody |> CustomModalOpen |> T.send, Track.planLimit .memos (Just erd) ] ) + ( model, Extra.cmdL [ erd |> Erd.getProjectRef urlInfos |> ProPlan.memosModalBody |> CustomModalOpen |> T.send, Track.planLimit .memos (Just erd) ] ) -editMemo : Bool -> Memo -> Model x -> ( Model x, Cmd Msg ) +editMemo : Bool -> Memo -> Model x -> ( Model x, Extra Msg ) editMemo createMode memo model = - ( model |> setEditMemo (Just { id = memo.id, content = memo.content, createMode = createMode }), memo.id |> MemoId.toInputId |> Dom.focus |> Task.attempt (\_ -> Noop "focus-memo-input") ) + ( model |> setEditMemo (Just { id = memo.id, content = memo.content, createMode = createMode }), memo.id |> MemoId.toInputId |> Dom.focus |> Task.attempt (\_ -> Noop "focus-memo-input") |> Extra.cmd ) -saveMemo : Time.Posix -> MemoEdit -> Model x -> ( Model x, Cmd Msg ) +saveMemo : Time.Posix -> MemoEdit -> Model x -> ( Model x, Extra Msg ) saveMemo now edit model = let memoContent : String @@ -88,20 +91,56 @@ saveMemo now edit model = else if edit.content == memoContent then -- no change, don't save - ( model |> setEditMemo Nothing, Cmd.none ) + ( model |> setEditMemo Nothing, Extra.none ) else - ( model |> setEditMemo Nothing |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemosL .id edit.id (setContent edit.content))), Track.memoSaved edit.createMode edit.content model.erd ) |> setDirtyCmd - - -deleteMemo : Time.Posix -> MemoId -> Bool -> Model x -> ( Model x, Cmd Msg ) + model + |> setEditMemo Nothing + |> mapErdMTM + (Erd.mapCurrentLayoutTMWithTime now + (mapMemosLT .id + edit.id + (\memo -> + memo + |> mapContentT + (\c -> + ( edit.content + , Extra.newHL + (Track.memoSaved edit.createMode edit.content model.erd) + (if edit.createMode then + [ ( MemoMsg (MDelete edit.id), MemoMsg (MUnDelete 0 { memo | content = edit.content }) ) ] + + else + [ ( MemoMsg (MEditSave { edit | content = c }), MemoMsg (MEditSave edit) ) ] + ) + ) + ) + ) + ) + ) + |> setDirtyM + + +deleteMemo : Time.Posix -> MemoId -> Bool -> Model x -> ( Model x, Extra Msg ) deleteMemo now id createMode model = model - |> mapErdM (Erd.mapCurrentLayoutWithTime now (mapMemos (List.filter (\m -> m.id /= id)))) - |> (\m -> + |> mapErdMTM + (Erd.mapCurrentLayoutTWithTime now + (mapMemosT + (\memos -> + case memos |> List.zipWithIndex |> List.partition (\( m, _ ) -> m.id == id) of + ( ( deleted, index ) :: _, kept ) -> + ( kept |> List.map Tuple.first, [ ( MemoMsg (MUnDelete index deleted), MemoMsg (MDelete deleted.id) ) ] ) + + _ -> + ( memos, [] ) + ) + ) + ) + |> (\( m, hist ) -> if createMode then - ( m, Cmd.none ) + ( m, Extra.none ) else - ( m, Track.memoDeleted model.erd ) |> setDirtyCmd + ( m, Extra.newHL (Track.memoDeleted model.erd) (hist |> Maybe.withDefault []) ) |> setDirty ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Notes.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Notes.elm index 23dc27a08..beaff4665 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Notes.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Notes.elm @@ -9,7 +9,8 @@ import PagesComponents.Organization_.Project_.Models exposing (Msg(..), NotesDia import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) import PagesComponents.Organization_.Project_.Models.NotesMsg exposing (NotesMsg(..)) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty) import Services.Lenses exposing (mapEditNotesM, mapErdM, mapMetadata, setEditNotes, setNotes) import Track @@ -23,7 +24,7 @@ type alias Model x = } -handleNotes : NotesMsg -> Model x -> ( Model x, Cmd Msg ) +handleNotes : NotesMsg -> Model x -> ( Model x, Extra Msg ) handleNotes msg model = case msg of NOpen table column -> @@ -33,11 +34,11 @@ handleNotes msg model = model.erd |> Maybe.andThen (.metadata >> Metadata.getNotes table column) |> Maybe.withDefault "" in ( model |> setEditNotes (Just { id = Conf.ids.editNotesDialog, table = table, column = column, initialNotes = notes, notes = notes }) - , Cmd.batch [ T.sendAfter 1 (ModalOpen Conf.ids.editNotesDialog), Cmd.none ] + , ModalOpen Conf.ids.editNotesDialog |> T.sendAfter 1 |> Extra.cmd ) NEdit notes -> - ( model |> mapEditNotesM (setNotes notes), Cmd.none ) + ( model |> mapEditNotesM (setNotes notes), Extra.none ) NSave table column initialNotes notes -> let @@ -55,7 +56,10 @@ handleNotes msg model = else Track.notesUpdated notes model.erd in - ( model |> setEditNotes Nothing |> mapErdM (mapMetadata (Metadata.putNotes table column (String.nonEmptyMaybe notes))), cmd ) |> setDirtyCmd + ( model |> setEditNotes Nothing |> mapErdM (mapMetadata (Metadata.putNotes table column (String.nonEmptyMaybe notes))) + , Extra.new cmd ( NotesMsg (NSave table column notes initialNotes), NotesMsg msg ) + ) + |> setDirty NCancel -> - ( model |> setEditNotes Nothing, Cmd.none ) + ( model |> setEditNotes Nothing, Extra.none ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Project.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Project.elm index 63b998c26..bcfa9335b 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Project.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Project.elm @@ -11,11 +11,12 @@ import Models.UrlInfos exposing (UrlInfos) import PagesComponents.Organization_.Project_.Components.ProjectSaveDialog as ProjectSaveDialog import PagesComponents.Organization_.Project_.Models exposing (Model, Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Services.Toasts as Toasts -triggerSaveProject : UrlInfos -> List Organization -> Model -> ( Model, Cmd Msg ) +triggerSaveProject : UrlInfos -> List Organization -> Model -> ( Model, Extra Msg ) triggerSaveProject urlInfos organizations model = let preselectedOrg : Maybe Organization @@ -24,7 +25,7 @@ triggerSaveProject urlInfos organizations model = in ( model , model.erd - |> Maybe.mapOrElse + |> Maybe.map (\e -> e.project.organization |> Maybe.map (\_ -> UpdateProject |> T.send) @@ -36,54 +37,46 @@ triggerSaveProject urlInfos organizations model = ProjectSaveDialog.Open e.project.name preselectedOrg |> ProjectSaveMsg |> T.send ) ) - Cmd.none + |> Extra.cmdM ) -createProject : ProjectName -> Organization -> ProjectStorage -> Model -> ( Model, Cmd Msg ) +createProject : ProjectName -> Organization -> ProjectStorage -> Model -> ( Model, Extra Msg ) createProject name organization storage model = if model.conf.save then (model.erd |> Maybe.map Erd.unpack) |> Maybe.mapOrElse (\p -> p.organization - |> Maybe.map (\_ -> ( model, "Project already created" |> Toasts.warning |> Toast |> T.send )) - |> Maybe.withDefault ( { model | saving = True }, Ports.createProject organization.id storage { p | name = name } ) + |> Maybe.map (\_ -> ( model, "Project already created" |> Toasts.warning |> Toast |> Extra.msg )) + |> Maybe.withDefault ( { model | saving = True }, Ports.createProject organization.id storage { p | name = name } |> Extra.cmd ) ) - ( model, "No project to save" |> Toasts.warning |> Toast |> T.send ) + ( model, "No project to save" |> Toasts.warning |> Toast |> Extra.msg ) else - ( model, Cmd.none ) + ( model, Extra.none ) -updateProject : Model -> ( Model, Cmd Msg ) +updateProject : Model -> ( Model, Extra Msg ) updateProject model = if model.conf.save then (model.erd |> Maybe.map Erd.unpack) |> Maybe.mapOrElse (\p -> p.organization - |> Maybe.map (\_ -> ( { model | saving = True }, Ports.updateProject p )) - |> Maybe.withDefault ( model, "Project doesn't exist" |> Toasts.warning |> Toast |> T.send ) + |> Maybe.map (\_ -> ( { model | saving = True }, Ports.updateProject p |> Extra.cmd )) + |> Maybe.withDefault ( model, "Project doesn't exist" |> Toasts.warning |> Toast |> Extra.msg ) ) - ( model, "No project to save" |> Toasts.warning |> Toast |> T.send ) + ( model, "No project to save" |> Toasts.warning |> Toast |> Extra.msg ) else - ( model, Cmd.none ) + ( model, Extra.none ) -moveProject : ProjectStorage -> Model -> ( Model, Cmd Msg ) +moveProject : ProjectStorage -> Model -> ( Model, Extra Msg ) moveProject storage model = if model.conf.save then - ( model - , Cmd.batch - (model.erd - |> Maybe.map Erd.unpack - |> Maybe.mapOrElse - (\p -> [ Ports.moveProjectTo p storage ]) - [ "No project to move" |> Toasts.warning |> Toast |> T.send ] - ) - ) + ( model, Extra.cmd (model.erd |> Maybe.map Erd.unpack |> Maybe.mapOrElse (\p -> Ports.moveProjectTo p storage) ("No project to move" |> Toasts.warning |> Toast |> T.send)) ) else - ( model, Cmd.none ) + ( model, Extra.none ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/ProjectSettings.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/ProjectSettings.elm index 65071fe39..2caa231be 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/ProjectSettings.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/ProjectSettings.elm @@ -5,16 +5,18 @@ import Libs.Bool as B import Libs.List as List import Libs.Maybe as Maybe import Libs.Task as T +import Libs.Tuple as Tuple import Models.Project.ProjectSettings as ProjectSettings -import Models.Project.Source as Source +import Models.Project.Source as Source exposing (Source) import Models.Project.TableId exposing (TableId) import PagesComponents.Organization_.Project_.Components.SourceUpdateDialog as SourceUpdateDialog import PagesComponents.Organization_.Project_.Models exposing (Msg(..), ProjectSettingsDialog, ProjectSettingsMsg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty, setDirtyM) import Ports -import Services.Lenses exposing (mapCollapseTableColumns, mapColumnBasicTypes, mapEnabled, mapErdM, mapHiddenColumns, mapProps, mapRelations, mapRemoveViews, mapRemovedSchemas, mapSettingsM, mapSourceUpdateCmd, setColumnOrder, setDefaultSchema, setList, setMax, setName, setRelationStyle, setRemovedTables, setSettings) +import Services.Lenses exposing (mapCollapseTableColumns, mapColumnBasicTypes, mapEnabled, mapErdM, mapErdMT, mapErdMTM, mapHiddenColumns, mapNameT, mapProps, mapRelations, mapRemoveViews, mapRemovedSchemas, mapSettingsM, mapSourceUpdateT, setColumnOrder, setDefaultSchema, setList, setMax, setRelationStyle, setRemovedTables, setSettings) import Services.Toasts as Toasts import Time import Track @@ -30,82 +32,136 @@ type alias Model x = } -handleProjectSettings : Time.Posix -> ProjectSettingsMsg -> Model x -> ( Model x, Cmd Msg ) +handleProjectSettings : Time.Posix -> ProjectSettingsMsg -> Model x -> ( Model x, Extra Msg ) handleProjectSettings now msg model = case msg of PSOpen -> - ( model |> setSettings (Just { id = Conf.ids.settingsDialog, sourceNameEdit = Nothing }), Cmd.batch [ T.sendAfter 1 (ModalOpen Conf.ids.settingsDialog) ] ) + ( model |> setSettings (Just { id = Conf.ids.settingsDialog, sourceNameEdit = Nothing }), ModalOpen Conf.ids.settingsDialog |> T.sendAfter 1 |> Extra.cmd ) PSClose -> - ( model |> setSettings Nothing, Cmd.none ) + ( model |> setSettings Nothing, Extra.none ) PSSourceToggle source -> model |> mapErdM (Erd.mapSource source.id (mapEnabled not)) - |> (\updated -> - ( updated - , Cmd.batch - [ Ports.observeTablesSize (updated.erd |> getShownTables) - , "Source " ++ source.name ++ " set to " ++ B.cond source.enabled "hidden" "visible" ++ "." |> Toasts.info |> Toast |> T.send + |> (\newModel -> + ( newModel + , Extra.cmdL + [ Ports.observeTablesSize (newModel.erd |> getShownTables) + , "'" ++ source.name ++ "' source set to " ++ B.cond source.enabled "hidden" "visible" ++ "." |> Toasts.info |> Toast |> T.send ] ) ) - |> setDirtyCmd + |> setDirty PSSourceNameUpdate source name -> - ( model |> mapSettingsM (\s -> { s | sourceNameEdit = Just source }) |> mapErdM (Erd.mapSource source (setName name)), Cmd.none ) + ( model |> mapSettingsM (\s -> { s | sourceNameEdit = Just ( source, name ) }), Extra.none ) - PSSourceNameUpdateDone -> - ( model |> mapSettingsM (\s -> { s | sourceNameEdit = Nothing }), Cmd.none ) + PSSourceNameUpdateDone source name -> + model + |> mapSettingsM (\s -> { s | sourceNameEdit = Nothing }) + |> mapErdMTM + (Erd.mapSourceT source + (mapNameT + (\old -> + ( name + , if old == name then + Extra.none + + else + Extra.history (( PSSourceNameUpdateDone source old, PSSourceNameUpdateDone source name ) |> Tuple.map ProjectSettingsMsg) + ) + ) + ) + ) + |> Extra.defaultT - PSSourceDelete source -> - ( model |> mapErdM (Erd.mapSources (List.filter (\s -> s.id /= source.id))), Cmd.batch [ "Source " ++ source.name ++ " has been deleted from your project." |> Toasts.info |> Toast |> T.send, Track.sourceDeleted model.erd source ] ) |> setDirtyCmd + PSSourceDelete sourceId -> + model + |> mapErdMT + (Erd.mapSourcesT + (\sources -> + case sources |> List.zipWithIndex |> List.partition (\( s, _ ) -> s.id == sourceId) of + ( ( deleted, index ) :: _, kept ) -> + ( kept |> List.map Tuple.first + , Extra.newCL + [ "'" ++ deleted.name ++ "' source removed from project." |> Toasts.info |> Toast |> T.send, Track.sourceDeleted model.erd deleted ] + (( PSSourceUnDelete_ index deleted, msg ) |> Tuple.map ProjectSettingsMsg) + ) + + _ -> + ( sources, Extra.none ) + ) + ) + |> setDirtyM + + PSSourceUnDelete_ index source -> + model + |> mapErdM (Erd.mapSources (List.insertAt index source)) + |> (\newModel -> ( newModel, Ports.observeTablesSize (newModel.erd |> getShownTables) |> Extra.cmd ) |> setDirty) PSSourceUpdate message -> - model |> mapSourceUpdateCmd (SourceUpdateDialog.update (PSSourceUpdate >> ProjectSettingsMsg) ModalOpen Noop now (model.erd |> Maybe.map .project) message) + model |> mapSourceUpdateT (SourceUpdateDialog.update (PSSourceUpdate >> ProjectSettingsMsg) ModalOpen Noop now (model.erd |> Maybe.map .project) message) PSSourceSet source -> - if model.erd |> Maybe.mapOrElse (\erd -> erd.sources |> List.memberBy .id source.id) False then - ( model |> mapErdM (Erd.mapSource source.id (Source.refreshWith source)), Cmd.batch [ T.send (ModalClose (SourceUpdateDialog.Close |> PSSourceUpdate |> ProjectSettingsMsg)), Track.sourceRefreshed model.erd source ] ) |> setDirtyCmd - - else - ( model |> mapErdM (Erd.mapSources (List.add source)), Cmd.batch [ T.send (ModalClose (SourceUpdateDialog.Close |> PSSourceUpdate |> ProjectSettingsMsg)), Track.sourceAdded model.erd source ] ) |> setDirtyCmd + model + |> mapErdMT + (Erd.mapSourcesT + (\sources -> + let + close : Cmd Msg + close = + model.sourceUpdate |> Maybe.map (\_ -> SourceUpdateDialog.Close |> PSSourceUpdate |> ProjectSettingsMsg |> ModalClose) |> Maybe.withDefault (Noop "close-source-update") |> T.send + in + (sources |> List.findBy .id source.id) + |> Maybe.mapOrElse + (\s -> + ( sources |> List.mapBy .id source.id (Source.refreshWith source) + , Extra.newCL [ close, Track.sourceRefreshed model.erd source ] (( PSSourceSet s, msg ) |> Tuple.map ProjectSettingsMsg) + ) + ) + ( sources |> List.insert source + , Extra.newCL [ close, Track.sourceAdded model.erd source ] (( PSSourceDelete source.id, msg ) |> Tuple.map ProjectSettingsMsg) + ) + ) + ) + |> setDirtyM PSDefaultSchemaUpdate value -> - model |> mapErdM (Erd.mapSettings (setDefaultSchema value)) |> setDirty + ( model |> mapErdM (Erd.mapSettings (setDefaultSchema value)), Extra.none ) |> setDirty PSSchemaToggle schema -> - model |> mapErdM (Erd.mapSettings (mapRemovedSchemas (List.toggle schema))) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) )) |> setDirtyCmd + model |> mapErdM (Erd.mapSettings (mapRemovedSchemas (List.toggle schema))) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) |> Extra.cmd )) |> setDirty PSRemoveViewsToggle -> - model |> mapErdM (Erd.mapSettings (mapRemoveViews not)) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) )) |> setDirtyCmd + model |> mapErdM (Erd.mapSettings (mapRemoveViews not)) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) |> Extra.cmd )) |> setDirty PSRemovedTablesUpdate values -> - model |> mapErdM (Erd.mapSettings (setRemovedTables values >> ProjectSettings.fillFindPath)) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) )) |> setDirtyCmd + model |> mapErdM (Erd.mapSettings (setRemovedTables values >> ProjectSettings.fillFindPath)) |> (\m -> ( m, Ports.observeTablesSize (m.erd |> getShownTables) |> Extra.cmd )) |> setDirty PSHiddenColumnsListUpdate values -> - model |> mapErdM (Erd.mapSettings (mapHiddenColumns (setList values) >> ProjectSettings.fillFindPath)) |> setDirty + ( model |> mapErdM (Erd.mapSettings (mapHiddenColumns (setList values) >> ProjectSettings.fillFindPath)), Extra.none ) |> setDirty PSHiddenColumnsMaxUpdate value -> - value |> String.toInt |> Maybe.mapOrElse (\max -> model |> mapErdM (Erd.mapSettings (mapHiddenColumns (setMax max) >> ProjectSettings.fillFindPath))) model |> setDirty + ( value |> String.toInt |> Maybe.mapOrElse (\max -> model |> mapErdM (Erd.mapSettings (mapHiddenColumns (setMax max) >> ProjectSettings.fillFindPath))) model, Extra.none ) |> setDirty PSHiddenColumnsPropsToggle -> - model |> mapErdM (Erd.mapSettings (mapHiddenColumns (mapProps not))) |> setDirty + ( model |> mapErdM (Erd.mapSettings (mapHiddenColumns (mapProps not))), Extra.none ) |> setDirty PSHiddenColumnsRelationsToggle -> - model |> mapErdM (Erd.mapSettings (mapHiddenColumns (mapRelations not))) |> setDirty + ( model |> mapErdM (Erd.mapSettings (mapHiddenColumns (mapRelations not))), Extra.none ) |> setDirty PSColumnOrderUpdate order -> - model |> mapErdM (\e -> e |> Erd.mapSettings (setColumnOrder order)) |> setDirty + ( model |> mapErdM (\e -> e |> Erd.mapSettings (setColumnOrder order)), Extra.none ) |> setDirty PSRelationStyleUpdate style -> - model |> mapErdM (\e -> e |> Erd.mapSettings (setRelationStyle style)) |> setDirty + ( model |> mapErdM (\e -> e |> Erd.mapSettings (setRelationStyle style)), Extra.none ) |> setDirty PSColumnBasicTypesToggle -> - model |> mapErdM (Erd.mapSettings (mapColumnBasicTypes not)) |> setDirty + ( model |> mapErdM (Erd.mapSettings (mapColumnBasicTypes not)), Extra.none ) |> setDirty PSCollapseTableOnShowToggle -> - model |> mapErdM (Erd.mapSettings (mapCollapseTableColumns not)) |> setDirty + ( model |> mapErdM (Erd.mapSettings (mapCollapseTableColumns not)), Extra.none ) |> setDirty getShownTables : Maybe Erd -> List TableId diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Source.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Source.elm index 55787cfbc..40eed1d66 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Source.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Source.elm @@ -1,40 +1,49 @@ -module PagesComponents.Organization_.Project_.Updates.Source exposing (createRelations) +module PagesComponents.Organization_.Project_.Updates.Source exposing (createRelations, deleteRelations) import Conf import Libs.List as List import Libs.Task as T import Models.Project.ColumnRef exposing (ColumnRef) import Models.Project.Source as Source -import Models.Project.SourceId as SourceId +import Models.Project.SourceId as SourceId exposing (SourceId) import Models.Project.SourceKind exposing (SourceKind(..)) import Models.Project.TableId as TableId import PagesComponents.Organization_.Project_.Models exposing (Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Random import Services.Toasts as Toasts import Time -createRelations : Time.Posix -> List { src : ColumnRef, ref : ColumnRef } -> Erd -> ( Erd, Cmd Msg ) +createRelations : Time.Posix -> List { src : ColumnRef, ref : ColumnRef } -> Erd -> ( Erd, Extra Msg ) createRelations now rels erd = case erd.sources |> List.find (\s -> s.kind == AmlEditor && s.name == Conf.constants.virtualRelationSourceName) of Just source -> ( erd |> Erd.mapSource source.id (Source.addRelations now rels) - , case rels of - [] -> - "No relation to add." |> Toasts.info |> Toast |> T.send + , Extra.new + (case rels of + [] -> + "No relation to add." |> Toasts.info |> Toast |> T.send - { src, ref } :: [] -> - "Relation " ++ TableId.show erd.settings.defaultSchema src.table ++ " → " ++ TableId.show erd.settings.defaultSchema ref.table ++ " added to " ++ source.name ++ " source." |> Toasts.info |> Toast |> T.send + { src, ref } :: [] -> + TableId.show erd.settings.defaultSchema src.table ++ " → " ++ TableId.show erd.settings.defaultSchema ref.table ++ " relation added to '" ++ source.name ++ "' source." |> Toasts.info |> Toast |> T.send - _ -> - (rels |> List.length |> String.fromInt) ++ " relations added to " ++ source.name ++ " source." |> Toasts.info |> Toast |> T.send + _ -> + (rels |> List.length |> String.fromInt) ++ " relations added to " ++ source.name ++ " source." |> Toasts.info |> Toast |> T.send + ) + ( RemoveRelations_ source.id rels, CreateRelations rels ) ) Nothing -> ( erd - , Cmd.batch + , Extra.cmdL [ SourceId.generator |> Random.generate (Source.aml Conf.constants.virtualRelationSourceName now >> Source.addRelations now rels >> CreateUserSourceWithId) - , "Created " ++ Conf.constants.virtualRelationSourceName ++ " source to add the relations." |> Toasts.info |> Toast |> T.send + , "'" ++ Conf.constants.virtualRelationSourceName ++ "' source added to project with new relation." |> Toasts.info |> Toast |> T.send ] ) + + +deleteRelations : SourceId -> List { src : ColumnRef, ref : ColumnRef } -> Erd -> ( Erd, Extra Msg ) +deleteRelations sourceId rels erd = + ( erd |> Erd.mapSource sourceId (Source.removeRelations rels), Extra.history ( CreateRelations rels, RemoveRelations_ sourceId rels ) ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Table.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Table.elm index 290c14409..4a9119d13 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Table.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Table.elm @@ -1,5 +1,6 @@ -module PagesComponents.Organization_.Project_.Updates.Table exposing (goToTable, hideColumn, hideColumns, hideRelatedTables, hideTable, hoverColumn, hoverNextColumn, mapTablePropOrSelected, showAllTables, showColumn, showColumns, showRelatedTables, showTable, showTables, sortColumns, toggleNestedColumn) +module PagesComponents.Organization_.Project_.Updates.Table exposing (goToTable, hideColumn, hideColumns, hideRelatedTables, hideTable, hoverColumn, hoverNextColumn, mapTablePropOrSelected, mapTablePropOrSelectedTE, showAllTables, showColumn, showColumns, showRelatedTables, showTable, showTables, sortColumns, toggleNestedColumn, unHideTable) +import Components.Organisms.Table exposing (TableHover) import Conf import Dict import Libs.Bool as B @@ -26,6 +27,7 @@ import PagesComponents.Organization_.Project_.Models exposing (Model, Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdColumn exposing (ErdColumn, ErdNestedColumns(..)) import PagesComponents.Organization_.Project_.Models.ErdColumnProps as ErdColumnProps exposing (ErdColumnProps, ErdColumnPropsFlat, ErdColumnPropsNested(..)) +import PagesComponents.Organization_.Project_.Models.ErdLayout as ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.ErdRelation as ErdRelation import PagesComponents.Organization_.Project_.Models.ErdTable as ErdTable exposing (ErdTable) import PagesComponents.Organization_.Project_.Models.ErdTableLayout as ErdTableLayout exposing (ErdTableLayout) @@ -33,20 +35,34 @@ import PagesComponents.Organization_.Project_.Models.ErdTableProps exposing (Erd import PagesComponents.Organization_.Project_.Models.HideColumns as HideColumns exposing (HideColumns) import PagesComponents.Organization_.Project_.Models.PositionHint as PositionHint exposing (PositionHint(..)) import PagesComponents.Organization_.Project_.Models.ShowColumns as ShowColumns exposing (ShowColumns) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports -import Services.Lenses exposing (mapCanvas, mapColumns, mapProps, mapRelatedTables, mapTables, mapTablesL, setHighlighted, setHoverColumn, setPosition, setSelected, setShown) +import Services.Lenses exposing (mapCanvas, mapColumns, mapColumnsT, mapRelatedTables, mapTables, mapTablesL, mapTablesLTM, mapTablesT, setHighlighted, setHoverTable, setPosition, setShown) import Services.Toasts as Toasts import Set exposing (Set) import Time import Track -goToTable : Time.Posix -> TableId -> ErdProps -> Erd -> ( Erd, Cmd Msg ) +goToTable : Time.Posix -> TableId -> ErdProps -> Erd -> ( Erd, Extra Msg ) goToTable now id viewport erd = (erd |> Erd.getLayoutTable id) - |> Maybe.map (\p -> placeTableAtCenter viewport (erd |> Erd.currentLayout |> .canvas) p.props) - |> Maybe.map (\pos -> ( erd |> Erd.mapCurrentLayoutWithTime now (mapTables (List.map (\t -> t |> mapProps (setSelected (t.id == id)))) >> mapCanvas (setPosition pos)), Cmd.none )) - |> Maybe.withDefault ( erd, "Table " ++ TableId.show erd.settings.defaultSchema id ++ " not shown" |> Toasts.info |> Toast |> T.send ) + |> Maybe.map (\t -> ( placeTableAtCenter viewport (erd |> Erd.currentLayout |> .canvas) t.props, TableId.toHtmlId id )) + |> Maybe.map + (\( pos, htmlId ) -> + erd + |> Erd.mapCurrentLayoutTWithTime now + (\l -> + ( l |> mapCanvas (setPosition pos) |> ErdLayout.mapSelected (\i _ -> i.id == htmlId) + , Extra.history + ( Batch [ CanvasPosition l.canvas.position, SelectItems_ (ErdLayout.getSelected l) ] + , Batch [ CanvasPosition pos, SelectItems_ [ htmlId ] ] + ) + ) + ) + |> Extra.defaultT + ) + |> Maybe.withDefault ( erd, "Table " ++ TableId.show erd.settings.defaultSchema id ++ " not shown" |> Toasts.info |> Toast |> Extra.msg ) placeTableAtCenter : ErdProps -> CanvasProps -> ErdTableProps -> Position.Diagram @@ -63,51 +79,52 @@ placeTableAtCenter viewport canvas table = canvas.position |> Position.moveDiagram delta -showTable : Time.Posix -> TableId -> Maybe PositionHint -> String -> Erd -> ( Erd, Cmd Msg ) +showTable : Time.Posix -> TableId -> Maybe PositionHint -> String -> Erd -> ( Erd, Extra Msg ) showTable now id hint from erd = case erd |> Erd.getTable id of Just table -> if erd |> Erd.isShown id then - ( erd, "Table " ++ TableId.show erd.settings.defaultSchema id ++ " already shown" |> Toasts.info |> Toast |> T.send ) + ( erd, "Table " ++ TableId.show erd.settings.defaultSchema id ++ " already shown" |> Toasts.info |> Toast |> Extra.msg ) else - ( erd |> performShowTable now table hint, Cmd.batch [ Ports.observeTableSize table.id, Track.tableShown 1 from (Just erd) ] ) + erd |> performShowTable now table hint |> Tuple.mapSecond (Extra.newLL [ Ports.observeTableSize table.id, Track.tableShown 1 from (Just erd) ]) Nothing -> - ( erd, "Can't show table " ++ TableId.show erd.settings.defaultSchema id ++ ": not found" |> Toasts.error |> Toast |> T.send ) + ( erd, "Can't show table " ++ TableId.show erd.settings.defaultSchema id ++ ": not found" |> Toasts.error |> Toast |> Extra.msg ) -showTables : Time.Posix -> List TableId -> Maybe PositionHint -> String -> Erd -> ( Erd, Cmd Msg ) +showTables : Time.Posix -> List TableId -> Maybe PositionHint -> String -> Erd -> ( Erd, Extra Msg ) showTables now ids hint from erd = ids |> List.indexedMap (\i id -> ( id, erd |> Erd.getTable id, hint |> Maybe.map (PositionHint.move { dx = 0, dy = Conf.ui.table.headerHeight * toFloat i }) )) |> List.foldl - (\( id, maybeTable, tableHint ) ( e, ( found, shown, notFound ) ) -> + (\( id, maybeTable, tableHint ) ( ( e, h ), ( found, shown, notFound ) ) -> case maybeTable of Just table -> if erd |> Erd.isShown id then - ( e, ( found, id :: shown, notFound ) ) + ( ( e, h ), ( found, id :: shown, notFound ) ) else - ( e |> performShowTable now table tableHint, ( id :: found, shown, notFound ) ) + ( e |> performShowTable now table tableHint |> Tuple.mapSecond (\m -> m ++ h), ( id :: found, shown, notFound ) ) Nothing -> - ( e, ( found, shown, id :: notFound ) ) + ( ( e, h ), ( found, shown, id :: notFound ) ) ) - ( erd, ( [], [], [] ) ) - |> (\( e, ( found, shown, notFound ) ) -> + ( ( erd, [] ), ( [], [], [] ) ) + |> (\( ( e, h ), ( found, shown, notFound ) ) -> ( e - , Cmd.batch + , Extra.newLL [ Ports.observeTablesSize found , B.cond (shown |> List.isEmpty) Cmd.none (Track.tableShown (List.length shown) from (Just erd)) , B.cond (shown |> List.isEmpty) Cmd.none ("Tables " ++ (shown |> List.map (TableId.show erd.settings.defaultSchema) |> String.join ", ") ++ " are already shown" |> Toasts.info |> Toast |> T.send) , B.cond (notFound |> List.isEmpty) Cmd.none ("Can't show tables " ++ (notFound |> List.map (TableId.show erd.settings.defaultSchema) |> String.join ", ") ++ ": can't found them" |> Toasts.info |> Toast |> T.send) ] + (h |> List.reverse) ) ) -showAllTables : Time.Posix -> String -> Erd -> ( Erd, Cmd Msg ) +showAllTables : Time.Posix -> String -> Erd -> ( Erd, Extra Msg ) showAllTables now from erd = let shownIds : Set TableId @@ -123,28 +140,33 @@ showAllTables now from erd = tablesToShow |> List.map (\t -> t |> ErdTableLayout.init erd.settings shownIds (erd.relationsByTable |> Dict.getOrElse t.id []) erd.settings.collapseTableColumns Nothing) in ( erd |> Erd.mapCurrentLayoutWithTime now (mapTables (\old -> newTables ++ old)) - , Cmd.batch + , Extra.newCL [ Ports.observeTablesSize (newTables |> List.map .id) , B.cond (newTables |> List.isEmpty) Cmd.none (Track.tableShown (List.length newTables) from (Just erd)) ] + ( tablesToShow |> List.map (\t -> HideTable t.id) |> Batch, ShowAllTables "redo" ) ) -hideTable : Time.Posix -> TableId -> Erd -> Erd +hideTable : Time.Posix -> TableId -> Erd -> ( Erd, Extra Msg ) hideTable now id erd = if erd |> Erd.currentLayout |> .tables |> List.findBy .id id |> Maybe.map (.props >> .selected) |> Maybe.withDefault False then - erd |> Erd.currentLayout |> .tables |> List.filter (.props >> .selected) |> List.foldl (\p -> performHideTable now p.id) erd + (erd |> Erd.currentLayout |> .tables) + |> List.filter (.props >> .selected) + |> List.foldl (\p ( e, h ) -> performHideTable now p.id e |> Tuple.mapSecond (Extra.combine h)) ( erd, Extra.none ) else performHideTable now id erd -showRelatedTables : TableId -> Erd -> ( Erd, Cmd Msg ) -showRelatedTables id erd = - erd - |> Erd.currentLayout - |> .tables - |> List.findBy .id id +unHideTable : Time.Posix -> Int -> ErdTableLayout -> Erd -> ( Erd, Extra Msg ) +unHideTable now index table erd = + ( erd |> performReshowTable now index table, Extra.newCL [ Ports.observeTableSize table.id, Track.tableShown 1 "undo" (Just erd) ] ( HideTable table.id, UnHideTable_ index table ) ) + + +showRelatedTables : Time.Posix -> TableId -> Erd -> ( Erd, Extra Msg ) +showRelatedTables now id erd = + (erd |> Erd.currentLayout |> .tables |> List.findBy .id id) |> Maybe.mapOrElse (\table -> let @@ -188,10 +210,18 @@ showRelatedTables id erd = shows : List ( TableId, Maybe PositionHint ) shows = toShow |> List.foldl (\( t, h ) ( cur, res ) -> ( cur + h + padding.dy, ( t, Just (PlaceAt (Position.grid { left = left, top = cur })) ) :: res )) ( top, [] ) |> Tuple.second + + ( newErd, extra ) = + shows |> List.foldl (\( t, h ) ( e, cs ) -> showTable now t h "related" e |> Tuple.mapSecond (Extra.combine cs)) ( erd, Extra.none ) + + ( back, forward ) = + ( shows |> List.map (\( t, _ ) -> HideTable t) |> Batch + , shows |> List.map (\( t, h ) -> ShowTable t h "related") |> Batch + ) in - ( erd, Cmd.batch (shows |> List.map (\( t, hint ) -> T.send (ShowTable t hint "related"))) ) + ( newErd, extra |> Extra.setHistory ( back, forward ) ) ) - ( erd, Cmd.none ) + ( erd, Extra.none ) guessHeight : TableId -> Erd -> Float @@ -201,8 +231,8 @@ guessHeight id erd = |> Maybe.withDefault 200 -hideRelatedTables : TableId -> Erd -> ( Erd, Cmd Msg ) -hideRelatedTables id erd = +hideRelatedTables : Time.Posix -> TableId -> Erd -> ( Erd, Extra Msg ) +hideRelatedTables now id erd = let related : List TableId related = @@ -216,50 +246,62 @@ hideRelatedTables id erd = else r.src.table ) + + shownTables : List ( ErdTableLayout, Int ) + shownTables = + erd |> Erd.currentLayout |> .tables |> List.zipWithIndex |> List.filter (\( t, _ ) -> related |> List.member t.id) in - ( erd, Cmd.batch (related |> List.map (\t -> T.send (HideTable t))) ) + ( related |> List.foldl (\t e -> hideTable now t e |> Tuple.first) erd + , Extra.history ( shownTables |> List.map (\( t, i ) -> UnHideTable_ i t) |> Batch, related |> List.map HideTable |> Batch ) + ) -showColumn : Time.Posix -> TableId -> ColumnPath -> Erd -> Erd -showColumn now table column erd = - erd |> Erd.mapCurrentLayoutWithTime now (mapTablesL .id table (mapColumns (ErdColumnProps.remove column >> ErdColumnProps.add column))) +showColumn : Time.Posix -> Int -> ColumnRef -> Erd -> ( Erd, Extra Msg ) +showColumn now index column erd = + ( erd |> Erd.mapCurrentLayoutWithTime now (mapTablesL .id column.table (mapColumns (ErdColumnProps.remove column.column >> ErdColumnProps.insertAt index column.column))) + , Extra.history ( HideColumn column, ShowColumn index column ) + ) -hideColumn : Time.Posix -> TableId -> ColumnPath -> Erd -> Erd -hideColumn now table column erd = - erd |> Erd.mapCurrentLayoutWithTime now (mapTablesL .id table (mapColumns (ErdColumnProps.remove column))) +hideColumn : Time.Posix -> ColumnRef -> Erd -> ( Erd, Extra Msg ) +hideColumn now column erd = + erd + |> Erd.mapCurrentLayoutTWithTime now + (mapTablesLTM .id column.table (mapColumnsT (ErdColumnProps.removeWithIndex column.column)) + >> Tuple.mapSecond (Maybe.map (\i -> ( ShowColumn i column, HideColumn column )) >> Extra.historyM) + ) + |> Extra.defaultT -hoverNextColumn : TableId -> ColumnPath -> Model -> Model -hoverNextColumn table column model = +hoverNextColumn : ColumnRef -> Model -> Model +hoverNextColumn column model = let nextColumn : Maybe ColumnPath nextColumn = model.erd - |> Maybe.andThen (Erd.currentLayout >> .tables >> List.findBy .id table) - |> Maybe.andThen (.columns >> ErdColumnProps.unpackAll >> List.dropUntil (\p -> p == column) >> List.drop 1 >> List.head) + |> Maybe.andThen (Erd.currentLayout >> .tables >> List.findBy .id column.table) + |> Maybe.andThen (.columns >> ErdColumnProps.unpackAll >> List.dropUntil (\p -> p == column.column) >> List.drop 1 >> List.head) in - model |> setHoverColumn (nextColumn |> Maybe.map (ColumnRef table)) + model |> setHoverTable (Just ( column.table, nextColumn )) -showColumns : Time.Posix -> TableId -> ShowColumns -> Erd -> ( Erd, Cmd msg ) +showColumns : Time.Posix -> TableId -> ShowColumns -> Erd -> ( Erd, Extra Msg ) showColumns now id kind erd = - ( mapColumnsForTableOrSelectedProps now + mapColumnsForTableOrSelectedPropsTE now id (\table columns -> erd.relations |> List.filter (Relation.linkedToTable id) |> (\tableRelations -> ShowColumns.filterBy kind tableRelations table columns) |> (\cols -> ShowColumns.sortBy kind cols) + |> (\cols -> ( cols, Extra.history ( SetColumns_ table.id columns, SetColumns_ table.id cols ) )) ) erd - , Cmd.none - ) -hideColumns : Time.Posix -> TableId -> HideColumns -> Erd -> ( Erd, Cmd Msg ) +hideColumns : Time.Posix -> TableId -> HideColumns -> Erd -> ( Erd, Extra Msg ) hideColumns now id kind erd = - ( mapColumnsForTableOrSelectedProps now + mapColumnsForTableOrSelectedPropsTE now id (\table columns -> erd.relations @@ -287,11 +329,33 @@ hideColumns now id kind erd = _ -> False ) + |> (\cols -> ( cols, Extra.history ( SetColumns_ table.id columns, SetColumns_ table.id cols ) )) ) ) erd - , Cmd.none - ) + + +sortColumns : Time.Posix -> TableId -> ColumnOrder -> Erd -> ( Erd, Extra Msg ) +sortColumns now id kind erd = + mapColumnsForTableOrSelectedPropsTE now + id + (\table columns -> + columns + |> ErdColumnProps.mapAll + (\path cols -> + cols + |> List.filterMap + (\col -> + table + |> ErdTable.getColumn (path |> Maybe.mapOrElse (ColumnPath.child col.name) (ColumnPath.fromString col.name)) + |> Maybe.map (\c -> ( c, col )) + ) + |> ColumnOrder.sortBy kind table erd.relations + |> List.map Tuple.second + ) + |> (\cols -> ( cols, Extra.history ( SetColumns_ table.id columns, SetColumns_ table.id cols ) )) + ) + erd toggleNestedColumn : Time.Posix -> TableId -> ColumnPath -> Bool -> Erd -> Erd @@ -322,71 +386,68 @@ toggleNestedColumn now id path open erd = erd -sortColumns : Time.Posix -> TableId -> ColumnOrder -> Erd -> ( Erd, Cmd Msg ) -sortColumns now id kind erd = - ( mapColumnsForTableOrSelectedProps now - id - (\table columns -> - columns - |> ErdColumnProps.mapAll - (\path cols -> - cols - |> List.filterMap - (\col -> - table - |> ErdTable.getColumn (path |> Maybe.mapOrElse (ColumnPath.child col.name) (ColumnPath.fromString col.name)) - |> Maybe.map (\c -> ( c, col )) - ) - |> ColumnOrder.sortBy kind table erd.relations - |> List.map Tuple.second - ) - ) - erd - , Cmd.none - ) - - -hoverColumn : ColumnRef -> Bool -> Erd -> List ErdTableLayout -> List ErdTableLayout -hoverColumn column enter erd tables = - let - highlightedColumns : Set ColumnId - highlightedColumns = - if enter then - erd.relationsByTable - |> Dict.getOrElse column.table [] - |> List.filter (ErdRelation.linkedTo column) - |> List.concatMap (\r -> [ ColumnId.fromRef r.src, ColumnId.fromRef r.ref ]) - |> Set.fromList - |> Set.insert (ColumnId.fromRef column) +hoverColumn : TableHover -> Bool -> Erd -> List ErdTableLayout -> List ErdTableLayout +hoverColumn ( table, columnM ) enter erd tables = + (columnM |> Maybe.map (ColumnRef table)) + |> Maybe.map + (\column -> + let + highlightedColumns : Set ColumnId + highlightedColumns = + if enter then + (erd.relationsByTable |> Dict.getOrElse column.table []) + |> List.filter (ErdRelation.linkedTo column) + |> List.concatMap (\r -> [ ColumnId.fromRef r.src, ColumnId.fromRef r.ref ]) + |> Set.fromList + |> Set.insert (ColumnId.fromRef column) - else - Set.empty - in - tables |> List.map (\t -> t |> mapColumns (ErdColumnProps.map (\p c -> c |> setHighlighted (highlightedColumns |> Set.member (ColumnId.from t { path = p }))))) + else + Set.empty + in + tables |> List.map (\t -> t |> mapColumns (ErdColumnProps.map (\p c -> c |> setHighlighted (highlightedColumns |> Set.member (ColumnId.from t { path = p }))))) + ) + |> Maybe.withDefault tables -performHideTable : Time.Posix -> TableId -> Erd -> Erd -performHideTable now table erd = - erd |> Erd.mapCurrentLayoutWithTime now (mapTables (List.removeBy .id table) >> mapTables updateRelatedTables) +performHideTable : Time.Posix -> TableId -> Erd -> ( Erd, Extra Msg ) +performHideTable now id erd = + (erd |> Erd.currentLayout |> .tables |> List.zipWithIndex |> List.find (\( t, _ ) -> t.id == id)) + |> Maybe.map + (\( table, index ) -> + ( erd |> Erd.mapCurrentLayoutWithTime now (mapTables (List.removeBy .id id) >> mapTables updateRelatedTables) + , Extra.history ( UnHideTable_ index table, HideTable id ) + ) + ) + |> Maybe.withDefault ( erd, Extra.none ) -performShowTable : Time.Posix -> ErdTable -> Maybe PositionHint -> Erd -> Erd +performShowTable : Time.Posix -> ErdTable -> Maybe PositionHint -> Erd -> ( Erd, List ( Msg, Msg ) ) performShowTable now table hint erd = erd - |> Erd.mapCurrentLayoutWithTime now - (mapTables + |> Erd.mapCurrentLayoutTWithTime now + (mapTablesT (\tables -> - -- initial position is computed in frontend/src/PagesComponents/Organization_/Project_/Updates.elm:502#computeInitialPosition when size is known - ErdTableLayout.init erd.settings - (tables |> List.map .id |> Set.fromList) - (erd.relationsByTable |> Dict.getOrElse table.id []) - erd.settings.collapseTableColumns - hint - table - :: tables + let + erdTable : ErdTableLayout + erdTable = + -- initial position is computed in frontend/src/PagesComponents/Organization_/Project_/Updates.elm:502#computeInitialPosition when size is known + ErdTableLayout.init erd.settings + (tables |> List.map .id |> Set.fromList) + (erd.relationsByTable |> Dict.getOrElse table.id []) + erd.settings.collapseTableColumns + hint + table + in + ( erdTable :: tables, [ ( HideTable table.id, UnHideTable_ 0 erdTable ) ] ) ) - >> mapTables updateRelatedTables + >> Tuple.mapFirst (mapTables updateRelatedTables) ) + |> Tuple.mapSecond (Maybe.withDefault []) + + +performReshowTable : Time.Posix -> Int -> ErdTableLayout -> Erd -> Erd +performReshowTable now index table erd = + erd |> Erd.mapCurrentLayoutWithTime now (mapTables (List.insertAt index table) >> mapTables updateRelatedTables) updateRelatedTables : List ErdTableLayout -> List ErdTableLayout @@ -395,19 +456,32 @@ updateRelatedTables tables = |> (\shownTables -> tables |> List.map (mapRelatedTables (Dict.map (\id -> setShown (shownTables |> Set.member id))))) -mapTablePropOrSelected : SchemaName -> TableId -> (ErdTableLayout -> ErdTableLayout) -> List ErdTableLayout -> ( List ErdTableLayout, Cmd Msg ) +mapTablePropOrSelected : SchemaName -> TableId -> (ErdTableLayout -> ErdTableLayout) -> List ErdTableLayout -> ( List ErdTableLayout, Extra Msg ) mapTablePropOrSelected defaultSchema id transform tableLayouts = - tableLayouts - |> List.findBy .id id + (tableLayouts |> List.findBy .id id) |> Maybe.map (\tableLayout -> if tableLayout.props.selected then - ( tableLayouts |> List.mapBy (.props >> .selected) True transform, Cmd.none ) + ( tableLayouts |> List.mapBy (.props >> .selected) True transform, Extra.none ) + + else + ( tableLayouts |> List.mapBy .id id transform, Extra.none ) + ) + |> Maybe.withDefault ( tableLayouts, "Table " ++ TableId.show defaultSchema id ++ " not found" |> Toasts.info |> Toast |> Extra.msg ) + + +mapTablePropOrSelectedTE : SchemaName -> Bool -> TableId -> (ErdTableLayout -> ( ErdTableLayout, Extra Msg )) -> List ErdTableLayout -> ( List ErdTableLayout, Extra Msg ) +mapTablePropOrSelectedTE defaultSchema extendToSelected id transform tableLayouts = + (tableLayouts |> List.findBy .id id) + |> Maybe.map + (\tableLayout -> + if tableLayout.props.selected && extendToSelected then + tableLayouts |> List.mapByTE (.props >> .selected) True transform else - ( tableLayouts |> List.mapBy .id id transform, Cmd.none ) + tableLayouts |> List.mapByTE .id id transform ) - |> Maybe.withDefault ( tableLayouts, "Table " ++ TableId.show defaultSchema id ++ " not found" |> Toasts.info |> Toast |> T.send ) + |> Maybe.withDefault ( tableLayouts, "Table " ++ TableId.show defaultSchema id ++ " not found" |> Toasts.info |> Toast |> Extra.msg ) mapColumnsForTableOrSelectedProps : Time.Posix -> TableId -> (ErdTable -> List ErdColumnProps -> List ErdColumnProps) -> Erd -> Erd @@ -433,3 +507,28 @@ mapColumnsForTableOrSelectedProps now id transform erd = ) ) ) + + +mapColumnsForTableOrSelectedPropsTE : Time.Posix -> TableId -> (ErdTable -> List ErdColumnProps -> ( List ErdColumnProps, Extra a )) -> Erd -> ( Erd, Extra a ) +mapColumnsForTableOrSelectedPropsTE now id transform erd = + let + selected : Bool + selected = + erd |> Erd.currentLayout |> .tables |> List.findBy .id id |> Maybe.mapOrElse (.props >> .selected) False + in + erd + |> Erd.mapCurrentLayoutTWithTime now + (mapTablesT + (List.mapTE + (\props -> + if props.id == id || (selected && props.props.selected) then + (erd.tables |> Dict.get props.id) + |> Maybe.map (\table -> props |> mapColumnsT (transform table >> Tuple.mapFirst (ErdColumnProps.filter (\p _ -> table |> ErdTable.getColumn p |> Maybe.isJust)))) + |> Maybe.withDefault ( props, Extra.none ) + + else + ( props, Extra.none ) + ) + ) + ) + |> Extra.defaultT diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/TableRow.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/TableRow.elm index d4f618793..1dbc23254 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/TableRow.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/TableRow.elm @@ -1,4 +1,4 @@ -module PagesComponents.Organization_.Project_.Updates.TableRow exposing (mapTableRowOrSelectedCmd, moveToTableRow, showTableRow) +module PagesComponents.Organization_.Project_.Updates.TableRow exposing (deleteTableRow, mapTableRowOrSelected, moveToTableRow, showTableRow, unDeleteTableRow) import Components.Organisms.TableRow as TableRow import DataSources.DbMiner.DbTypes exposing (RowQuery) @@ -16,29 +16,15 @@ import PagesComponents.Organization_.Project_.Models exposing (Model, Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout) import PagesComponents.Organization_.Project_.Models.PositionHint exposing (PositionHint) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports -import Services.Lenses exposing (mapCanvas, mapPosition, mapTableRows, mapTableRowsSeq) +import Services.Lenses exposing (mapCanvasT, mapPositionT, mapTableRows, mapTableRowsSeq, mapTableRowsT) import Set exposing (Set) import Time import Track -mapTableRowOrSelectedCmd : TableRow.Id -> TableRow.Msg -> (TableRow -> ( TableRow, Cmd msg )) -> List TableRow -> ( List TableRow, Cmd msg ) -mapTableRowOrSelectedCmd id msg f rows = - rows - |> List.findBy .id id - |> Maybe.map - (\r -> - if r.selected && TableRow.canBroadcast msg then - rows |> List.mapByCmd .selected True f - - else - rows |> List.mapByCmd .id id f - ) - |> Maybe.withDefault ( rows, Cmd.none ) - - -showTableRow : Time.Posix -> DbSourceInfo -> RowQuery -> Maybe TableRow.SuccessState -> Maybe PositionHint -> String -> Erd -> ( Erd, Cmd Msg ) +showTableRow : Time.Posix -> DbSourceInfo -> RowQuery -> Maybe TableRow.SuccessState -> Maybe PositionHint -> String -> Erd -> ( Erd, Extra Msg ) showTableRow now source query previous hint from erd = let hidden : Set ColumnName @@ -51,16 +37,38 @@ showTableRow now source query previous hint from erd = ( erd |> mapTableRowsSeq (\i -> i + 1) |> Erd.mapCurrentLayoutWithTime now (mapTableRows (List.prepend row)) - , Cmd.batch [ cmd, Ports.observeTableRowSize row.id, Track.tableRowShown source from erd.project ] + , Extra.newLL + [ cmd, Ports.observeTableRowSize row.id, Track.tableRowShown source from erd.project ] + (previous |> Maybe.mapOrElse (\_ -> [ ( DeleteTableRow row.id, UnDeleteTableRow_ 0 row ) ]) []) + -- don't add history if loading, add it when loaded (see frontend/src/Components/Organisms/TableRow.elm#update GotResult) ) -moveToTableRow : Time.Posix -> ErdProps -> TableRow -> Erd -> ( Erd, Cmd Msg ) +deleteTableRow : TableRow.Id -> ErdLayout -> ( ErdLayout, Extra Msg ) +deleteTableRow id layout = + layout + |> mapTableRowsT + (\rows -> + case rows |> List.zipWithIndex |> List.partition (\( r, _ ) -> r.id == id) of + ( ( deleted, index ) :: _, kept ) -> + ( kept |> List.map Tuple.first, Extra.history ( UnDeleteTableRow_ index deleted, DeleteTableRow deleted.id ) ) + + _ -> + ( rows, Extra.none ) + ) + + +unDeleteTableRow : Int -> TableRow -> ErdLayout -> ( ErdLayout, Extra Msg ) +unDeleteTableRow index tableRow layout = + layout |> mapTableRowsT (\rows -> ( rows |> List.insertAt index tableRow, Extra.new (Ports.observeTableRowSize tableRow.id) ( DeleteTableRow tableRow.id, UnDeleteTableRow_ index tableRow ) )) + + +moveToTableRow : Time.Posix -> ErdProps -> TableRow -> Erd -> ( Erd, Extra Msg ) moveToTableRow now viewport row erd = - ( erd |> Erd.mapCurrentLayoutWithTime now (mapCanvas (centerTableRow viewport row)), Cmd.none ) + erd |> Erd.mapCurrentLayoutTWithTime now (mapCanvasT (centerTableRow viewport row)) |> Extra.defaultT -centerTableRow : ErdProps -> TableRow -> CanvasProps -> CanvasProps +centerTableRow : ErdProps -> TableRow -> CanvasProps -> ( CanvasProps, Extra Msg ) centerTableRow viewport row canvas = let rowCenter : Position.Viewport @@ -71,4 +79,19 @@ centerTableRow viewport row canvas = delta = viewport |> Area.centerViewport |> Position.diffViewport rowCenter in - canvas |> mapPosition (Position.moveDiagram delta) + canvas |> mapPositionT (\pos -> pos |> Position.moveDiagram delta |> (\newPos -> ( newPos, Extra.history ( CanvasPosition pos, CanvasPosition newPos ) ))) + + +mapTableRowOrSelected : TableRow.Id -> TableRow.Msg -> (TableRow -> ( TableRow, Extra msg )) -> List TableRow -> ( List TableRow, Extra msg ) +mapTableRowOrSelected id msg f rows = + rows + |> List.findBy .id id + |> Maybe.map + (\r -> + if r.selected && TableRow.canBroadcast msg then + rows |> List.mapByT .selected True f |> Tuple.mapSecond Extra.concat + + else + rows |> List.mapByT .id id f |> Tuple.mapSecond Extra.concat + ) + |> Maybe.withDefault ( rows, Extra.none ) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Tags.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Tags.elm index 87563a057..6c636f452 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Tags.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Tags.elm @@ -5,7 +5,8 @@ import PagesComponents.Organization_.Project_.Models exposing (Msg(..)) import PagesComponents.Organization_.Project_.Models.Erd exposing (Erd) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) import PagesComponents.Organization_.Project_.Models.TagsMsg exposing (TagsMsg(..)) -import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyCmd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirty) import Services.Lenses exposing (mapEditTagsM, mapErdM, mapMetadata, setEditTags) import Track @@ -19,11 +20,11 @@ type alias Model x = } -handleTags : TagsMsg -> Model x -> ( Model x, Cmd Msg ) +handleTags : TagsMsg -> Model x -> ( Model x, Extra Msg ) handleTags msg model = case msg of TEdit content -> - ( model |> mapEditTagsM (\_ -> content), Cmd.none ) + ( model |> mapEditTagsM (\_ -> content), Extra.none ) TSave table column initialTags tags -> let @@ -41,4 +42,7 @@ handleTags msg model = else Track.tagsUpdated tags model.erd in - ( model |> setEditTags Nothing |> mapErdM (mapMetadata (Metadata.putTags table column tags)), cmd ) |> setDirtyCmd + ( model |> setEditTags Nothing |> mapErdM (mapMetadata (Metadata.putTags table column tags)) + , Extra.new cmd ( TagsMsg (TSave table column tags initialTags), TagsMsg msg ) + ) + |> setDirty diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm index 5abb1279e..0a4d758f4 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/Utils.elm @@ -1,26 +1,23 @@ -module PagesComponents.Organization_.Project_.Updates.Utils exposing (Model, setDirty, setDirtyCmd) +module PagesComponents.Organization_.Project_.Updates.Utils exposing (DirtyModel, setDirty, setDirtyM) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports -type alias Model x = - { x | conf : ErdConf, dirty : Bool } +type alias DirtyModel m = + { m | conf : ErdConf, dirty : Bool } -setDirty : Model x -> ( Model x, Cmd msg ) -setDirty model = +setDirty : ( DirtyModel m, Extra msg ) -> ( DirtyModel m, Extra msg ) +setDirty ( model, e ) = if model.dirty || not model.conf.save then - ( model, Cmd.none ) + ( model, e ) else - ( { model | dirty = True }, Ports.projectDirty True ) + ( { model | dirty = True }, e |> Extra.addCmd (Ports.projectDirty True) ) -setDirtyCmd : ( Model x, Cmd msg ) -> ( Model x, Cmd msg ) -setDirtyCmd ( model, cmd ) = - if model.dirty || not model.conf.save then - ( model, cmd ) - - else - ( { model | dirty = True }, Cmd.batch [ cmd, Ports.projectDirty True ] ) +setDirtyM : ( DirtyModel m, Maybe (Extra msg) ) -> ( DirtyModel m, Extra msg ) +setDirtyM ( model, extraM ) = + ( model, extraM |> Maybe.withDefault Extra.none ) |> setDirty diff --git a/frontend/src/PagesComponents/Organization_/Project_/Updates/VirtualRelation.elm b/frontend/src/PagesComponents/Organization_/Project_/Updates/VirtualRelation.elm index c2301227c..2cd017b38 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Updates/VirtualRelation.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Updates/VirtualRelation.elm @@ -1,11 +1,11 @@ module PagesComponents.Organization_.Project_.Updates.VirtualRelation exposing (Model, handleVirtualRelation) -import Libs.Task as T import Models.ErdProps exposing (ErdProps) import Models.Position as Position import Models.Project.ColumnRef exposing (ColumnRef) import PagesComponents.Organization_.Project_.Models exposing (Msg(..), VirtualRelation, VirtualRelationMsg(..)) import PagesComponents.Organization_.Project_.Models.Erd as Erd exposing (Erd) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.Lenses exposing (mapVirtualRelationM, setMouse, setVirtualRelation) @@ -17,28 +17,28 @@ type alias Model x = } -handleVirtualRelation : VirtualRelationMsg -> Model x -> ( Model x, Cmd Msg ) +handleVirtualRelation : VirtualRelationMsg -> Model x -> ( Model x, Extra Msg ) handleVirtualRelation msg model = case msg of VRCreate src -> - ( model |> setVirtualRelation (Just { src = src, mouse = src |> computeInitialPosition model |> Maybe.withDefault Position.zeroViewport }), Cmd.none ) + ( model |> setVirtualRelation (Just { src = src, mouse = src |> computeInitialPosition model |> Maybe.withDefault Position.zeroViewport }), Extra.none ) VRUpdate ref pos -> case model.virtualRelation |> Maybe.map .src of Nothing -> - ( model, Cmd.none ) + ( model, Extra.none ) Just Nothing -> - ( model |> setVirtualRelation (Just { src = Just ref, mouse = pos }), Cmd.none ) + ( model |> setVirtualRelation (Just { src = Just ref, mouse = pos }), Extra.none ) Just (Just src) -> - ( model |> setVirtualRelation Nothing, T.send (CreateRelations [ { src = src, ref = ref } ]) ) + ( model |> setVirtualRelation Nothing, CreateRelations [ { src = src, ref = ref } ] |> Extra.msg ) VRMove pos -> - ( model |> mapVirtualRelationM (setMouse pos), Cmd.none ) + ( model |> mapVirtualRelationM (setMouse pos), Extra.none ) VRCancel -> - ( model |> setVirtualRelation Nothing, Cmd.none ) + ( model |> setVirtualRelation Nothing, Extra.none ) computeInitialPosition : Model x -> Maybe ColumnRef -> Maybe Position.Viewport diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views.elm b/frontend/src/PagesComponents/Organization_/Project_/Views.elm index 489ee5875..7033e6311 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views.elm @@ -80,7 +80,7 @@ viewProject onDelete currentUrl urlInfos shared model = , Lazy.lazy viewContextMenu model.contextMenu , if model.saving then div [ class "absolute inset-0 flex z-max bg-white opacity-10 animate-pulse" ] - [ h1 [ class "m-auto select-none animate-text bg-gradient-to-r from-teal-500 via-purple-500 to-orange-500 bg-clip-text text-transparent text-5xl font-black" ] [ text "Saving" ] ] + [ h1 [ class "m-auto select-none animate-text bg-gradient-to-r from-teal-500 via-purple-500 to-orange-500 bg-clip-text text-transparent text-5xl leading-normal font-black" ] [ text "Saving" ] ] else Html.none @@ -108,9 +108,11 @@ viewApp currentUrl urlOrganization shared model htmlId erd = layout = erd |> Erd.currentLayout in - Lazy.lazy3 viewCommands + Lazy.lazy5 viewCommands model.conf layout.canvas.zoom + model.history + model.future (Commands.argsToString model.cursorMode (htmlId ++ "-commands") @@ -141,7 +143,7 @@ viewLeftSidebar model = let content : Maybe (Html Msg) content = - model.detailsSidebar |> Maybe.map2 (DetailsSidebar.view DetailsSidebarMsg (\id -> ShowTable id Nothing "details") ShowColumn 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/Commands.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Commands.elm index 262746551..eacec0a9f 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Commands.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Commands.elm @@ -6,7 +6,7 @@ import Components.Molecules.Dropdown as Dropdown import Components.Molecules.Tooltip as Tooltip import Components.Slices.DataExplorer as DataExplorer import Html exposing (Html, button, div, span, text) -import Html.Attributes exposing (class, id, type_) +import Html.Attributes exposing (class, disabled, id, type_) import Html.Events exposing (onClick) import Libs.Basics as Basics import Libs.Bool as B @@ -14,9 +14,9 @@ import Libs.Html as Html import Libs.Html.Attributes exposing (ariaExpanded, ariaHaspopup, css) import Libs.Models.HtmlId exposing (HtmlId) import Libs.Models.ZoomLevel exposing (ZoomLevel) -import Libs.Tailwind exposing (TwClass, batch, focus, hover) +import Libs.Tailwind as Tw exposing (TwClass, batch, focus, hover) import PagesComponents.Organization_.Project_.Components.DetailsSidebar as DetailsSidebar -import PagesComponents.Organization_.Project_.Models exposing (AmlSidebarMsg(..), Msg(..), confirm) +import PagesComponents.Organization_.Project_.Models exposing (AmlSidebarMsg(..), Msg(..)) import PagesComponents.Organization_.Project_.Models.CursorMode as CursorMode exposing (CursorMode) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) @@ -36,15 +36,15 @@ stringToArgs args = ( ( CursorMode.Select, "", "" ), True, ( True, True, True ) ) -viewCommands : ErdConf -> ZoomLevel -> String -> Html Msg -viewCommands conf canvasZoom args = +viewCommands : ErdConf -> ZoomLevel -> List ( Msg, Msg ) -> List ( Msg, Msg ) -> String -> Html Msg +viewCommands conf canvasZoom history future args = let ( ( cursorMode, htmlId, openedDropdown ), layoutNonEmpty, ( amlSidebar, detailsSidebar, dataExplorer ) ) = stringToArgs args buttonStyles : TwClass buttonStyles = - batch [ "relative inline-flex items-center p-2 border border-gray-300 text-sm font-medium", focus [ "z-10 outline-none ring-1 ring-primary-500 border-primary-500" ] ] + batch [ "relative inline-flex items-center p-2 border border-gray-300 text-sm font-medium", focus [ "z-10 outline-none ring-1 ring-primary-500 border-primary-500" ], Tw.disabled [ "cursor-not-allowed bg-gray-100 text-gray-400" ] ] classic : TwClass classic = @@ -56,10 +56,18 @@ viewCommands conf canvasZoom args = in div [ class "az-commands absolute bottom-0 right-0 m-3 print:hidden" ] [ if conf.move && layoutNonEmpty then + let + ( historyLen, futureLen ) = + ( List.length history, List.length future ) + in span [ class "relative z-0 inline-flex shadow-sm rounded-md" ] [ button [ type_ "button", onClick FitToScreen, css [ "rounded-l-md", buttonStyles, classic ] ] [ Icon.solid ArrowsExpand "" ] |> Tooltip.t "Fit diagram to screen" - , button [ type_ "button", onClick (ArrangeTables |> confirm "Arrange tables?" (text "Table disposition will be changed and undo feature is not implement yet...")), css [ "-ml-px rounded-r-md", buttonStyles, classic ] ] [ Icon.solid CubeTransparent "" ] + , button [ type_ "button", onClick Undo, disabled (historyLen == 0), css [ "-ml-px", buttonStyles, classic ] ] [ Icon.solid ArrowCircleLeft "" ] + |> Tooltip.t (B.cond (historyLen == 0) "Undo" ("Undo (" ++ String.fromInt historyLen ++ ")")) + , button [ type_ "button", onClick Redo, disabled (futureLen == 0), css [ "-ml-px", buttonStyles, classic ] ] [ Icon.solid ArrowCircleRight "" ] + |> Tooltip.t (B.cond (futureLen == 0) "Redo" ("Redo (" ++ String.fromInt futureLen ++ ")")) + , button [ type_ "button", onClick ArrangeTables, css [ "-ml-px rounded-r-md", buttonStyles, classic ] ] [ Icon.solid CubeTransparent "" ] |> Tooltip.t "Arrange tables" ] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd.elm index ddb613db5..1b636b2e0 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd.elm @@ -3,6 +3,7 @@ module PagesComponents.Organization_.Project_.Views.Erd exposing (ErdArgs, argsT import Components.Atoms.Badge as Badge import Components.Atoms.Icon as Icon exposing (Icon(..)) import Components.Molecules.Tooltip as Tooltip +import Components.Organisms.Table exposing (TableHover) import Components.Organisms.TableRow as TableRow exposing (TableRowHover, TableRowRelation, TableRowRelationColumn, TableRowSuccess) import Conf import Dict exposing (Dict) @@ -64,6 +65,7 @@ import PagesComponents.Organization_.Project_.Updates.Drag as Drag import PagesComponents.Organization_.Project_.Views.Erd.Memo as Memo import PagesComponents.Organization_.Project_.Views.Erd.Relation as Relation exposing (viewEmptyRelation, viewRelation, viewVirtualRelation) import PagesComponents.Organization_.Project_.Views.Erd.RelationRow exposing (viewRelationRow) +import PagesComponents.Organization_.Project_.Views.Erd.SelectionBox as SelectionBox import PagesComponents.Organization_.Project_.Views.Erd.Table as Table exposing (viewTable) import PagesComponents.Organization_.Project_.Views.Erd.TableRow as TableRow exposing (viewTableRow) import PagesComponents.Organization_.Project_.Views.Modals.ErdContextMenu as ErdContextMenu @@ -76,22 +78,22 @@ type alias ErdArgs = String -argsToString : Time.Posix -> Platform -> CursorMode -> String -> String -> DetailsSidebar.Selected -> Maybe TableId -> Maybe TableRowHover -> Maybe GroupEdit -> ErdArgs +argsToString : Time.Posix -> Platform -> CursorMode -> String -> String -> DetailsSidebar.Selected -> Maybe TableHover -> Maybe TableRowHover -> Maybe GroupEdit -> ErdArgs argsToString now platform cursorMode openedDropdown openedPopover selected hoverTable hoverRow editGroup = - [ Time.posixToMillis now |> String.fromInt, Platform.toString platform, CursorMode.toString cursorMode, openedDropdown, openedPopover, selected, hoverTable |> Maybe.mapOrElse TableId.toString "", hoverRowToString hoverRow, editGroup |> Maybe.mapOrElse (.index >> String.fromInt) "", editGroup |> Maybe.mapOrElse .content "" ] |> String.join "~" + [ Time.posixToMillis now |> String.fromInt, Platform.toString platform, CursorMode.toString cursorMode, openedDropdown, openedPopover, selected, hoverTableToString hoverTable, hoverRowToString hoverRow, editGroup |> Maybe.mapOrElse (.index >> String.fromInt) "", editGroup |> Maybe.mapOrElse .content "" ] |> String.join "~" -stringToArgs : ErdArgs -> ( ( Time.Posix, Platform, CursorMode ), ( String, String, DetailsSidebar.Selected ), ( Maybe TableId, Maybe TableRowHover, Maybe GroupEdit ) ) +stringToArgs : ErdArgs -> ( ( Time.Posix, Platform, CursorMode ), ( String, String, DetailsSidebar.Selected ), ( Maybe TableHover, Maybe TableRowHover, Maybe GroupEdit ) ) stringToArgs args = case args |> String.split "~" of [ now, platform, cursorMode, openedDropdown, openedPopover, selected, hoverTable, hoverTableRow, editGroupIndex, editGroupContent ] -> - ( ( now |> String.toInt |> Maybe.withDefault 0 |> Time.millisToPosix, Platform.fromString platform, CursorMode.fromString cursorMode ), ( openedDropdown, openedPopover, selected ), ( hoverTable |> TableId.fromString, hoverRowFromString hoverTableRow, editGroupIndex |> String.toInt |> Maybe.map (\index -> { index = index, content = editGroupContent }) ) ) + ( ( now |> String.toInt |> Maybe.withDefault 0 |> Time.millisToPosix, Platform.fromString platform, CursorMode.fromString cursorMode ), ( openedDropdown, openedPopover, selected ), ( hoverTableFromString hoverTable, hoverRowFromString hoverTableRow, editGroupIndex |> String.toInt |> Maybe.map (\index -> { index = index, content = editGroupContent }) ) ) _ -> ( ( Time.zero, Platform.PC, CursorMode.Select ), ( "", "", "" ), ( Nothing, Nothing, Nothing ) ) -viewErd : ErdConf -> ErdProps -> Erd -> Maybe Area.Canvas -> Maybe VirtualRelation -> Maybe MemoEdit -> ErdArgs -> Maybe DragState -> Html Msg +viewErd : ErdConf -> ErdProps -> Erd -> Maybe SelectionBox.Model -> Maybe VirtualRelation -> Maybe MemoEdit -> ErdArgs -> Maybe DragState -> Html Msg viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = let ( ( now, platform, cursorMode ), ( openedDropdown, openedPopover, selected ), ( hoverTable, hoverTableRow, editGroup ) ) = @@ -103,7 +105,7 @@ viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = canvas : CanvasProps canvas = - dragging |> Maybe.filter (\d -> d.id == Conf.ids.erd) |> Maybe.mapOrElse (\d -> layout.canvas |> Drag.moveCanvas d) layout.canvas + dragging |> Maybe.filter (\d -> d.id == Conf.ids.erd) |> Maybe.mapOrElse (\d -> layout.canvas |> Drag.moveCanvas d |> Tuple.first) layout.canvas -- TODO: use to render only visible tables => needs to handle size change to 0... --canvasViewport : Area.Canvas @@ -111,7 +113,7 @@ viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = -- canvas |> CanvasProps.viewport erdElem draggedLayout : ErdLayout draggedLayout = - dragging |> Maybe.mapOrElse (\d -> layout |> Drag.moveInLayout d canvas.zoom) layout + dragging |> Maybe.mapOrElse (\d -> layout |> Drag.moveInLayout d canvas.zoom |> Tuple.first) layout layoutTables : List ErdTableLayout layoutTables = @@ -166,7 +168,7 @@ viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = ] ++ B.cond (conf.move && ErdLayout.nonEmpty layout) [ onWheel OnWheel platform ] [] ++ B.cond ((conf.move || conf.select) && virtualRelation == Nothing && editMemo == Nothing) [ onPointerDown (handleErdPointerDown conf cursorMode) platform ] [] - ++ B.cond (conf.layout && virtualRelation == Nothing && editMemo == Nothing && ErdLayout.nonEmpty layout) [ onDblClick (CanvasProps.eventCanvas erdElem canvas >> MCreate >> MemoMsg) platform, onContextMenu (\e -> ContextMenuCreate (ErdContextMenu.view platform erdElem canvas layout e) e) platform ] [] + ++ B.cond (conf.layout && virtualRelation == Nothing && editMemo == Nothing && ErdLayout.nonEmpty layout) [ onDblClick (CanvasProps.eventCanvas erdElem canvas >> Position.onGrid >> MCreate >> MemoMsg) platform, onContextMenu (\e -> ContextMenuCreate (ErdContextMenu.view platform erdElem canvas layout e) e) platform ] [] ) [ div [ class "az-canvas origin-top-left", Position.styleTransformDiagram canvas.position canvas.zoom ] -- use HTML order instead of z-index, must be careful with it, this allows to have tooltips & popovers always on top @@ -179,7 +181,7 @@ viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = , erd.relations |> Lazy.lazy5 viewRelations conf erd.settings.defaultSchema erd.settings.relationStyle displayedTables , layoutTables |> viewTables platform conf cursorMode virtualRelation openedDropdown openedPopover hoverTable dragging canvas.zoom erd.settings.defaultSchema selected erd.settings.columnBasicTypes erd.tables erd.metadata layout , memos |> viewMemos platform conf cursorMode editMemo - , div [ class "az-selection-box pointer-events-none" ] (selectionBox |> Maybe.filter (\_ -> layout |> ErdLayout.nonEmpty) |> Maybe.mapOrElse viewSelectionBox []) + , div [ class "az-selection-box pointer-events-none" ] (selectionBox |> Maybe.filter (\_ -> layout |> ErdLayout.nonEmpty) |> Maybe.mapOrElse SelectionBox.view []) , div [ class "az-virtual-relation pointer-events-none" ] [ virtualRelationInfo |> Maybe.mapOrElse (\i -> viewVirtualRelation erd.settings.relationStyle i) viewEmptyRelation ] ] , if layout |> ErdLayout.isEmpty then @@ -190,7 +192,7 @@ viewErd conf erdElem erd selectionBox virtualRelation editMemo args dragging = ] -viewTables : Platform -> ErdConf -> CursorMode -> Maybe VirtualRelation -> HtmlId -> HtmlId -> Maybe TableId -> Maybe DragState -> ZoomLevel -> SchemaName -> DetailsSidebar.Selected -> Bool -> Dict TableId ErdTable -> Metadata -> ErdLayout -> List ErdTableLayout -> Html Msg +viewTables : Platform -> ErdConf -> CursorMode -> Maybe VirtualRelation -> HtmlId -> HtmlId -> Maybe TableHover -> Maybe DragState -> ZoomLevel -> SchemaName -> DetailsSidebar.Selected -> Bool -> Dict TableId ErdTable -> Metadata -> ErdLayout -> List ErdTableLayout -> Html Msg viewTables platform conf cursorMode virtualRelation openedDropdown openedPopover hoverTable dragging zoom defaultSchema selected useBasicTypes tables metadata layout tableLayouts = Keyed.node "div" [ class "az-tables" ] @@ -212,7 +214,7 @@ viewTables platform conf cursorMode virtualRelation openedDropdown openedPopover (B.cond (openedPopover |> String.startsWith table.htmlId) openedPopover "") index selected - (hoverTable == Just table.id) + (hoverTable |> Maybe.any (\( t, _ ) -> t == table.id)) (dragging |> Maybe.any (\d -> d.id == table.htmlId && d.init /= d.last)) (virtualRelation /= Nothing) useBasicTypes @@ -308,7 +310,7 @@ viewMemos platform conf cursorMode editMemo memos = |> List.map (\memo -> ( MemoId.toHtmlId memo.id - , Lazy.lazy5 Memo.viewMemo platform conf cursorMode (editMemo |> Maybe.filterBy .id memo.id |> Maybe.map .content) memo + , Lazy.lazy5 Memo.viewMemo platform conf cursorMode (editMemo |> Maybe.filterBy .id memo.id) memo ) ) ) @@ -343,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 ] ] ] @@ -381,11 +383,6 @@ viewHiddenTables defaultSchema tables = ) -viewSelectionBox : Area.Canvas -> List (Html Msg) -viewSelectionBox area = - [ div ([ css [ "absolute border-2 bg-opacity-25 z-max border-teal-400 bg-teal-400" ] ] ++ Area.styleTransformCanvas area) [] ] - - viewEmptyState : SchemaName -> Dict TableId ErdTable -> Html Msg viewEmptyState defaultSchema tables = let @@ -478,6 +475,21 @@ handleErdPointerDown conf cursorMode e = Noop "No match on erd pointer down" +hoverTableToString : Maybe TableHover -> String +hoverTableToString hover = + hover |> Maybe.mapOrElse (\( id, col ) -> TableId.toHtmlId id ++ "/" ++ (col |> Maybe.mapOrElse ColumnPath.toString "")) "" + + +hoverTableFromString : String -> Maybe TableHover +hoverTableFromString str = + case str |> String.split "/" of + idStr :: col -> + idStr |> TableId.fromHtmlId |> Maybe.map (\id -> ( id, col |> List.head |> Maybe.map ColumnPath.fromString )) + + _ -> + Nothing + + hoverRowToString : Maybe TableRowHover -> String hoverRowToString hover = hover |> Maybe.mapOrElse (\( id, col ) -> String.fromInt id ++ "/" ++ (col |> Maybe.mapOrElse ColumnPath.toString "")) "" diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Memo.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Memo.elm index 8d8299b63..3d199e528 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Memo.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Memo.elm @@ -15,7 +15,7 @@ import Libs.Tailwind as Tw import Models.Area as Area import Models.Position as Position import Models.Size as Size -import PagesComponents.Organization_.Project_.Models exposing (MemoMsg(..), Msg(..)) +import PagesComponents.Organization_.Project_.Models exposing (MemoEdit, MemoMsg(..), Msg(..)) import PagesComponents.Organization_.Project_.Models.CursorMode as CursorMode exposing (CursorMode) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo) @@ -23,8 +23,8 @@ import PagesComponents.Organization_.Project_.Models.MemoId as MemoId import PagesComponents.Organization_.Project_.Views.Modals.MemoContextMenu as MemoContextMenu -viewMemo : Platform -> ErdConf -> CursorMode -> Maybe String -> Memo -> Html Msg -viewMemo platform conf cursorMode edit memo = +viewMemo : Platform -> ErdConf -> CursorMode -> Maybe MemoEdit -> Memo -> Html Msg +viewMemo platform conf cursorMode editM memo = let htmlId : HtmlId htmlId = @@ -38,16 +38,16 @@ viewMemo platform conf cursorMode edit memo = resizeMemo = Bool.cond (cursorMode == CursorMode.Drag || not conf.move) [] [ onPointerDown (\_ -> Noop "no drag on memo resize") platform ] in - edit + editM |> Maybe.map - (\v -> + (\edit -> div ([ id htmlId, class "absolute" ] ++ Position.stylesGrid memo.position) [ textarea ([ id (MemoId.toInputId memo.id) , name (MemoId.toInputId memo.id) - , value v + , value edit.content , onInput (MEditUpdate >> MemoMsg) - , onBlur (MemoMsg MEditSave) + , onBlur (MEditSave edit |> MemoMsg) , autofocus True , placeholder "Write any useful memo here!" , class "resize block rounded-md border-gray-300 shadow-sm focus:border-indigo-500 focus:ring-indigo-500" diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Relation.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Relation.elm index 470a1da23..e9a81196e 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Relation.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Relation.elm @@ -63,7 +63,7 @@ viewRelation defaultSchema style conf srcTable refTable relation = onHover : Bool -> Msg onHover = - ToggleHoverColumn { table = relation.src.table, column = relation.src.column } + HoverTable ( relation.src.table, Just relation.src.column ) in case ( src, ref ) of ( Nothing, Nothing ) -> diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/SelectionBox.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/SelectionBox.elm new file mode 100644 index 000000000..74774844a --- /dev/null +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/SelectionBox.elm @@ -0,0 +1,17 @@ +module PagesComponents.Organization_.Project_.Views.Erd.SelectionBox exposing (Model, view) + +import Html exposing (Html, div) +import Libs.Html.Attributes exposing (css) +import Libs.Models.HtmlId exposing (HtmlId) +import Models.Area as Area + + +type alias Model = + { area : Area.Canvas + , previouslySelected : List HtmlId + } + + +view : Model -> List (Html msg) +view model = + [ div ([ css [ "absolute border-2 bg-opacity-25 z-max border-teal-400 bg-teal-400" ] ] ++ Area.styleTransformCanvas model.area) [] ] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Table.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Table.elm index 8f1811ac3..5a9e66a89 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Table.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Erd/Table.elm @@ -116,12 +116,12 @@ viewTable conf zoom args layout meta tableLayout table = , showHiddenColumns = tableLayout.props.showHiddenColumns } , actions = - { hover = ToggleHoverTable table.id + { hover = HoverTable ( table.id, Nothing ) , headerClick = \e -> B.cond (e.button == MainButton) (SelectItem (TableId.toHtmlId table.id) (e.ctrl || e.shift)) (Noop "non-main-button-table-header-click") , headerDblClick = DetailsSidebarMsg (DetailsSidebar.ShowTable table.id) , headerRightClick = ContextMenuCreate dropdown , headerDropdownClick = DropdownToggle - , columnHover = \col on -> ToggleHoverColumn { table = table.id, column = col } on + , columnHover = \col -> HoverTable ( table.id, Just col ) , columnClick = B.maybe virtualRelation (\col e -> VirtualRelationMsg (VRUpdate { table = table.id, column = col } e.clientPos)) , columnDblClick = \col -> { table = table.id, column = col } |> DetailsSidebar.ShowColumn |> DetailsSidebarMsg , columnRightClick = \i col -> ContextMenuCreate (B.cond (tableLayout.columns |> ErdColumnProps.member col) ColumnContextMenu.view ColumnContextMenu.viewHidden platform i { table = table.id, column = col } (table |> ErdTable.getColumn col) (meta.columns |> ColumnPath.get col |> Maybe.andThen .notes)) @@ -184,14 +184,20 @@ buildColumn useBasicTypes tableMeta layout column = column.kindLabel , kindDetails = column.customType - |> Maybe.map + |> Maybe.andThen (\t -> case t.value of + CustomTypeValue.Enum [] -> + Nothing + CustomTypeValue.Enum values -> - "Enum: " ++ String.join ", " values + "Enum: " ++ String.join ", " values |> Just + + CustomTypeValue.Definition "" -> + Nothing CustomTypeValue.Definition definition -> - "Type: " ++ definition + "Type: " ++ definition |> Just ) , nullable = column.nullable , default = column.defaultLabel diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ColumnContextMenu.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ColumnContextMenu.elm index ad64e3b80..a545f28a1 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ColumnContextMenu.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ColumnContextMenu.elm @@ -42,7 +42,7 @@ view platform index ref column notes = viewHidden : Platform -> Int -> ColumnRef -> Maybe ErdColumn -> Maybe Notes -> Html Msg viewHidden platform _ column erdColumn notes = div [] - [ ContextMenu.btnHotkey "" (ShowColumn column) [] [ text "Show column" ] platform (Conf.hotkeys |> Dict.getOrElse "show" []) + [ ContextMenu.btnHotkey "" (ShowColumn 1000 column) [] [ text "Show column" ] platform (Conf.hotkeys |> Dict.getOrElse "show" []) , ContextMenu.btn "" (DetailsSidebarMsg (DetailsSidebar.ShowColumn column)) [] [ text "Show details" ] , erdColumn |> Maybe.andThen (\c -> c.origins |> List.findMap (\o -> o.db |> Maybe.map (\url -> ( o.id, url )))) diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ErdContextMenu.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ErdContextMenu.elm index ded5b0b42..1badcd1b2 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ErdContextMenu.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ErdContextMenu.elm @@ -11,6 +11,7 @@ import Libs.Html.Events exposing (PointerEvent) import Libs.Maybe as Maybe import Libs.Models.Platform exposing (Platform) import Models.ErdProps exposing (ErdProps) +import Models.Position as Position import Models.Project.CanvasProps as CanvasProps exposing (CanvasProps) import Models.Project.TableId exposing (TableId) import PagesComponents.Organization_.Project_.Models exposing (AmlSidebarMsg(..), FindPathMsg(..), GroupMsg(..), MemoMsg(..), Msg(..), SchemaAnalysisMsg(..)) @@ -30,7 +31,7 @@ view platform erdElem canvasProps layout event = , ContextMenu.btn "" (AmlSidebarMsg AToggle) [] [ text "Update your schema" ] , ContextMenu.btnHotkey "" (DataExplorerMsg (DataExplorer.Open Nothing Nothing)) [] [ text "Explore your database content" ] platform [] , ContextMenu.btnHotkey "" (NewLayoutMsg (NewLayout.Open NewLayoutBody.Create)) [] [ text "New layout" ] platform (Conf.hotkeys |> Dict.getOrElse "create-layout" []) - , ContextMenu.btnHotkey "" (event |> CanvasProps.eventCanvas erdElem canvasProps |> MCreate |> MemoMsg) [] [ text "New memo" ] platform (Conf.hotkeys |> Dict.getOrElse "new-memo" []) + , ContextMenu.btnHotkey "" (event |> CanvasProps.eventCanvas erdElem canvasProps |> Position.onGrid |> MCreate |> MemoMsg) [] [ text "New memo" ] platform (Conf.hotkeys |> Dict.getOrElse "new-memo" []) , selectedTables |> List.head |> Maybe.mapOrElse (\_ -> ContextMenu.btnHotkey "" (GCreate selectedTables |> GroupMsg) [] [ text "New group" ] platform (Conf.hotkeys |> Dict.getOrElse "create-group" [])) (div [] []) , ContextMenu.btnHotkey "" SelectAll [] [ text "Select all" ] platform (Conf.hotkeys |> Dict.getOrElse "select-all" []) , ContextMenu.btn "" FitToScreen [] [ text "Fit diagram to screen" ] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm index 923628642..470026d8a 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/NewLayout.elm @@ -15,8 +15,9 @@ 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 (mapErdMCmd, mapLayouts, mapNewLayoutMCmd, setCurrentLayout, setNewLayout) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) +import PagesComponents.Organization_.Project_.Updates.Utils exposing (setDirtyM) +import Services.Lenses exposing (mapErdMT, mapLayouts, mapNewLayoutMT, setCurrentLayout, setNewLayout) import Services.Toasts as Toasts import Time import Track @@ -47,59 +48,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, Extra 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)), modalOpen dialogId |> T.sendAfter 1 |> Extra.cmd ) else - ( model - , Cmd.batch - [ model.erd |> Erd.getProjectRefM urlInfos |> ProPlan.layoutsModalBody |> customModalOpen |> T.send - , Track.planLimit .layouts model.erd - ] - ) + ( model, Extra.cmdL [ model.erd |> Erd.getProjectRefM urlInfos |> ProPlan.layoutsModalBody |> customModalOpen |> T.send, Track.planLimit .layouts model.erd ] ) BodyMsg m -> - model |> mapNewLayoutMCmd (NewLayoutBody.update m) + model |> mapNewLayoutMT (NewLayoutBody.update m) |> Extra.defaultT Submit mode name -> - model |> setNewLayout Nothing |> mapErdMCmd (updateLayouts toast mode name now) |> setDirtyCmd + model |> setNewLayout Nothing |> mapErdMT (updateLayouts wrap batch toast loadLayout deleteLayout mode name now) |> setDirtyM Cancel -> - ( model |> setNewLayout Nothing, Cmd.none ) + ( model |> setNewLayout Nothing, Extra.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, Extra 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, Extra 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 |> Extra.msg )) + |> 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 + , Extra.new + (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, Extra 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 + , Extra.new (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 |> Extra.msg ) view : (Msg -> msg) -> (msg -> msg) -> ProjectRef -> List LayoutName -> Bool -> Model -> Html msg diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ProjectSettings.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ProjectSettings.elm index bb7a19748..3f1f8e231 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ProjectSettings.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/ProjectSettings.elm @@ -56,18 +56,18 @@ viewSourcesSection htmlId zone erd model = [ legend [ class "font-medium text-gray-900" ] [ text "Project sources" ] , p [ class "text-sm text-gray-500" ] [ text "Active sources are merged to create your current schema." ] , div [ class "mt-1 border border-gray-300 rounded-md shadow-sm divide-y divide-gray-300" ] - ((erd.sources |> List.map (\s -> viewSource htmlId erd.project.id zone (model.sourceNameEdit |> Maybe.has s.id) s)) ++ [ viewAddSource (htmlId ++ "-new") erd.project.id ]) + ((erd.sources |> List.map (\s -> viewSource htmlId erd.project.id zone (model.sourceNameEdit |> Maybe.filter (\( id, _ ) -> id == s.id) |> Maybe.map Tuple.second) s)) ++ [ viewAddSource (htmlId ++ "-new") erd.project.id ]) ] -viewSource : HtmlId -> ProjectId -> Time.Zone -> Bool -> Source -> Html Msg +viewSource : HtmlId -> ProjectId -> Time.Zone -> Maybe String -> Source -> Html Msg viewSource htmlId _ zone updating source = let ( views, tables ) = source.tables |> Dict.values |> List.partition .view - nameInput : HtmlId - nameInput = + inputName : HtmlId + inputName = htmlId ++ "-name-input" view : Icon -> String -> Time.Posix -> String -> Html Msg @@ -77,11 +77,9 @@ viewSource htmlId _ zone updating source = [ div [ class "flex justify-between" ] [ viewCheckbox "mt-3" (htmlId ++ "-" ++ SourceId.toString source.id) - (if updating then - [ input [ type_ "text", name nameInput, id nameInput, value source.name, onInput (PSSourceNameUpdate source.id >> ProjectSettingsMsg), onBlur (PSSourceNameUpdateDone |> ProjectSettingsMsg), class "block w-full rounded-md border-0 py-0 text-gray-900 shadow-sm ring-1 ring-inset ring-gray-300 placeholder:text-gray-400 focus:ring-2 focus:ring-inset focus:ring-indigo-600 sm:text-sm sm:leading-6" ] [] ] - - else - [ span [ class "truncate max-w-xs" ] [ Icon.solid icon "inline", text source.name ] |> Tooltip.b labelTitle ] + (updating + |> Maybe.map (\inputValue -> [ input [ type_ "text", name inputName, id inputName, value inputValue, onInput (PSSourceNameUpdate source.id >> ProjectSettingsMsg), onBlur (PSSourceNameUpdateDone source.id inputValue |> ProjectSettingsMsg), class "block w-full rounded-md border-0 py-0 text-gray-900 shadow-sm ring-1 ring-inset ring-gray-300 placeholder:text-gray-400 focus:ring-2 focus:ring-inset focus:ring-indigo-600 sm:text-sm sm:leading-6" ] [] ]) + |> Maybe.withDefault [ span [ class "truncate max-w-xs" ] [ Icon.solid icon "inline", text source.name ] |> Tooltip.b labelTitle ] ) source.enabled (source |> PSSourceToggle |> ProjectSettingsMsg) @@ -92,10 +90,10 @@ viewSource htmlId _ zone updating source = , button [ type_ "button", onClick (Batch [ ModalClose (ProjectSettingsMsg PSClose), AmlSidebarMsg (AOpen (Just source.id)) ]), css [ focus [ "outline-none" ], B.cond (source.kind == AmlEditor) "" "hidden" ] ] [ Icon.solid Icon.Terminal "inline" ] |> Tooltip.bl "Update this source" - , button [ type_ "button", onClick (Batch [ source.name |> PSSourceNameUpdate source.id |> ProjectSettingsMsg, Ports.focus nameInput |> Send ]), css [ focus [ "outline-none" ] ] ] + , button [ type_ "button", onClick (Batch [ source.name |> PSSourceNameUpdate source.id |> ProjectSettingsMsg, Ports.focus inputName |> Send ]), css [ focus [ "outline-none" ] ] ] [ Icon.solid Icon.Pencil "inline" ] |> Tooltip.bl "Update source name" - , button [ type_ "button", onClick (source |> PSSourceDelete |> ProjectSettingsMsg |> confirm ("Delete " ++ source.name ++ " source?") (text "Are you really sure?")), css [ focus [ "outline-none" ] ] ] + , button [ type_ "button", onClick (source.id |> PSSourceDelete |> ProjectSettingsMsg |> confirm ("Delete " ++ source.name ++ " source?") (text "Are you really sure?")), css [ focus [ "outline-none" ] ] ] [ Icon.solid Icon.Trash "inline" ] |> Tooltip.bl "Delete this source" ] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableContextMenu.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableContextMenu.elm index 11b54f5de..5fbb658e8 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableContextMenu.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableContextMenu.elm @@ -38,7 +38,7 @@ view platform conf defaultSchema layout index table props notes = |> List.findMap (\o -> o.db |> Maybe.map (\url -> ( o.id, url ))) |> Maybe.map (\( id, url ) -> { label = "Explore table data", content = ContextMenu.Simple { action = DataExplorerMsg (DataExplorer.Open (Just id) (Just (DbQuery.exploreTable (DatabaseKind.fromUrl url) table.id))) } }) , Maybe.when conf.layout { label = notes |> Maybe.mapOrElse (\_ -> "Update notes") "Add notes", content = ContextMenu.SimpleHotkey { action = NotesMsg (NOpen table.id Nothing), platform = platform, hotkeys = Conf.hotkeys |> Dict.getOrElse "notes" [] } } - , Maybe.when conf.layout { label = B.cond props.selected "Set color of selected tables" "Set color", content = ContextMenu.Custom (ColorPicker.view (TableColor table.id)) ContextMenu.BottomRight } + , Maybe.when conf.layout { label = B.cond props.selected "Set color of selected tables" "Set color", content = ContextMenu.Custom (ColorPicker.view (\c -> TableColor table.id c True)) ContextMenu.BottomRight } , Maybe.when conf.layout { label = B.cond props.selected "Sort columns of selected tables" "Sort columns", content = ContextMenu.SubMenu (ColumnOrder.all |> List.map (\o -> { label = ColumnOrder.show o, action = SortColumns table.id o })) ContextMenu.BottomRight } , Maybe.when conf.layout { label = B.cond props.selected "Hide columns of selected tables" "Hide columns" diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableRowContextMenu.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableRowContextMenu.elm index f51277114..9f7891162 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableRowContextMenu.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Modals/TableRowContextMenu.elm @@ -16,15 +16,15 @@ import Models.Project.TableRow exposing (TableRow) import PagesComponents.Organization_.Project_.Models.ErdConf exposing (ErdConf) -view : msg -> (TableId -> Maybe ColumnPath -> msg) -> msg -> msg -> msg -> Platform -> ErdConf -> SchemaName -> TableRow -> Maybe Notes -> Html msg -view refresh openNotes collapse expand delete platform conf defaultSchema row notes = +view : msg -> (TableId -> Maybe ColumnPath -> msg) -> (Bool -> msg) -> msg -> Platform -> ErdConf -> SchemaName -> TableRow -> Maybe Notes -> Html msg +view refresh openNotes setCollapse delete platform conf defaultSchema row notes = div [ class "z-max" ] ([ div [ class "px-4 py-1 text-sm font-medium leading-6 text-gray-500" ] [ text (TableId.show defaultSchema row.table ++ " row") ] ] ++ ([ Maybe.when conf.layout { label = B.cond row.selected "Refresh selected rows" "Refresh data", content = ContextMenu.Simple { action = refresh } } , Maybe.when conf.layout { label = notes |> Maybe.mapOrElse (\_ -> "Update notes") "Add notes", content = ContextMenu.SimpleHotkey { action = openNotes row.table Nothing, platform = platform, hotkeys = Conf.hotkeys |> Dict.getOrElse "notes" [] } } , Maybe.when conf.layout { label = B.cond row.collapsed (B.cond row.selected "Expand selected tables" "Expand table") (B.cond row.selected "Collapse selected tables" "Collapse table") - , content = ContextMenu.SimpleHotkey { action = B.cond row.collapsed expand collapse, platform = platform, hotkeys = Conf.hotkeys |> Dict.getOrElse "collapse" [] } + , content = ContextMenu.SimpleHotkey { action = setCollapse (not row.collapsed), platform = platform, hotkeys = Conf.hotkeys |> Dict.getOrElse "collapse" [] } } , Maybe.when conf.layout { label = B.cond row.selected "Delete selected rows" "Delete row", content = ContextMenu.SimpleHotkey { action = delete, platform = platform, hotkeys = Conf.hotkeys |> Dict.getOrElse "hide" [] } } ] diff --git a/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm b/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm index 3372928e8..0e1e203bd 100644 --- a/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm +++ b/frontend/src/PagesComponents/Organization_/Project_/Views/Navbar/Title.elm @@ -24,6 +24,7 @@ import Libs.Models.Platform exposing (Platform) import Libs.String as String import Libs.Tailwind as Tw exposing (focus, focus_ring_offset_600) import Libs.Task as T +import Libs.Tuple3 as Tuple3 import Models.Organization as Organization exposing (Organization) import Models.OrganizationId as OrganizationId exposing (OrganizationId) import Models.Project.LayoutName exposing (LayoutName) @@ -204,20 +205,34 @@ buildFolders layouts = buildFoldersNested : List ( List String, LayoutName, ErdLayout ) -> List LayoutFolder buildFoldersNested layouts = layouts - |> List.groupBy (\( parts, _, _ ) -> parts |> List.head |> Maybe.withDefault "") + |> List.groupBy (\( parts, _, _ ) -> parts |> List.headOr "") |> Dict.toList |> List.sortBy (\( folder, _ ) -> folder |> String.toLower) |> List.concatMap (\( folder, items ) -> case items of ( parts, name, layout ) :: [] -> - [ LayoutItem (parts |> String.join "/") ( name, layout ) ] + [ LayoutItem (parts |> String.join " / ") ( name, layout ) ] _ -> - [ LayoutFolder folder (items |> List.filterMap (\( parts, name, layout ) -> parts |> List.tail |> Maybe.map (\p -> ( p, name, layout ))) |> buildFoldersNested) ] + let + ( folderName, folderItems ) = + buildFoldersNestedFlat folder (items |> List.map (Tuple3.mapFirst (List.drop 1))) + in + [ LayoutFolder folderName (folderItems |> buildFoldersNested) ] ) +buildFoldersNestedFlat : String -> List ( List String, LayoutName, ErdLayout ) -> ( String, List ( List String, LayoutName, ErdLayout ) ) +buildFoldersNestedFlat folder layouts = + case layouts |> List.groupBy (\( parts, _, _ ) -> parts |> List.headOr "") |> Dict.keys of + sub :: [] -> + buildFoldersNestedFlat (folder ++ " / " ++ sub) (layouts |> List.map (Tuple3.mapFirst (List.drop 1))) + + _ -> + ( folder, layouts ) + + countLayouts : List LayoutFolder -> Int countLayouts folders = folders @@ -254,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") ++ ")") ] ] @@ -273,5 +288,5 @@ confirmDeleteLayout name = , message = span [] [ text "Are you sure you want to delete ", bText name, text " layout?" ] , confirm = "Delete " ++ name ++ " layout" , cancel = "Cancel" - , onConfirm = T.send (name |> LDelete |> LayoutMsg) + , onConfirm = name |> LDelete |> LayoutMsg |> T.send } diff --git a/frontend/src/Services/AmlSource.elm b/frontend/src/Services/AmlSource.elm index f304db774..8a6eaae23 100644 --- a/frontend/src/Services/AmlSource.elm +++ b/frontend/src/Services/AmlSource.elm @@ -8,6 +8,7 @@ import Libs.Models.HtmlId exposing (HtmlId) import Models.Project.Source as Source exposing (Source) import Models.Project.SourceId as SourceId exposing (SourceId) import Models.ProjectInfo exposing (ProjectInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Random import Time import Track @@ -39,25 +40,25 @@ init = -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model -> ( Model, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model -> ( Model, Extra msg ) update wrap now project msg model = case msg of UpdateName name -> if name == "" then - ( { model | name = name, parsedSource = Nothing }, Cmd.none ) + ( { model | name = name, parsedSource = Nothing }, Extra.none ) else if model.parsedSource == Nothing then - ( { model | name = name }, SourceId.generator |> Random.generate (BuildSource >> wrap) ) + ( { model | name = name }, SourceId.generator |> Random.generate (BuildSource >> wrap) |> Extra.cmd ) else - ( { model | name = name, parsedSource = model.parsedSource |> Maybe.map (Result.map (\s -> { s | name = name })) }, Cmd.none ) + ( { model | name = name, parsedSource = model.parsedSource |> Maybe.map (Result.map (\s -> { s | name = name })) }, Extra.none ) BuildSource id -> if model.name == "" then - ( model, Cmd.none ) + ( model, Extra.none ) else - Source.aml model.name now id |> (\source -> ( { model | parsedSource = source |> Ok |> Just }, Track.amlSourceCreated project source )) + Source.aml model.name now id |> (\source -> ( { model | parsedSource = source |> Ok |> Just }, Track.amlSourceCreated project source |> Extra.cmd )) diff --git a/frontend/src/Services/DatabaseSource.elm b/frontend/src/Services/DatabaseSource.elm index 9557fbe93..501cda375 100644 --- a/frontend/src/Services/DatabaseSource.elm +++ b/frontend/src/Services/DatabaseSource.elm @@ -24,6 +24,7 @@ import Models.Project.Source exposing (Source) import Models.Project.SourceId as SourceId exposing (SourceId) import Models.ProjectInfo exposing (ProjectInfo) import Models.SourceInfo as SourceInfo +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Random import Services.Backend as Backend @@ -101,26 +102,26 @@ init src callback = -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Extra msg ) update wrap now project msg model = case msg of UpdateSelectedDb key -> - ( { model | selectedDb = key }, Cmd.none ) + ( { model | selectedDb = key }, Extra.none ) UpdateUrl url -> - ( { model | url = url, selectedUrl = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Cmd.none ) + ( { model | url = url, selectedUrl = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Extra.none ) GetSchema schemaUrl -> if schemaUrl == "" then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Extra.none ) else ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedUrl = Just (Ok schemaUrl) }) - , Ports.getDatabaseSchema schemaUrl + , Ports.getDatabaseSchema schemaUrl |> Extra.cmd ) GotSchema result -> - ( { model | parsedSchema = Just result }, SourceId.generator |> Random.generate (BuildSource >> wrap) ) + ( { model | parsedSchema = Just result }, SourceId.generator |> Random.generate (BuildSource >> wrap) |> Extra.cmd ) BuildSource sourceId -> Maybe.map2 @@ -132,11 +133,12 @@ update wrap now project msg model = , source |> Maybe.map (\s -> Cmd.batch [ s |> model.callback |> T.send, s |> Track.sourceCreated project "database" ]) |> Maybe.withDefault (Err "Can't build source" |> Track.sourceCreated project "database") + |> Extra.cmd ) ) UiToggle htmlId -> - ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Cmd.none ) + ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Extra.none ) diff --git a/frontend/src/Services/JsonSource.elm b/frontend/src/Services/JsonSource.elm index 63f7d1711..7116d0542 100644 --- a/frontend/src/Services/JsonSource.elm +++ b/frontend/src/Services/JsonSource.elm @@ -26,6 +26,7 @@ import Models.Project.Source exposing (Source) import Models.Project.SourceId as SourceId import Models.ProjectInfo exposing (ProjectInfo) import Models.SourceInfo as SourceInfo exposing (SourceInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Random import Services.Lenses exposing (mapShow, setId, setParsedSchema, setParsedSource) @@ -90,56 +91,56 @@ init source callback = -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Extra msg ) update wrap now project msg model = case msg of UpdateRemoteFile url -> - ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedSchema = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Cmd.none ) + ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedSchema = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Extra.none ) GetRemoteFile schemaUrl -> if schemaUrl == "" then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Extra.none ) else if schemaUrl |> String.startsWith "http" |> not then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Extra.none ) else ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Ok schemaUrl) }) - , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } + , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } |> Extra.cmd ) GotRemoteFile url result -> case result of Ok content -> - ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.jsonRemote now sourceId url content Nothing) content |> wrap) ) + ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.jsonRemote now sourceId url content Nothing) content |> wrap) |> Extra.cmd ) Err err -> - ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), T.send (model.callback (err |> Http.errorToString |> Err)) ) + ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), err |> Http.errorToString |> Err |> model.callback |> Extra.msg ) GetLocalFile file -> ( init model.source model.callback |> (\m -> { m | selectedLocalFile = Just file }) - , Ports.readLocalFile kind file + , Ports.readLocalFile kind file |> Extra.cmd ) GotFile sourceInfo fileContent -> ( { model | loadedSchema = Just ( sourceInfo |> setId (model.source |> Maybe.mapOrElse .id sourceInfo.id), fileContent ) } - , T.send (ParseSource |> wrap) + , ParseSource |> wrap |> Extra.msg ) ParseSource -> model.loadedSchema - |> Maybe.map (\( _, json ) -> ( model |> setParsedSchema (json |> Decode.decodeString JsonSchema.decode |> Just), T.send (BuildSource |> wrap) )) - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.map (\( _, json ) -> ( model |> setParsedSchema (json |> Decode.decodeString JsonSchema.decode |> Just), BuildSource |> wrap |> Extra.msg )) + |> Maybe.withDefault ( model, Extra.none ) BuildSource -> Maybe.map2 (\( info, _ ) schema -> schema |> Result.map (JsonAdapter.buildSource info) |> Result.mapError Decode.errorToString) model.loadedSchema model.parsedSchema - |> Maybe.map (\source -> ( model |> setParsedSource (source |> Just), Cmd.batch [ T.send (model.callback source), Track.sourceCreated project "json" source ] )) - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.map (\source -> ( model |> setParsedSource (Just source), Extra.cmdL [ T.send (model.callback source), Track.sourceCreated project "json" source ] )) + |> Maybe.withDefault ( model, Extra.none ) UiToggle htmlId -> - ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Cmd.none ) + ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Extra.none ) diff --git a/frontend/src/Services/Lenses.elm b/frontend/src/Services/Lenses.elm index 689724162..90ca33177 100644 --- a/frontend/src/Services/Lenses.elm +++ b/frontend/src/Services/Lenses.elm @@ -1,66 +1,63 @@ module Services.Lenses exposing ( mapActive , mapAmlSidebarM - , mapAmlSourceCmd - , mapBody - , mapBodyCmd - , mapBodyMCmd + , mapAmlSidebarMTM + , mapAmlSourceT + , mapBodyT , mapCanvas - , mapChecks + , mapCanvasT , mapCollapseTableColumns - , mapColumn + , mapCollapsedT + , mapColorT , mapColumnBasicTypes , mapColumns - , mapCommentM - , mapConf + , mapColumnsT , mapContent + , mapContentT , mapContextMenuM - , mapDataExplorerCmd - , mapDatabaseSourceCmd - , mapDatabaseSourceMCmd - , mapDetailsCmd - , mapDetailsSidebarCmd + , mapDataExplorerT + , mapDatabaseSourceMT + , mapDatabaseSourceT + , mapDetailsSidebarT + , mapDetailsT , mapEditGroupM , mapEditMemoM , mapEditNotesM , mapEditTagsM - , mapEmbedSourceParsingMCmd + , mapEmbedSourceParsingMT , mapEnabled , mapErdM - , mapErdMCmd - , mapExecutions - , mapExpanded - , mapExportDialogCmd - , mapFilter + , mapErdMT + , mapErdMTM + , mapErdMTW + , mapExportDialogT , mapFilters , mapFindPath , mapFindPathM , mapGroups - , mapHead + , mapGroupsT , mapHidden , mapHiddenColumns - , mapHighlight - , mapHighlights , mapHoverTable , mapIndex - , mapIndexes - , mapJsonSourceCmd - , mapJsonSourceMCmd - , mapLanguagesModel - , mapLanguagesModelD + , mapJsonSourceMT + , mapJsonSourceT , mapLayouts , mapLayoutsD - , mapLayoutsDCmd + , mapLayoutsDT + , mapLayoutsDTL + , mapLayoutsDTM , mapList - , mapM - , mapMCmd + , mapMT , mapMemos - , mapMemosL + , mapMemosLT + , mapMemosT , mapMetadata , mapMobileMenuOpen + , mapModalM + , mapNameT , mapNavbar - , mapNewLayoutMCmd - , mapNotes + , mapNewLayoutMT , mapOpened , mapOpenedDialogs , mapOpenedDropdown @@ -69,71 +66,67 @@ module Services.Lenses exposing , mapParsedSchemaM , mapPlan , mapPosition - , mapPrevious - , mapPrimaryKeyM - , mapPrismaSourceCmd - , mapPrismaSourceMCmd + , mapPositionT + , mapPrismaSourceMT + , mapPrismaSourceT , mapProject - , mapProjectSourceMCmd + , mapProjectSourceMTW + , mapProjectT , mapPromptM , mapProps - , mapQuery + , mapPropsT , mapRelatedTables , mapRelations , mapRemoveViews , mapRemovedSchemas , mapResult - , mapResultsCmd - , mapRow - , mapSampleSourceMCmd - , mapSaveCmd + , mapResultsT + , mapSampleSourceMTW + , mapSaveT , mapSchemaAnalysisM , mapSearch , mapSelected + , mapSelectedMT + , mapSelectionBox , mapSettings , mapSettingsM - , mapSharingCmd + , mapSharingT , mapShow , mapShowHiddenColumns , mapShowSettings - , mapSourceUpdateCmd - , mapSqlSourceCmd - , mapSqlSourceMCmd + , mapSourceUpdateT + , mapSqlSourceMT + , mapSqlSourceT , mapState + , mapStateT , mapTableRows - , mapTableRowsCmd , mapTableRowsSeq + , mapTableRowsT , mapTables - , mapTablesCmd , mapTablesL + , mapTablesLTM + , mapTablesT , mapToasts - , mapToastsCmd + , mapToastsT , mapTokenFormM - , mapUniques - , mapValues , mapVirtualRelationM , mapVisualEditor , setActive , setAmlSidebar , setAmlSource + , setArea , setBody , setCanvas - , setChecks - , setCode , setCollapseTableColumns , setCollapsed , setColor , setColors - , setColumn , setColumnBasicTypes , setColumnOrder , setColumns - , setComment - , setConf , setConfirm , setContent , setContextMenu - , setCurrentLanguage , setCurrentLayout , setCursorMode , setDataExplorer @@ -141,7 +134,6 @@ module Services.Lenses exposing , setDefaultSchema , setDetails , setDetailsSidebar - , setDisplay , setDragging , setEditGroup , setEditMemo @@ -149,47 +141,36 @@ module Services.Lenses exposing , setEditTags , setEmbedSourceParsing , setEnabled - , setEnd , setErd , setErrors - , setExecutions - , setExpanded , setExpire , setExportDialog - , setFilter , setFilters , setFindPath , setFrom , setGroups - , setHead , setHidden , setHiddenColumns , setHighlight , setHighlighted - , setHighlights - , setHoverColumn , setHoverTable , setHoverTableRow , setId , setIgnoredColumns , setIgnoredTables , setIndex - , setIndexes , setInput , setIsOpen , setJsonSource - , setLanguagesModel , setLast , setLayoutOnLoad , setLayouts , setList - , setLoading , setMax , setMemos , setMetadata , setMobileMenuOpen , setModal - , setMode , setMouse , setName , setNavbar @@ -207,7 +188,6 @@ module Services.Lenses exposing , setPlan , setPosition , setPrevious - , setPrimaryKey , setPrismaSource , setProject , setProjectSource @@ -222,7 +202,6 @@ module Services.Lenses exposing , setRemovedTables , setResult , setResults - , setRow , setSampleSource , setSave , setSchemaAnalysis @@ -237,12 +216,9 @@ module Services.Lenses exposing , setShowSettings , setShown , setSize - , setSource , setSourceUpdate , setSqlSource - , setStart , setState - , setTable , setTableRows , setTableRowsSeq , setTables @@ -253,14 +229,11 @@ module Services.Lenses exposing , setToken , setTokenForm , setTokens - , setUniques , setUpdatedAt , setValue - , setValues , setView , setVirtualRelation , setVisualEditor - , setZoom ) import Dict exposing (Dict) @@ -272,6 +245,21 @@ import Libs.Maybe as Maybe -- - `set*` helpers update the value -- - `map*` helpers provide a transform function -- +-- Here are same examples with name explanations: +-- - `setName "Loïc"`: set `name` property value in the record if different +-- - `mapName (\n -> n ++ "!")`: transform `name` property value with lambda function if different +-- - `mapNameM (\n -> n ++ "!")`: transform `name` optional property value with lambda function if present and different (M means Maybe) +-- - `mapNameT (\n -> (n, 1))`: transform `name` property value with lambda function returning a Tuple if different (T means Tuple) +-- - `mapNameMT (\n -> (n, 1))`: transform `name` optional property value with lambda function returning a Tuple if different (M means Maybe & T means Tuple) +-- - `mapNameMTW (\n -> (n, 1)) 0`: transform `name` optional property value with lambda function returning a Tuple using default value if different (M means Maybe, T means Tuple, W means With for default value) +-- - `mapNameMTM (\n -> (n, Just 1))`: transform `name` optional property value with lambda function returning a Tuple with Maybe if different (M means Maybe & T means Tuple) +-- - `mapColumnsD "name" (\c -> { c | active = True })`: transform Dict value at given key in `columns` property value with lambda function if different (D means Dict) +-- - `mapColumnsDT "name" (\c -> ({ c | active = True }, 1))`: transform Dict value at given key in `columns` property value with lambda function returning a Tuple if different (D means Dict, T means Tuple) +-- - `mapColumnsDTM "name" (\c -> ({ c | active = True }, Just 1))`: transform Dict value at given key in `columns` property value with lambda function returning a Tuple with Maybe if different (D means Dict, T means Tuple, M means Maybe) +-- - `mapColumnsL .name "name" (\c -> { c | active = True })`: transform List values having `name` property equal to "name" in `columns` property value with lambda function if different (L means List) +-- - `mapColumnsLT .name "name" (\c -> ({ c | active = True }, 1))`: transform List values having `name` property equal to "name" in `columns` property value with lambda function returning a Tuple if different (L means List, T means Tuple) +-- - `mapColumnsLTM .name "name" (\c -> ({ c | active = True }, Just 1))`: transform List values having `name` property equal to "name" in `columns` property value with lambda function returning a Tuple with Maybe if different (L means List, T means Tuple, M means Maybe) +-- -- functions should be ordered by property name @@ -295,14 +283,24 @@ mapAmlSidebarM = mapM_ .amlSidebar setAmlSidebar +mapAmlSidebarMTM : (v -> ( v, Maybe a )) -> { item | amlSidebar : Maybe v } -> ( { item | amlSidebar : Maybe v }, Maybe a ) +mapAmlSidebarMTM = + mapMTM_ .amlSidebar setAmlSidebar + + setAmlSource : v -> { item | amlSource : v } -> { item | amlSource : v } setAmlSource = set_ .amlSource (\value item -> { item | amlSource = value }) -mapAmlSourceCmd : (v -> ( v, Cmd msg )) -> { item | amlSource : v } -> ( { item | amlSource : v }, Cmd msg ) -mapAmlSourceCmd = - mapCmd_ .amlSource setAmlSource +mapAmlSourceT : (v -> ( v, a )) -> { item | amlSource : v } -> ( { item | amlSource : v }, a ) +mapAmlSourceT = + mapT_ .amlSource setAmlSource + + +setArea : v -> { item | area : v } -> { item | area : v } +setArea = + set_ .area (\value item -> { item | area = value }) setBody : v -> { item | body : v } -> { item | body : v } @@ -310,19 +308,9 @@ setBody = set_ .body (\value item -> { item | body = value }) -mapBody : (v -> v) -> { item | body : v } -> { item | body : v } -mapBody = - map_ .body setBody - - -mapBodyCmd : (v -> ( v, Cmd msg )) -> { item | body : v } -> ( { item | body : v }, Cmd msg ) -mapBodyCmd = - mapCmd_ .body setBody - - -mapBodyMCmd : (v -> ( v, Cmd msg )) -> { item | body : Maybe v } -> ( { item | body : Maybe v }, Cmd msg ) -mapBodyMCmd = - mapMCmd_ .body setBody +mapBodyT : (v -> ( v, a )) -> { item | body : v } -> ( { item | body : v }, a ) +mapBodyT = + mapT_ .body setBody setCanvas : v -> { item | canvas : v } -> { item | canvas : v } @@ -335,19 +323,9 @@ mapCanvas = map_ .canvas setCanvas -setChecks : v -> { item | checks : v } -> { item | checks : v } -setChecks = - set_ .checks (\value item -> { item | checks = value }) - - -mapChecks : (v -> v) -> { item | checks : v } -> { item | checks : v } -mapChecks = - map_ .checks setChecks - - -setCode : v -> { item | code : v } -> { item | code : v } -setCode = - set_ .code (\value item -> { item | code = value }) +mapCanvasT : (v -> ( v, a )) -> { item | canvas : v } -> ( { item | canvas : v }, a ) +mapCanvasT = + mapT_ .canvas setCanvas setCollapsed : v -> { item | collapsed : v } -> { item | collapsed : v } @@ -355,6 +333,11 @@ setCollapsed = set_ .collapsed (\value item -> { item | collapsed = value }) +mapCollapsedT : (v -> ( v, a )) -> { item | collapsed : v } -> ( { item | collapsed : v }, a ) +mapCollapsedT = + mapT_ .collapsed setCollapsed + + setCollapseTableColumns : v -> { item | collapseTableColumns : v } -> { item | collapseTableColumns : v } setCollapseTableColumns = set_ .collapseTableColumns (\value item -> { item | collapseTableColumns = value }) @@ -370,21 +353,16 @@ setColor = set_ .color (\value item -> { item | color = value }) +mapColorT : (v -> ( v, a )) -> { item | color : v } -> ( { item | color : v }, a ) +mapColorT = + mapT_ .color setColor + + setColors : v -> { item | colors : v } -> { item | colors : v } setColors = set_ .colors (\value item -> { item | colors = value }) -setColumn : v -> { item | column : v } -> { item | column : v } -setColumn = - set_ .column (\value item -> { item | column = value }) - - -mapColumn : (v -> v) -> { item | column : v } -> { item | column : v } -mapColumn = - map_ .column setColumn - - setColumns : v -> { item | columns : v } -> { item | columns : v } setColumns = set_ .columns (\value item -> { item | columns = value }) @@ -395,6 +373,11 @@ mapColumns = map_ .columns setColumns +mapColumnsT : (v -> ( v, a )) -> { item | columns : v } -> ( { item | columns : v }, a ) +mapColumnsT = + mapT_ .columns setColumns + + setColumnBasicTypes : v -> { item | columnBasicTypes : v } -> { item | columnBasicTypes : v } setColumnBasicTypes = set_ .columnBasicTypes (\value item -> { item | columnBasicTypes = value }) @@ -410,26 +393,6 @@ setColumnOrder = set_ .columnOrder (\value item -> { item | columnOrder = value }) -setComment : v -> { item | comment : v } -> { item | comment : v } -setComment = - set_ .comment (\value item -> { item | comment = value }) - - -mapCommentM : (v -> v) -> { item | comment : Maybe v } -> { item | comment : Maybe v } -mapCommentM = - mapM_ .comment setComment - - -setConf : v -> { item | conf : v } -> { item | conf : v } -setConf = - set_ .conf (\value item -> { item | conf = value }) - - -mapConf : (v -> v) -> { item | conf : v } -> { item | conf : v } -mapConf = - map_ .conf setConf - - setConfirm : v -> { item | confirm : v } -> { item | confirm : v } setConfirm = set_ .confirm (\value item -> { item | confirm = value }) @@ -445,6 +408,11 @@ mapContent = map_ .content setContent +mapContentT : (v -> ( v, a )) -> { item | content : v } -> ( { item | content : v }, a ) +mapContentT = + mapT_ .content setContent + + setContextMenu : v -> { item | contextMenu : v } -> { item | contextMenu : v } setContextMenu = set_ .contextMenu (\value item -> { item | contextMenu = value }) @@ -455,11 +423,6 @@ mapContextMenuM = mapM_ .contextMenu setContextMenu -setCurrentLanguage : v -> { item | currentLanguage : v } -> { item | currentLanguage : v } -setCurrentLanguage = - set_ .currentLanguage (\value item -> { item | currentLanguage = value }) - - setCurrentLayout : v -> { item | currentLayout : v } -> { item | currentLayout : v } setCurrentLayout = set_ .currentLayout (\value item -> { item | currentLayout = value }) @@ -475,14 +438,14 @@ setDatabaseSource = set_ .databaseSource (\value item -> { item | databaseSource = value }) -mapDatabaseSourceCmd : (v -> ( v, Cmd msg )) -> { item | databaseSource : v } -> ( { item | databaseSource : v }, Cmd msg ) -mapDatabaseSourceCmd = - mapCmd_ .databaseSource setDatabaseSource +mapDatabaseSourceT : (v -> ( v, a )) -> { item | databaseSource : v } -> ( { item | databaseSource : v }, a ) +mapDatabaseSourceT = + mapT_ .databaseSource setDatabaseSource -mapDatabaseSourceMCmd : (v -> ( v, Cmd msg )) -> { item | databaseSource : Maybe v } -> ( { item | databaseSource : Maybe v }, Cmd msg ) -mapDatabaseSourceMCmd = - mapMCmd_ .databaseSource setDatabaseSource +mapDatabaseSourceMT : (v -> ( v, a )) -> { item | databaseSource : Maybe v } -> ( { item | databaseSource : Maybe v }, Maybe a ) +mapDatabaseSourceMT transform item = + mapMT_ .databaseSource setDatabaseSource transform item setDataExplorer : v -> { item | dataExplorer : v } -> { item | dataExplorer : v } @@ -490,9 +453,9 @@ setDataExplorer = set_ .dataExplorer (\value item -> { item | dataExplorer = value }) -mapDataExplorerCmd : (v -> ( v, Cmd msg )) -> { item | dataExplorer : v } -> ( { item | dataExplorer : v }, Cmd msg ) -mapDataExplorerCmd = - mapCmd_ .dataExplorer setDataExplorer +mapDataExplorerT : (v -> ( v, a )) -> { item | dataExplorer : v } -> ( { item | dataExplorer : v }, a ) +mapDataExplorerT = + mapT_ .dataExplorer setDataExplorer setDefaultSchema : v -> { item | defaultSchema : v } -> { item | defaultSchema : v } @@ -505,9 +468,9 @@ setDetails = set_ .details (\value item -> { item | details = value }) -mapDetailsCmd : (v -> ( v, Cmd msg )) -> { item | details : v } -> ( { item | details : v }, Cmd msg ) -mapDetailsCmd = - mapCmd_ .details setDetails +mapDetailsT : (v -> ( v, a )) -> { item | details : v } -> ( { item | details : v }, a ) +mapDetailsT = + mapT_ .details setDetails setDetailsSidebar : v -> { item | detailsSidebar : v } -> { item | detailsSidebar : v } @@ -515,14 +478,9 @@ setDetailsSidebar = set_ .detailsSidebar (\value item -> { item | detailsSidebar = value }) -mapDetailsSidebarCmd : (v -> ( v, Cmd msg )) -> { item | detailsSidebar : v } -> ( { item | detailsSidebar : v }, Cmd msg ) -mapDetailsSidebarCmd = - mapCmd_ .detailsSidebar setDetailsSidebar - - -setDisplay : v -> { item | display : v } -> { item | display : v } -setDisplay = - set_ .display (\value item -> { item | display = value }) +mapDetailsSidebarT : (v -> ( v, a )) -> { item | detailsSidebar : v } -> ( { item | detailsSidebar : v }, a ) +mapDetailsSidebarT = + mapT_ .detailsSidebar setDetailsSidebar setDragging : v -> { item | dragging : v } -> { item | dragging : v } @@ -575,9 +533,9 @@ setEmbedSourceParsing = set_ .embedSourceParsing (\value item -> { item | embedSourceParsing = value }) -mapEmbedSourceParsingMCmd : (v -> ( v, Cmd msg )) -> { item | embedSourceParsing : Maybe v } -> ( { item | embedSourceParsing : Maybe v }, Cmd msg ) -mapEmbedSourceParsingMCmd = - mapMCmd_ .embedSourceParsing setEmbedSourceParsing +mapEmbedSourceParsingMT : (v -> ( v, a )) -> { item | embedSourceParsing : Maybe v } -> ( { item | embedSourceParsing : Maybe v }, Maybe a ) +mapEmbedSourceParsingMT transform item = + mapMT_ .embedSourceParsing setEmbedSourceParsing transform item setEnabled : v -> { item | enabled : v } -> { item | enabled : v } @@ -590,11 +548,6 @@ mapEnabled = map_ .enabled setEnabled -setEnd : v -> { item | end : v } -> { item | end : v } -setEnd = - set_ .end (\value item -> { item | end = value }) - - setErd : v -> { item | erd : v } -> { item | erd : v } setErd = set_ .erd (\value item -> { item | erd = value }) @@ -605,34 +558,24 @@ mapErdM = mapM_ .erd setErd -mapErdMCmd : (v -> ( v, Cmd msg )) -> { item | erd : Maybe v } -> ( { item | erd : Maybe v }, Cmd msg ) -mapErdMCmd = - mapMCmd_ .erd setErd - - -setErrors : v -> { item | errors : v } -> { item | errors : v } -setErrors = - set_ .errors (\value item -> { item | errors = value }) +mapErdMT : (v -> ( v, a )) -> { item | erd : Maybe v } -> ( { item | erd : Maybe v }, Maybe a ) +mapErdMT = + mapMT_ .erd setErd -setExecutions : v -> { item | executions : v } -> { item | executions : v } -setExecutions = - set_ .executions (\value item -> { item | executions = value }) +mapErdMTW : (v -> ( v, a )) -> a -> { item | erd : Maybe v } -> ( { item | erd : Maybe v }, a ) +mapErdMTW transform default item = + mapMT_ .erd setErd transform item |> Tuple.mapSecond (Maybe.withDefault default) -mapExecutions : (v -> v) -> { item | executions : v } -> { item | executions : v } -mapExecutions = - map_ .executions setExecutions +mapErdMTM : (v -> ( v, Maybe a )) -> { item | erd : Maybe v } -> ( { item | erd : Maybe v }, Maybe a ) +mapErdMTM = + mapMTM_ .erd setErd -setExpanded : v -> { item | expanded : v } -> { item | expanded : v } -setExpanded = - set_ .expanded (\value item -> { item | expanded = value }) - - -mapExpanded : (v -> v) -> { item | expanded : v } -> { item | expanded : v } -mapExpanded = - map_ .expanded setExpanded +setErrors : v -> { item | errors : v } -> { item | errors : v } +setErrors = + set_ .errors (\value item -> { item | errors = value }) setExpire : v -> { item | expire : v } -> { item | expire : v } @@ -645,19 +588,9 @@ setExportDialog = set_ .exportDialog (\value item -> { item | exportDialog = value }) -mapExportDialogCmd : (v -> ( v, Cmd msg )) -> { item | exportDialog : v } -> ( { item | exportDialog : v }, Cmd msg ) -mapExportDialogCmd = - mapCmd_ .exportDialog setExportDialog - - -setFilter : v -> { item | filter : v } -> { item | filter : v } -setFilter = - set_ .filter (\value item -> { item | filter = value }) - - -mapFilter : (v -> v) -> { item | filter : v } -> { item | filter : v } -mapFilter = - map_ .filter setFilter +mapExportDialogT : (v -> ( v, a )) -> { item | exportDialog : v } -> ( { item | exportDialog : v }, a ) +mapExportDialogT = + mapT_ .exportDialog setExportDialog setFilters : v -> { item | filters : v } -> { item | filters : v } @@ -700,14 +633,9 @@ mapGroups = map_ .groups setGroups -setHead : v -> { item | head : v } -> { item | head : v } -setHead = - set_ .head (\value item -> { item | head = value }) - - -mapHead : (v -> v) -> { item | head : v } -> { item | head : v } -mapHead = - map_ .head setHead +mapGroupsT : (v -> ( v, a )) -> { item | groups : v } -> ( { item | groups : v }, a ) +mapGroupsT = + mapT_ .groups setGroups setHidden : v -> { item | hidden : v } -> { item | hidden : v } @@ -735,36 +663,11 @@ setHighlight = set_ .highlight (\value item -> { item | highlight = value }) -mapHighlight : (v -> v) -> { item | highlight : v } -> { item | highlight : v } -mapHighlight = - map_ .highlight setHighlight - - -setHighlights : v -> { item | highlights : v } -> { item | highlights : v } -setHighlights = - set_ .highlights (\value item -> { item | highlights = value }) - - -mapHighlights : (v -> v) -> { item | highlights : v } -> { item | highlights : v } -mapHighlights = - map_ .highlights setHighlights - - setHighlighted : v -> { item | highlighted : v } -> { item | highlighted : v } setHighlighted = set_ .highlighted (\value item -> { item | highlighted = value }) -setHoverColumn : v -> { item | hoverColumn : v } -> { item | hoverColumn : v } -setHoverColumn = - set_ .hoverColumn (\value item -> { item | hoverColumn = value }) - - -setHoverTableRow : v -> { item | hoverTableRow : v } -> { item | hoverTableRow : v } -setHoverTableRow = - set_ .hoverTableRow (\value item -> { item | hoverTableRow = value }) - - setHoverTable : v -> { item | hoverTable : v } -> { item | hoverTable : v } setHoverTable = set_ .hoverTable (\value item -> { item | hoverTable = value }) @@ -775,6 +678,11 @@ mapHoverTable = map_ .hoverTable setHoverTable +setHoverTableRow : v -> { item | hoverTableRow : v } -> { item | hoverTableRow : v } +setHoverTableRow = + set_ .hoverTableRow (\value item -> { item | hoverTableRow = value }) + + setId : v -> { item | id : v } -> { item | id : v } setId = set_ .id (\value item -> { item | id = value }) @@ -800,16 +708,6 @@ mapIndex = map_ .index setIndex -setIndexes : v -> { item | indexes : v } -> { item | indexes : v } -setIndexes = - set_ .indexes (\value item -> { item | indexes = value }) - - -mapIndexes : (v -> v) -> { item | indexes : v } -> { item | indexes : v } -mapIndexes = - map_ .indexes setIndexes - - setInput : v -> { item | input : v } -> { item | input : v } setInput = set_ .input (\value item -> { item | input = value }) @@ -825,29 +723,14 @@ setJsonSource = set_ .jsonSource (\value item -> { item | jsonSource = value }) -mapJsonSourceCmd : (v -> ( v, Cmd msg )) -> { item | jsonSource : v } -> ( { item | jsonSource : v }, Cmd msg ) -mapJsonSourceCmd = - mapCmd_ .jsonSource setJsonSource +mapJsonSourceT : (v -> ( v, a )) -> { item | jsonSource : v } -> ( { item | jsonSource : v }, a ) +mapJsonSourceT = + mapT_ .jsonSource setJsonSource -mapJsonSourceMCmd : (v -> ( v, Cmd msg )) -> { item | jsonSource : Maybe v } -> ( { item | jsonSource : Maybe v }, Cmd msg ) -mapJsonSourceMCmd = - mapMCmd_ .jsonSource setJsonSource - - -setLanguagesModel : v -> { item | languagesModel : v } -> { item | languagesModel : v } -setLanguagesModel = - set_ .languagesModel (\value item -> { item | languagesModel = value }) - - -mapLanguagesModel : (v -> v) -> { item | languagesModel : v } -> { item | languagesModel : v } -mapLanguagesModel = - map_ .languagesModel setLanguagesModel - - -mapLanguagesModelD : comparable -> (v -> v) -> { item | languagesModel : Dict comparable v } -> { item | languagesModel : Dict comparable v } -mapLanguagesModelD = - mapD_ .languagesModel setLanguagesModel +mapJsonSourceMT : (v -> ( v, a )) -> { item | jsonSource : Maybe v } -> ( { item | jsonSource : Maybe v }, Maybe a ) +mapJsonSourceMT transform item = + mapMT_ .jsonSource setJsonSource transform item setLast : v -> { item | last : v } -> { item | last : v } @@ -875,9 +758,19 @@ mapLayoutsD = mapD_ .layouts setLayouts -mapLayoutsDCmd : comparable -> (v -> ( v, Cmd msg )) -> { item | layouts : Dict comparable v } -> ( { item | layouts : Dict comparable v }, Cmd msg ) -mapLayoutsDCmd = - mapDCmd_ .layouts setLayouts +mapLayoutsDT : comparable -> (v -> ( v, a )) -> { item | layouts : Dict comparable v } -> ( { item | layouts : Dict comparable v }, Maybe a ) +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 setList : v -> { item | list : v } -> { item | list : v } @@ -885,11 +778,6 @@ setList = set_ .list (\value item -> { item | list = value }) -setLoading : v -> { item | loading : v } -> { item | loading : v } -setLoading = - set_ .loading (\value item -> { item | loading = value }) - - setMax : v -> { item | max : v } -> { item | max : v } setMax = set_ .max (\value item -> { item | max = value }) @@ -905,9 +793,14 @@ mapMemos = map_ .memos setMemos -mapMemosL : (v -> k) -> k -> (v -> v) -> { item | memos : List v } -> { item | memos : List v } -mapMemosL = - mapL_ .memos setMemos +mapMemosT : (v -> ( v, a )) -> { item | memos : v } -> ( { item | memos : v }, a ) +mapMemosT = + mapT_ .memos setMemos + + +mapMemosLT : (v -> k) -> k -> (v -> ( v, t )) -> { item | memos : List v } -> ( { item | memos : List v }, Maybe t ) +mapMemosLT = + mapLT_ .memos setMemos setMetadata : v -> { item | metadata : v } -> { item | metadata : v } @@ -935,9 +828,9 @@ setModal = set_ .modal (\value item -> { item | modal = value }) -setMode : v -> { item | mode : v } -> { item | mode : v } -setMode = - set_ .mode (\value item -> { item | mode = value }) +mapModalM : (v -> v) -> { item | modal : Maybe v } -> { item | modal : Maybe v } +mapModalM = + mapM_ .modal setModal setMouse : v -> { item | mouse : v } -> { item | mouse : v } @@ -950,6 +843,11 @@ setName = set_ .name (\value item -> { item | name = value }) +mapNameT : (v -> ( v, a )) -> { item | name : v } -> ( { item | name : v }, a ) +mapNameT = + mapT_ .name setName + + setNavbar : v -> { item | navbar : v } -> { item | navbar : v } setNavbar = set_ .navbar (\value item -> { item | navbar = value }) @@ -965,9 +863,9 @@ setNewLayout = set_ .newLayout (\value item -> { item | newLayout = value }) -mapNewLayoutMCmd : (v -> ( v, Cmd msg )) -> { item | newLayout : Maybe v } -> ( { item | newLayout : Maybe v }, Cmd msg ) -mapNewLayoutMCmd = - mapMCmd_ .newLayout setNewLayout +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 } @@ -975,11 +873,6 @@ setNotes = set_ .notes (\value item -> { item | notes = value }) -mapNotes : (v -> v) -> { item | notes : v } -> { item | notes : v } -mapNotes = - map_ .notes setNotes - - setOpened : v -> { item | opened : v } -> { item | opened : v } setOpened = set_ .opened (\value item -> { item | opened = value }) @@ -1075,39 +968,29 @@ mapPosition = map_ .position setPosition +mapPositionT : (v -> ( v, a )) -> { item | position : v } -> ( { item | position : v }, a ) +mapPositionT = + mapT_ .position setPosition + + setPrevious : v -> { item | previous : v } -> { item | previous : v } setPrevious = set_ .previous (\value item -> { item | previous = value }) -mapPrevious : (v -> v) -> { item | previous : v } -> { item | previous : v } -mapPrevious = - map_ .previous setPrevious - - -setPrimaryKey : v -> { item | primaryKey : v } -> { item | primaryKey : v } -setPrimaryKey = - set_ .primaryKey (\value item -> { item | primaryKey = value }) - - -mapPrimaryKeyM : (v -> v) -> { item | primaryKey : Maybe v } -> { item | primaryKey : Maybe v } -mapPrimaryKeyM = - mapM_ .primaryKey setPrimaryKey - - setPrismaSource : v -> { item | prismaSource : v } -> { item | prismaSource : v } setPrismaSource = set_ .prismaSource (\value item -> { item | prismaSource = value }) -mapPrismaSourceCmd : (v -> ( v, Cmd msg )) -> { item | prismaSource : v } -> ( { item | prismaSource : v }, Cmd msg ) -mapPrismaSourceCmd = - mapCmd_ .prismaSource setPrismaSource +mapPrismaSourceT : (v -> ( v, a )) -> { item | prismaSource : v } -> ( { item | prismaSource : v }, a ) +mapPrismaSourceT = + mapT_ .prismaSource setPrismaSource -mapPrismaSourceMCmd : (v -> ( v, Cmd msg )) -> { item | prismaSource : Maybe v } -> ( { item | prismaSource : Maybe v }, Cmd msg ) -mapPrismaSourceMCmd = - mapMCmd_ .prismaSource setPrismaSource +mapPrismaSourceMT : (v -> ( v, a )) -> { item | prismaSource : Maybe v } -> ( { item | prismaSource : Maybe v }, Maybe a ) +mapPrismaSourceMT transform item = + mapMT_ .prismaSource setPrismaSource transform item setProject : v -> { item | project : v } -> { item | project : v } @@ -1120,14 +1003,19 @@ mapProject = map_ .project setProject +mapProjectT : (v -> ( v, a )) -> { item | project : v } -> ( { item | project : v }, a ) +mapProjectT = + mapT_ .project setProject + + setProjectSource : v -> { item | projectSource : v } -> { item | projectSource : v } setProjectSource = set_ .projectSource (\value item -> { item | projectSource = value }) -mapProjectSourceMCmd : (v -> ( v, Cmd msg )) -> { item | projectSource : Maybe v } -> ( { item | projectSource : Maybe v }, Cmd msg ) -mapProjectSourceMCmd = - mapMCmd_ .projectSource setProjectSource +mapProjectSourceMTW : (v -> ( v, a )) -> a -> { item | projectSource : Maybe v } -> ( { item | projectSource : Maybe v }, a ) +mapProjectSourceMTW transform default item = + mapMT_ .projectSource setProjectSource transform item |> Tuple.mapSecond (Maybe.withDefault default) setPrompt : v -> { item | prompt : v } -> { item | prompt : v } @@ -1150,16 +1038,16 @@ mapProps = map_ .props setProps +mapPropsT : (v -> ( v, a )) -> { item | props : v } -> ( { item | props : v }, a ) +mapPropsT = + mapT_ .props setProps + + setQuery : v -> { item | query : v } -> { item | query : v } setQuery = set_ .query (\value item -> { item | query = value }) -mapQuery : (v -> v) -> { item | query : v } -> { item | query : v } -mapQuery = - map_ .query setQuery - - setRelatedTables : v -> { item | relatedTables : v } -> { item | relatedTables : v } setRelatedTables = set_ .relatedTables (\value item -> { item | relatedTables = value }) @@ -1225,19 +1113,9 @@ setResults = set_ .results (\value item -> { item | results = value }) -mapResultsCmd : (v -> ( v, Cmd msg )) -> { item | results : v } -> ( { item | results : v }, Cmd msg ) -mapResultsCmd = - mapCmd_ .results setResults - - -setRow : v -> { item | row : v } -> { item | row : v } -setRow = - set_ .row (\value item -> { item | row = value }) - - -mapRow : (v -> v) -> { item | row : v } -> { item | row : v } -mapRow = - map_ .row setRow +mapResultsT : (v -> ( v, a )) -> { item | results : v } -> ( { item | results : v }, a ) +mapResultsT = + mapT_ .results setResults setSampleSource : v -> { item | sampleSource : v } -> { item | sampleSource : v } @@ -1245,9 +1123,9 @@ setSampleSource = set_ .sampleSource (\value item -> { item | sampleSource = value }) -mapSampleSourceMCmd : (v -> ( v, Cmd msg )) -> { item | sampleSource : Maybe v } -> ( { item | sampleSource : Maybe v }, Cmd msg ) -mapSampleSourceMCmd = - mapMCmd_ .sampleSource setSampleSource +mapSampleSourceMTW : (v -> ( v, a )) -> a -> { item | sampleSource : Maybe v } -> ( { item | sampleSource : Maybe v }, a ) +mapSampleSourceMTW transform default item = + mapMT_ .sampleSource setSampleSource transform item |> Tuple.mapSecond (Maybe.withDefault default) setSave : v -> { item | save : v } -> { item | save : v } @@ -1255,9 +1133,9 @@ setSave = set_ .save (\value item -> { item | save = value }) -mapSaveCmd : (v -> ( v, Cmd msg )) -> { item | save : v } -> ( { item | save : v }, Cmd msg ) -mapSaveCmd = - mapCmd_ .save setSave +mapSaveT : (v -> ( v, a )) -> { item | save : v } -> ( { item | save : v }, a ) +mapSaveT = + mapT_ .save setSave setSchemaAnalysis : v -> { item | schemaAnalysis : v } -> { item | schemaAnalysis : v } @@ -1310,19 +1188,29 @@ mapSelected = map_ .selected setSelected +mapSelectedMT : (v -> ( v, a )) -> { item | selected : Maybe v } -> ( { item | selected : Maybe v }, Maybe a ) +mapSelectedMT transform item = + mapMT_ .selected setSelected transform item + + setSelectionBox : v -> { item | selectionBox : v } -> { item | selectionBox : v } setSelectionBox = set_ .selectionBox (\value item -> { item | selectionBox = value }) +mapSelectionBox : (v -> v) -> { item | selectionBox : v } -> { item | selectionBox : v } +mapSelectionBox = + map_ .selectionBox setSelectionBox + + setSharing : v -> { item | sharing : v } -> { item | sharing : v } setSharing = set_ .sharing (\value item -> { item | sharing = value }) -mapSharingCmd : (v -> ( v, Cmd msg )) -> { item | sharing : v } -> ( { item | sharing : v }, Cmd msg ) -mapSharingCmd = - mapCmd_ .sharing setSharing +mapSharingT : (v -> ( v, a )) -> { item | sharing : v } -> ( { item | sharing : v }, a ) +mapSharingT = + mapT_ .sharing setSharing setShow : v -> { item | show : v } -> { item | show : v } @@ -1365,19 +1253,14 @@ setSize = set_ .size (\value item -> { item | size = value }) -setSource : v -> { item | source : v } -> { item | source : v } -setSource = - set_ .source (\value item -> { item | source = value }) - - setSourceUpdate : v -> { item | sourceUpdate : v } -> { item | sourceUpdate : v } setSourceUpdate = set_ .sourceUpdate (\value item -> { item | sourceUpdate = value }) -mapSourceUpdateCmd : (v -> ( v, Cmd msg )) -> { item | sourceUpdate : v } -> ( { item | sourceUpdate : v }, Cmd msg ) -mapSourceUpdateCmd = - mapCmd_ .sourceUpdate setSourceUpdate +mapSourceUpdateT : (v -> ( v, a )) -> { item | sourceUpdate : v } -> ( { item | sourceUpdate : v }, a ) +mapSourceUpdateT = + mapT_ .sourceUpdate setSourceUpdate setSqlSource : v -> { item | sqlSource : v } -> { item | sqlSource : v } @@ -1385,19 +1268,14 @@ setSqlSource = set_ .sqlSource (\value item -> { item | sqlSource = value }) -mapSqlSourceCmd : (v -> ( v, Cmd msg )) -> { item | sqlSource : v } -> ( { item | sqlSource : v }, Cmd msg ) -mapSqlSourceCmd = - mapCmd_ .sqlSource setSqlSource - +mapSqlSourceT : (v -> ( v, a )) -> { item | sqlSource : v } -> ( { item | sqlSource : v }, a ) +mapSqlSourceT = + mapT_ .sqlSource setSqlSource -mapSqlSourceMCmd : (v -> ( v, Cmd msg )) -> { item | sqlSource : Maybe v } -> ( { item | sqlSource : Maybe v }, Cmd msg ) -mapSqlSourceMCmd = - mapMCmd_ .sqlSource setSqlSource - -setStart : v -> { item | start : v } -> { item | start : v } -setStart = - set_ .start (\value item -> { item | start = value }) +mapSqlSourceMT : (v -> ( v, a )) -> { item | sqlSource : Maybe v } -> ( { item | sqlSource : Maybe v }, Maybe a ) +mapSqlSourceMT transform item = + mapMT_ .sqlSource setSqlSource transform item setState : v -> { item | state : v } -> { item | state : v } @@ -1410,9 +1288,9 @@ mapState = map_ .state setState -setTable : v -> { item | table : v } -> { item | table : v } -setTable = - set_ .table (\value item -> { item | table = value }) +mapStateT : (v -> ( v, a )) -> { item | state : v } -> ( { item | state : v }, a ) +mapStateT = + mapT_ .state setState setTables : v -> { item | tables : v } -> { item | tables : v } @@ -1425,14 +1303,19 @@ mapTables = map_ .tables setTables +mapTablesT : (v -> ( v, a )) -> { item | tables : v } -> ( { item | tables : v }, a ) +mapTablesT = + mapT_ .tables setTables + + mapTablesL : (v -> k) -> k -> (v -> v) -> { item | tables : List v } -> { item | tables : List v } mapTablesL = mapL_ .tables setTables -mapTablesCmd : (v -> ( v, Cmd msg )) -> { item | tables : v } -> ( { item | tables : v }, Cmd msg ) -mapTablesCmd = - mapCmd_ .tables setTables +mapTablesLTM : (v -> k) -> k -> (v -> ( v, Maybe a )) -> { item | tables : List v } -> ( { item | tables : List v }, Maybe a ) +mapTablesLTM = + mapLTM_ .tables setTables setTableRows : v -> { item | tableRows : v } -> { item | tableRows : v } @@ -1445,9 +1328,9 @@ mapTableRows = map_ .tableRows setTableRows -mapTableRowsCmd : (v -> ( v, Cmd msg )) -> { item | tableRows : v } -> ( { item | tableRows : v }, Cmd msg ) -mapTableRowsCmd = - mapCmd_ .tableRows setTableRows +mapTableRowsT : (v -> ( v, a )) -> { item | tableRows : v } -> ( { item | tableRows : v }, a ) +mapTableRowsT = + mapT_ .tableRows setTableRows setTableRowsSeq : v -> { item | tableRowsSeq : v } -> { item | tableRowsSeq : v } @@ -1485,9 +1368,9 @@ mapToasts = map_ .toasts setToasts -mapToastsCmd : (v -> ( v, Cmd msg )) -> { item | toasts : v } -> ( { item | toasts : v }, Cmd msg ) -mapToastsCmd = - mapCmd_ .toasts setToasts +mapToastsT : (v -> ( v, a )) -> { item | toasts : v } -> ( { item | toasts : v }, a ) +mapToastsT = + mapT_ .toasts setToasts setToken : v -> { item | token : v } -> { item | token : v } @@ -1510,16 +1393,6 @@ mapTokenFormM = mapM_ .tokenForm setTokenForm -setUniques : v -> { item | uniques : v } -> { item | uniques : v } -setUniques = - set_ .uniques (\value item -> { item | uniques = value }) - - -mapUniques : (v -> v) -> { item | uniques : v } -> { item | uniques : v } -mapUniques = - map_ .uniques setUniques - - setUpdatedAt : v -> { item | updatedAt : v } -> { item | updatedAt : v } setUpdatedAt = set_ .updatedAt (\value item -> { item | updatedAt = value }) @@ -1530,16 +1403,6 @@ setValue = set_ .value (\value item -> { item | value = value }) -setValues : v -> { item | values : v } -> { item | values : v } -setValues = - set_ .values (\value item -> { item | values = value }) - - -mapValues : (v -> v) -> { item | values : v } -> { item | values : v } -mapValues = - map_ .values setValues - - setView : v -> { item | view : v } -> { item | view : v } setView = set_ .view (\view item -> { item | view = view }) @@ -1565,27 +1428,18 @@ mapVisualEditor = map_ .visualEditor setVisualEditor -setZoom : v -> { item | zoom : v } -> { item | zoom : v } -setZoom = - set_ .zoom (\value item -> { item | zoom = value }) - - -- specific methods -mapM : (v -> v) -> Maybe v -> Maybe v -mapM transform item = - item |> Maybe.map transform - - -mapMCmd : (v -> ( v, Cmd msg )) -> Maybe v -> ( Maybe v, Cmd msg ) -mapMCmd transform item = - item |> Maybe.mapOrElse (transform >> Tuple.mapFirst Just) ( Nothing, Cmd.none ) +mapMT : (v -> ( v, a )) -> Maybe v -> ( Maybe v, Maybe a ) +mapMT transform item = + item |> Maybe.mapT transform mapList : (item -> k) -> k -> (item -> item) -> List item -> List item mapList get key transform list = + -- map list given a condition list |> List.map (\item -> @@ -1603,6 +1457,7 @@ mapList get key transform list = set_ : (item -> v) -> (v -> item -> item) -> v -> item -> item set_ get update value item = + -- set a value in a record if different if get item == value then item @@ -1612,62 +1467,118 @@ set_ get update value item = map_ : (item -> v) -> (v -> item -> item) -> (v -> v) -> item -> item map_ get update transform item = + -- update a value in a record update (item |> get |> transform) item +mapT_ : (item -> v) -> (v -> item -> item) -> (v -> ( v, a )) -> item -> ( item, a ) +mapT_ get update transform item = + -- update a value in a record keeping tuple + item |> get |> transform |> Tuple.mapFirst (\value -> update value item) + + mapM_ : (item -> Maybe v) -> (Maybe v -> item -> item) -> (v -> v) -> item -> item mapM_ get update transform item = + -- update an optional value in a record if present update (item |> get |> Maybe.map transform) item -mapL_ : (item -> List v) -> (List v -> item -> item) -> (v -> k) -> k -> (v -> v) -> item -> item -mapL_ get update getKey key transform item = - update - (item - |> get - |> List.map - (\v -> - if getKey v == key then - transform v - - else - v - ) - ) - item +mapMT_ : (item -> Maybe v) -> (Maybe v -> item -> item) -> (v -> ( v, a )) -> item -> ( item, Maybe a ) +mapMT_ get update transform item = + -- update optional value in a record keeping tuple + item |> get |> Maybe.mapOrElse (transform >> Tuple.mapBoth (\value -> item |> update (Just value)) Just) ( item, Nothing ) + + +mapMTM_ : (item -> Maybe v) -> (Maybe v -> item -> item) -> (v -> ( v, Maybe a )) -> item -> ( item, Maybe a ) +mapMTM_ get update transform item = + -- update optional value in a record keeping tuple + item |> get |> Maybe.mapOrElse (transform >> Tuple.mapFirst (\value -> item |> update (Just value))) ( item, Nothing ) mapD_ : (item -> Dict comparable v) -> (Dict comparable v -> item -> item) -> comparable -> (v -> v) -> item -> item mapD_ get update key transform item = + -- update dict values in a record if match condition update (item |> get |> Dict.update key (Maybe.map transform)) item -mapCmd_ : (item -> v) -> (v -> item -> item) -> (v -> ( v, Cmd msg )) -> item -> ( item, Cmd msg ) -mapCmd_ get update transform item = - item |> get |> transform |> Tuple.mapFirst (\value -> update value item) +mapDT_ : (item -> Dict comparable v) -> (Dict comparable v -> item -> item) -> comparable -> (v -> ( v, a )) -> item -> ( item, Maybe a ) +mapDT_ get update key transform item = + item |> get |> Dict.get key |> Maybe.mapOrElse (transform >> Tuple.mapBoth (\n -> mapD_ get update key (\_ -> n) item) Just) ( item, Nothing ) -mapMCmd_ : (item -> Maybe v) -> (Maybe v -> item -> item) -> (v -> ( v, Cmd msg )) -> item -> ( item, Cmd msg ) -mapMCmd_ get update transform item = - item |> get |> Maybe.mapOrElse (transform >> Tuple.mapFirst (\value -> item |> update (Just value))) ( item, Cmd.none ) +mapDTM_ : (item -> Dict comparable v) -> (Dict comparable v -> item -> item) -> comparable -> (v -> ( v, Maybe a )) -> item -> ( item, Maybe a ) +mapDTM_ get update key transform item = + item |> get |> Dict.get key |> Maybe.mapOrElse (transform >> Tuple.mapFirst (\n -> mapD_ get update key (\_ -> n) item)) ( item, Nothing ) -mapDCmd_ : (item -> Dict comparable v) -> (Dict comparable v -> item -> item) -> comparable -> (v -> ( v, Cmd msg )) -> item -> ( item, Cmd msg ) -mapDCmd_ get update key transform item = - item |> get |> Dict.get key |> Maybe.mapOrElse (transform >> Tuple.mapFirst (\n -> mapD_ get update key (\_ -> n) item)) ( item, Cmd.none ) +mapDTL_ : (item -> Dict comparable v) -> (Dict comparable v -> item -> item) -> comparable -> (v -> ( v, List a )) -> item -> ( item, List a ) +mapDTL_ get update key transform item = + item |> get |> Dict.get key |> Maybe.mapOrElse (transform >> Tuple.mapFirst (\n -> mapD_ get update key (\_ -> n) item)) ( item, [] ) +mapL_ : (item -> List v) -> (List v -> item -> item) -> (v -> k) -> k -> (v -> v) -> item -> item +mapL_ get update getKey key transform item = + -- update list values in a record if match condition + (item + |> get + |> List.map + (\v -> + if getKey v == key then + transform v ---pure : a -> ( a, Cmd msg ) ---pure a = --- ( a, Cmd.none ) --- --- ---map : (a -> b) -> ( a, Cmd msg ) -> ( b, Cmd msg ) ---map f ( a, cmd ) = --- ( f a, cmd ) --- --- ---andThen : (a -> ( b, Cmd msg )) -> ( a, Cmd msg ) -> ( b, Cmd msg ) ---andThen f ( a, cmd1 ) = --- f a |> Tuple.mapSecond (\cmd2 -> Cmd.batch [ cmd1, cmd2 ]) + else + v + ) + ) + |> (\l -> update l item) + + +mapLT_ : (item -> List v) -> (List v -> item -> item) -> (v -> k) -> k -> (v -> ( v, t )) -> item -> ( item, Maybe t ) +mapLT_ get update getKey key transform item = + -- update list values in a record if match condition + (item + |> get + |> List.map + (\v -> + if getKey v == key then + transform v |> Tuple.mapSecond Just + + else + ( v, Nothing ) + ) + ) + |> List.unzip + |> Tuple.mapBoth (\l -> update l item) (List.filterMap identity >> List.head) + + +mapLTM_ : (item -> List v) -> (List v -> item -> item) -> (v -> k) -> k -> (v -> ( v, Maybe a )) -> item -> ( item, Maybe a ) +mapLTM_ get update getKey key transform item = + item + |> get + |> List.map + (\v -> + if getKey v == key then + transform v + + else + ( v, Nothing ) + ) + |> List.unzip + |> Tuple.mapBoth (\l -> update l item) (List.filterMap identity >> List.head) + + +mapLTL_ : (item -> List v) -> (List v -> item -> item) -> (v -> k) -> k -> (v -> ( v, List t )) -> item -> ( item, List t ) +mapLTL_ get update getKey key transform item = + -- update list values in a record if match condition + item + |> get + |> List.map + (\v -> + if getKey v == key then + transform v + + else + ( v, [] ) + ) + |> List.unzip + |> Tuple.mapBoth (\l -> update l item) List.concat diff --git a/frontend/src/Services/PrismaSource.elm b/frontend/src/Services/PrismaSource.elm index 8ed020e3b..bba3ca8bc 100644 --- a/frontend/src/Services/PrismaSource.elm +++ b/frontend/src/Services/PrismaSource.elm @@ -24,6 +24,7 @@ import Models.Project.Source exposing (Source) import Models.Project.SourceId as SourceId import Models.ProjectInfo exposing (ProjectInfo) import Models.SourceInfo as SourceInfo exposing (SourceInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Random import Services.Lenses exposing (mapShow, setId, setParsedSchema, setParsedSource) @@ -88,56 +89,56 @@ init source callback = -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Extra msg ) update wrap now project msg model = case msg of UpdateRemoteFile url -> - ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedSchema = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Cmd.none ) + ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedSchema = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Extra.none ) GetRemoteFile schemaUrl -> if schemaUrl == "" then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Extra.none ) else if schemaUrl |> String.startsWith "http" |> not then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Extra.none ) else ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Ok schemaUrl) }) - , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } + , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } |> Extra.cmd ) GotRemoteFile url result -> case result of Ok content -> - ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.prismaRemote now sourceId url content Nothing) content |> wrap) ) + ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.prismaRemote now sourceId url content Nothing) content |> wrap) |> Extra.cmd ) Err err -> - ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), T.send (model.callback (err |> Http.errorToString |> Err)) ) + ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), err |> Http.errorToString |> Err |> model.callback |> Extra.msg ) GetLocalFile file -> ( init model.source model.callback |> (\m -> { m | selectedLocalFile = Just file }) - , Ports.readLocalFile kind file + , Ports.readLocalFile kind file |> Extra.cmd ) GotFile sourceInfo fileContent -> ( { model | loadedSchema = Just ( sourceInfo |> setId (model.source |> Maybe.mapOrElse .id sourceInfo.id), fileContent ) } - , Ports.getPrismaSchema fileContent + , Ports.getPrismaSchema fileContent |> Extra.cmd ) GotSchema schema -> model.loadedSchema - |> Maybe.map (\_ -> ( model |> setParsedSchema (schema |> Just), BuildSource |> wrap |> T.send )) - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.map (\_ -> ( model |> setParsedSchema (Just schema), BuildSource |> wrap |> Extra.msg )) + |> Maybe.withDefault ( model, Extra.none ) BuildSource -> Maybe.map2 (\( info, _ ) schema -> schema |> Result.map (JsonAdapter.buildSource info)) model.loadedSchema model.parsedSchema - |> Maybe.map (\source -> ( model |> setParsedSource (source |> Just), Cmd.batch [ T.send (model.callback source), Track.sourceCreated project "prisma" source ] )) - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.map (\source -> ( model |> setParsedSource (Just source), Extra.cmdL [ T.send (model.callback source), Track.sourceCreated project "prisma" source ] )) + |> Maybe.withDefault ( model, Extra.none ) UiToggle htmlId -> - ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Cmd.none ) + ( model |> mapShow (\s -> B.cond (s == htmlId) "" htmlId), Extra.none ) diff --git a/frontend/src/Services/ProjectSource.elm b/frontend/src/Services/ProjectSource.elm index 23d4e8923..0e9bb5904 100644 --- a/frontend/src/Services/ProjectSource.elm +++ b/frontend/src/Services/ProjectSource.elm @@ -96,13 +96,13 @@ update wrap msg model = GotRemoteFile result -> case result of Ok content -> - ( model, T.send (GotFile content |> wrap) ) + ( model, GotFile content |> wrap |> T.send ) Err err -> ( { model | loadedProject = err |> Err |> Just } |> setProject (err |> Http.errorToString |> Err |> Just), Cmd.none ) GotFile content -> - ( { model | loadedProject = content |> Ok |> Just }, T.send (ParseProject |> wrap) ) + ( { model | loadedProject = content |> Ok |> Just }, ParseProject |> wrap |> T.send ) ParseProject -> model.loadedProject @@ -111,7 +111,7 @@ update wrap msg model = (\loadedProject -> case loadedProject |> Decode.decodeString Project.decode of Ok project -> - ( { model | parsedProject = project |> Ok |> Just }, T.send (BuildProject |> wrap) ) + ( { model | parsedProject = project |> Ok |> Just }, BuildProject |> wrap |> T.send ) Err err -> ( { model | parsedProject = err |> Err |> Just } |> setProject (err |> Decode.errorToString |> Err |> Just), Cmd.none ) diff --git a/frontend/src/Services/SqlSource.elm b/frontend/src/Services/SqlSource.elm index 274e1fdcc..5d76f143b 100644 --- a/frontend/src/Services/SqlSource.elm +++ b/frontend/src/Services/SqlSource.elm @@ -36,6 +36,7 @@ import Models.Project.Source exposing (Source) import Models.Project.SourceId as SourceId exposing (SourceId) import Models.ProjectInfo exposing (ProjectInfo) import Models.SourceInfo as SourceInfo exposing (SourceInfo) +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Ports import Random import Services.Lenses exposing (mapParsedSchemaM, mapShow, setId, setParsedSource) @@ -135,35 +136,35 @@ parsingInit fileContent buildMsg buildProject = -- UPDATE -update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Cmd msg ) +update : (Msg -> msg) -> Time.Posix -> Maybe ProjectInfo -> Msg -> Model msg -> ( Model msg, Extra msg ) update wrap now project msg model = case msg of UpdateRemoteFile url -> - ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedFile = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Cmd.none ) + ( { model | url = url, selectedLocalFile = Nothing, selectedRemoteFile = Nothing, loadedFile = Nothing, parsedSchema = Nothing, parsedSource = Nothing }, Extra.none ) GetRemoteFile schemaUrl -> if schemaUrl == "" then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl }), Extra.none ) else if schemaUrl |> String.startsWith "http" |> not then - ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Cmd.none ) + ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Err "Invalid url, it should start with 'http'") }), Extra.none ) else ( init model.source model.callback |> (\m -> { m | url = schemaUrl, selectedRemoteFile = Just (Ok schemaUrl) }) - , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } + , Http.get { url = schemaUrl, expect = Http.expectString (GotRemoteFile schemaUrl >> wrap) } |> Extra.cmd ) GotRemoteFile url result -> case result of Ok content -> - ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.sqlRemote now sourceId url content Nothing) content |> wrap) ) + ( model, SourceId.generator |> Random.generate (\sourceId -> GotFile (SourceInfo.sqlRemote now sourceId url content Nothing) content |> wrap) |> Extra.cmd ) Err err -> - ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), T.send (model.callback ( Nothing, err |> Http.errorToString |> Err )) ) + ( model |> setParsedSource (err |> Http.errorToString |> Err |> Just), ( Nothing, err |> Http.errorToString |> Err ) |> model.callback |> Extra.msg ) GetLocalFile file -> ( init model.source model.callback |> (\m -> { m | selectedLocalFile = Just file }) - , Ports.readLocalFile kind file + , Ports.readLocalFile kind file |> Extra.cmd ) GotFile sourceInfo fileContent -> @@ -171,7 +172,7 @@ update wrap now project msg model = | loadedFile = Just ( sourceInfo |> setId (model.source |> Maybe.mapOrElse .id sourceInfo.id), fileContent ) , parsedSchema = Just (parsingInit fileContent (ParseMsg >> wrap) (BuildSource |> wrap)) } - , T.send (BuildLines |> ParseMsg |> wrap) + , BuildLines |> ParseMsg |> wrap |> Extra.msg ) ParseMsg parseMsg -> @@ -182,13 +183,13 @@ update wrap now project msg model = ( { model | parsedSchema = Just parsed } -- 342 is an arbitrary number to break Elm message batching -- not too often to not increase compute time too much, not too scarce to not freeze the browser - , B.cond ((parsed.cpt |> modBy 342) == 1) (T.sendAfter 1 message) (T.send message) + , B.cond ((parsed.cpt |> modBy 342) == 1) (T.sendAfter 1 message) (T.send message) |> Extra.cmd ) ) ) model.parsedSchema model.loadedFile - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.withDefault ( model, Extra.none ) BuildSource -> model.parsedSchema @@ -202,13 +203,13 @@ update wrap now project msg model = |> Maybe.map (\( parsedSchema, source ) -> ( model |> setParsedSource (source |> Ok |> Just) - , Cmd.batch [ T.send (model.callback ( Just parsedSchema, Ok source )), Track.sqlSourceCreated project parsedSchema source ] + , Extra.cmdL [ T.send (model.callback ( Just parsedSchema, Ok source )), Track.sqlSourceCreated project parsedSchema source ] ) ) - |> Maybe.withDefault ( model, Cmd.none ) + |> Maybe.withDefault ( model, Extra.none ) UiToggle htmlId -> - ( model |> mapParsedSchemaM (mapShow (\s -> B.cond (s == htmlId) "" htmlId)), Cmd.none ) + ( model |> mapParsedSchemaM (mapShow (\s -> B.cond (s == htmlId) "" htmlId)), Extra.none ) parsingUpdate : ParsingMsg -> SqlParsing msg -> ( SqlParsing msg, msg ) diff --git a/frontend/src/Services/Toasts.elm b/frontend/src/Services/Toasts.elm index e42f863b1..587315a62 100644 --- a/frontend/src/Services/Toasts.elm +++ b/frontend/src/Services/Toasts.elm @@ -4,10 +4,10 @@ import Components.Atoms.Icon exposing (Icon(..)) import Components.Molecules.Toast as Toast exposing (Content(..)) import Html exposing (Html, div) import Html.Attributes exposing (class) -import Libs.Maybe as Maybe import Libs.Models exposing (Millis) import Libs.Tailwind as Tw import Libs.Task as T +import PagesComponents.Organization_.Project_.Updates.Extra as Extra exposing (Extra) import Services.Lenses exposing (mapIndex, mapList, mapToasts, setIsOpen) @@ -77,20 +77,20 @@ error message = ToastAdd Nothing (Simple { color = Tw.red, icon = Exclamation, title = message, message = "" }) -update : (Msg -> msg) -> Msg -> Model -> ( Model, Cmd msg ) +update : (Msg -> msg) -> Msg -> Model -> ( Model, Extra msg ) update wrap msg model = case msg of ToastAdd millis toast -> - model.index |> String.fromInt |> (\key -> ( model |> mapIndex (\i -> i + 1) |> mapToasts (\t -> { key = key, content = toast, isOpen = False } :: t), T.sendAfter 1 (key |> ToastShow millis |> wrap) )) + model.index |> String.fromInt |> (\key -> ( model |> mapIndex (\i -> i + 1) |> mapToasts (\t -> { key = key, content = toast, isOpen = False } :: t), key |> ToastShow millis |> wrap |> T.sendAfter 1 |> Extra.cmd )) ToastShow millis key -> - ( model |> mapToasts (mapList .key key (setIsOpen True)), millis |> Maybe.mapOrElse (\delay -> T.sendAfter delay (key |> ToastHide |> wrap)) Cmd.none ) + ( model |> mapToasts (mapList .key key (setIsOpen True)), millis |> Maybe.map (\delay -> key |> ToastHide |> wrap |> T.sendAfter delay) |> Extra.cmdM ) ToastHide key -> - ( model |> mapToasts (mapList .key key (setIsOpen False)), key |> ToastRemove |> wrap |> T.sendAfter 300 ) + ( model |> mapToasts (mapList .key key (setIsOpen False)), key |> ToastRemove |> wrap |> T.sendAfter 300 |> Extra.cmd ) ToastRemove key -> - ( model |> mapToasts (List.filter (\t -> t.key /= key)), Cmd.none ) + ( model |> mapToasts (List.filter (\t -> t.key /= key)), Extra.none ) view : (Msg -> msg) -> Model -> Html msg diff --git a/frontend/tests/Libs/ListTest.elm b/frontend/tests/Libs/ListTest.elm index 035d09cdb..63a07915e 100644 --- a/frontend/tests/Libs/ListTest.elm +++ b/frontend/tests/Libs/ListTest.elm @@ -15,13 +15,13 @@ suite = , test "get nothing on negative index" (\_ -> [ "a", "b", "c" ] |> List.get -1 |> Expect.equal Nothing) , test "get nothing on out of array index" (\_ -> [ "a", "b", "c" ] |> List.get 4 |> Expect.equal Nothing) ] - , describe "addAt" - [ test "first" (\_ -> [ "b", "c" ] |> List.addAt "a" 0 |> Expect.equal [ "a", "b", "c" ]) - , test "middle" (\_ -> [ "a", "c" ] |> List.addAt "b" 1 |> Expect.equal [ "a", "b", "c" ]) - , test "last" (\_ -> [ "a", "b" ] |> List.addAt "c" 2 |> Expect.equal [ "a", "b", "c" ]) - , test "after" (\_ -> [ "a", "b" ] |> List.addAt "c" 5 |> Expect.equal [ "a", "b", "c" ]) - , test "bad 1" (\_ -> [ "a", "b" ] |> List.addAt "c" -1 |> Expect.equal [ "c", "a", "b" ]) - , test "bad 2" (\_ -> [ "a", "b" ] |> List.addAt "c" -2 |> Expect.equal [ "c", "a", "b" ]) + , describe "insertAt" + [ test "first" (\_ -> [ "b", "c" ] |> List.insertAt 0 "a" |> Expect.equal [ "a", "b", "c" ]) + , test "middle" (\_ -> [ "a", "c" ] |> List.insertAt 1 "b" |> Expect.equal [ "a", "b", "c" ]) + , test "last" (\_ -> [ "a", "b" ] |> List.insertAt 2 "c" |> Expect.equal [ "a", "b", "c" ]) + , test "after" (\_ -> [ "a", "b" ] |> List.insertAt 5 "c" |> Expect.equal [ "a", "b", "c" ]) + , test "bad 1" (\_ -> [ "a", "b" ] |> List.insertAt -1 "c" |> Expect.equal [ "c", "a", "b" ]) + , test "bad 2" (\_ -> [ "a", "b" ] |> List.insertAt -2 "c" |> Expect.equal [ "c", "a", "b" ]) ] , describe "move" [ test "move an item from a position to an other" (\_ -> [ 1, 2, 3, 4, 5 ] |> List.moveIndex 0 2 |> Expect.equal [ 2, 3, 1, 4, 5 ]) diff --git a/frontend/tests/PagesComponents/Organization_/Project_/Models/ErdColumnPropsTest.elm b/frontend/tests/PagesComponents/Organization_/Project_/Models/ErdColumnPropsTest.elm index 4885a5b06..73455f396 100644 --- a/frontend/tests/PagesComponents/Organization_/Project_/Models/ErdColumnPropsTest.elm +++ b/frontend/tests/PagesComponents/Organization_/Project_/Models/ErdColumnPropsTest.elm @@ -1,6 +1,7 @@ module PagesComponents.Organization_.Project_.Models.ErdColumnPropsTest exposing (..) import Expect +import Models.Project.ColumnPath as ColumnPath exposing (ColumnPath) import PagesComponents.Organization_.Project_.Models.ErdColumnProps as ErdColumnProps exposing (ErdColumnProps, ErdColumnPropsNested(..)) import Test exposing (Test, describe, test) @@ -9,6 +10,32 @@ suite : Test suite = describe "PagesComponents.Organization_.Project_.Models.ErdColumnProps" [ test "flat and nest" (\_ -> props |> ErdColumnProps.flatten |> ErdColumnProps.nest |> Expect.equal props) + , describe "removeWithIndex" + [ test "not found" + (\_ -> + [ prop "id" [], prop "name" [] ] + |> ErdColumnProps.removeWithIndex (path "slug") + |> Expect.equal ( [ prop "id" [], prop "name" [] ], Nothing ) + ) + , test "found at root" + (\_ -> + [ prop "id" [], prop "name" [] ] + |> ErdColumnProps.removeWithIndex (path "name") + |> Expect.equal ( [ prop "id" [] ], Just 1 ) + ) + , test "found nested" + (\_ -> + [ prop "id" [], prop "name" [ prop "first" [], prop "last" [] ] ] + |> ErdColumnProps.removeWithIndex (path "name.first") + |> Expect.equal ( [ prop "id" [], prop "name" [ prop "last" [] ] ], Just 0 ) + ) + , test "not found nested" + (\_ -> + [ prop "id" [], prop "name" [ prop "first" [], prop "last" [] ] ] + |> ErdColumnProps.removeWithIndex (path "name.middle") + |> Expect.equal ( [ prop "id" [], prop "name" [ prop "first" [], prop "last" [] ] ], Nothing ) + ) + ] ] @@ -23,3 +50,16 @@ buildProps name children highlighted = , children = ErdColumnPropsNested children , highlighted = highlighted } + + +prop : String -> List ErdColumnProps -> ErdColumnProps +prop name children = + { name = name + , children = ErdColumnPropsNested children + , highlighted = False + } + + +path : String -> ColumnPath +path value = + value |> String.replace "." ColumnPath.separator |> ColumnPath.fromString diff --git a/frontend/tests/PagesComponents/Organization_/Project_/Updates/CanvasTest.elm b/frontend/tests/PagesComponents/Organization_/Project_/Updates/CanvasTest.elm index ca9197be1..a75576cce 100644 --- a/frontend/tests/PagesComponents/Organization_/Project_/Updates/CanvasTest.elm +++ b/frontend/tests/PagesComponents/Organization_/Project_/Updates/CanvasTest.elm @@ -21,10 +21,10 @@ suite : Test suite = describe "PagesComponents.Organization_.Project_.Updates.Canvas" [ describe "performZoom" - [ test "basic" (\_ -> CanvasProps (canvasPos 0 0) 1 |> performZoom erdElem 0.5 (viewportPos 50 50) |> Expect.equal (CanvasProps (canvasPos -25 -25) 1.5)) - , test "basic round trip" (\_ -> CanvasProps (canvasPos 0 0) 1 |> performZoom erdElem 0.5 (viewportPos 50 50) |> performZoom erdElem -0.5 (viewportPos 50 50) |> Expect.equal (CanvasProps (canvasPos 0 0) 1)) - , test "complex" (\_ -> CanvasProps (canvasPos 50 20) 0.5 |> performZoom erdElem 0.1 (viewportPos 200 300) |> Expect.equal (CanvasProps (canvasPos 20 -36) 0.6)) - , fuzz (Fuzz.pair positionViewport canvasProps) "no change" (\( pos, props ) -> props |> performZoom erdElem 0 pos |> Expect.equal (props |> mapPosition Position.roundDiagram)) + [ test "basic" (\_ -> CanvasProps (canvasPos 0 0) 1 |> performZoom erdElem 0.5 (viewportPos 50 50) |> Tuple.first |> Expect.equal (CanvasProps (canvasPos -25 -25) 1.5)) + , test "basic round trip" (\_ -> CanvasProps (canvasPos 0 0) 1 |> performZoom erdElem 0.5 (viewportPos 50 50) |> Tuple.first |> performZoom erdElem -0.5 (viewportPos 50 50) |> Tuple.first |> Expect.equal (CanvasProps (canvasPos 0 0) 1)) + , test "complex" (\_ -> CanvasProps (canvasPos 50 20) 0.5 |> performZoom erdElem 0.1 (viewportPos 200 300) |> Tuple.first |> Expect.equal (CanvasProps (canvasPos 20 -36) 0.6)) + , fuzz (Fuzz.pair positionViewport canvasProps) "no change" (\( pos, props ) -> props |> performZoom erdElem 0 pos |> Tuple.first |> Expect.equal (props |> mapPosition Position.roundDiagram)) --, fuzz (tuple3 ( float, positionViewport, canvasProps )) "round trip" (\( delta, pos, props ) -> props |> performZoom erdElem delta pos |> performZoom erdElem -delta pos |> Expect.equal (props |> mapPosition Position.roundCanvas)) ] diff --git a/frontend/tests/PagesComponents/Organization_/Project_/Views/ErdTest.elm b/frontend/tests/PagesComponents/Organization_/Project_/Views/ErdTest.elm index a9c302592..f3c9fd3d0 100644 --- a/frontend/tests/PagesComponents/Organization_/Project_/Views/ErdTest.elm +++ b/frontend/tests/PagesComponents/Organization_/Project_/Views/ErdTest.elm @@ -22,9 +22,9 @@ suite = ) , test "test 2" (\_ -> - Erd.argsToString (Time.millisToPosix 12) Platform.Mac CursorMode.Select "c" "d" "e" (Just ( "public", "users" )) (Just ( 1, Just (ColumnPath.fromString "name") )) (Just { index = 1, content = "f" }) + Erd.argsToString (Time.millisToPosix 12) Platform.Mac CursorMode.Select "c" "d" "e" (Just ( ( "public", "users" ), ColumnPath.fromString "id" |> Just )) (Just ( 1, Just (ColumnPath.fromString "name") )) (Just { index = 1, content = "f" }) |> Erd.stringToArgs - |> Expect.equal ( ( Time.millisToPosix 12, Platform.Mac, CursorMode.Select ), ( "c", "d", "e" ), ( Just ( "public", "users" ), Just ( 1, Just (ColumnPath.fromString "name") ), Just { index = 1, content = "f" } ) ) + |> Expect.equal ( ( Time.millisToPosix 12, Platform.Mac, CursorMode.Select ), ( "c", "d", "e" ), ( Just ( ( "public", "users" ), ColumnPath.fromString "id" |> Just ), Just ( 1, Just (ColumnPath.fromString "name") ), Just { index = 1, content = "f" } ) ) ) ] ] diff --git a/frontend/tests/PagesComponents/Organization_/Project_/Views/Navbar/TitleTest.elm b/frontend/tests/PagesComponents/Organization_/Project_/Views/Navbar/TitleTest.elm index 5e5100f8a..04f97d587 100644 --- a/frontend/tests/PagesComponents/Organization_/Project_/Views/Navbar/TitleTest.elm +++ b/frontend/tests/PagesComponents/Organization_/Project_/Views/Navbar/TitleTest.elm @@ -11,30 +11,53 @@ import Test exposing (Test, describe, test) suite : Test suite = describe "PagesComponents.Organization_.Project_.Views.Navbar.Title" - [ test "buildFolders" - (\_ -> - [ "c/1", " a / 2 ", "a", "b", "a/1", "d/1", "d/2", "d/3/a", "d/3/b" ] - |> List.map (\name -> ( name, layout )) - |> Dict.fromList - |> buildFolders - |> Expect.equal - [ LayoutFolder "a" - [ LayoutItem "" ( "a", layout ) - , LayoutItem "1" ( "a/1", layout ) - , LayoutItem "2" ( " a / 2 ", layout ) + [ describe "buildFolders" + [ test "simple list" + (\_ -> + ([ "a", "b", "c" ] |> List.map (\name -> ( name, layout )) |> Dict.fromList |> buildFolders) + |> Expect.equal + [ LayoutItem "a" ( "a", layout ) + , LayoutItem "b" ( "b", layout ) + , LayoutItem "c" ( "c", layout ) ] - , LayoutItem "b" ( "b", layout ) - , LayoutItem "c/1" ( "c/1", layout ) - , LayoutFolder "d" - [ LayoutItem "1" ( "d/1", layout ) - , LayoutItem "2" ( "d/2", layout ) - , LayoutFolder "3" - [ LayoutItem "a" ( "d/3/a", layout ) - , LayoutItem "b" ( "d/3/b", layout ) + ) + , test "nested folders" + (\_ -> + ([ "a/1", "a / 2", "a/3/a", "a/3/b" ] |> List.map (\name -> ( name, layout )) |> Dict.fromList |> buildFolders) + |> Expect.equal + [ LayoutFolder "a" + [ LayoutItem "1" ( "a/1", layout ) + , LayoutItem "2" ( "a / 2", layout ) + , LayoutFolder "3" + [ LayoutItem "a" ( "a/3/a", layout ) + , LayoutItem "b" ( "a/3/b", layout ) + ] ] ] - ] - ) + ) + , test "folder layout" + (\_ -> + ([ "a", "a/1", "a / 2" ] |> List.map (\name -> ( name, layout )) |> Dict.fromList |> buildFolders) + |> Expect.equal + [ LayoutFolder "a" + [ LayoutItem "" ( "a", layout ) + , LayoutItem "1" ( "a/1", layout ) + , LayoutItem "2" ( "a / 2", layout ) + ] + ] + ) + , test "flattened folders" + (\_ -> + ([ "a/1/a", "b/1/a", "b/1/b" ] |> List.map (\name -> ( name, layout )) |> Dict.fromList |> buildFolders) + |> Expect.equal + [ LayoutItem "a / 1 / a" ( "a/1/a", layout ) + , LayoutFolder "b / 1" + [ LayoutItem "a" ( "b/1/a", layout ) + , LayoutItem "b" ( "b/1/b", layout ) + ] + ] + ) + ] ]