Introduce layout links

frontend/src/Components/Molecules/Modal.elm

@@ -5,11 +5,12 @@ import Components.Atoms.Icon as Icon exposing (Icon(..))
 import ElmBook exposing (Msg)
 import ElmBook.Actions as Actions
 import ElmBook.Chapter as Chapter exposing (Chapter)
-import Html exposing (Html, div, h3, input, p, span, text, textarea)
-import Html.Attributes exposing (autofocus, class, cols, id, name, placeholder, rows, type_, value)
+import Html exposing (Html, div, h3, input, option, p, select, span, text, textarea)
+import Html.Attributes exposing (autofocus, class, cols, id, name, placeholder, rows, selected, type_, value)
 import Html.Events exposing (onClick, onInput)
 import Libs.Bool as B
 import Libs.Html.Attributes exposing (ariaHidden, ariaLabelledby, ariaModal, css, role)
+import Libs.List as List
 import Libs.Maybe as Maybe
 import Libs.Models.HtmlId exposing (HtmlId)
 import Libs.Tailwind as Tw exposing (Color, TwClass, batch, bg_100, focus, sm, text_600)
@@ -69,6 +70,7 @@ type alias PromptModel msg =
     , placeholder : String
     , value : String
     , multiline : Bool
+    , choices : List String
     , onUpdate : String -> msg
     , confirm : String
     , cancel : String
@@ -110,7 +112,11 @@ prompt model isOpen =
                     [ p [ class "text-sm text-gray-500" ] [ model.message ]
                     ]
                 , div [ class "mt-1" ]
-                    [ if model.multiline then
+                    [ if List.nonEmpty model.choices then
+                        select [ name fieldId, id fieldId, onInput model.onUpdate, placeholder model.placeholder, autofocus True, class "col-start-1 row-start-1 w-full appearance-none rounded-md bg-white py-1.5 pl-3 pr-8 text-base text-gray-900 outline outline-1 -outline-offset-1 outline-gray-300 focus:outline focus:outline-2 focus:-outline-offset-2 focus:outline-indigo-600 sm:text-sm/6" ]
+                            (model.choices |> List.map (\c -> option [ selected (c == model.value) ] [ text c ]))
+
+                      else if model.multiline then
                         let
                             lines : List String
                             lines =
@@ -242,6 +248,7 @@ doc =
                             , placeholder = ""
                             , value = state.input
                             , multiline = False
+                            , choices = []
                             , onUpdate = setInput
                             , confirm = "Ok"
                             , cancel = "Cancel"

frontend/src/Components/Slices/LlmKey.elm

@@ -25,6 +25,7 @@ promptLlmKey openPrompt updateLlmKey =
                 ]
         , placeholder = ""
         , multiline = False
+        , choices = []
         , confirm = "Save"
         , cancel = "Cancel"
         , onConfirm = updateLlmKey >> T.send

frontend/src/Libs/Tailwind.elm

@@ -1,4 +1,4 @@
-module Libs.Tailwind exposing (Color, ColorLevel, TwClass, active, all, amber, batch, bg_100, bg_200, bg_300, bg_400, bg_50, bg_500, bg_600, bg_700, bg_800, bg_900, black, blue, border_300, border_400, border_500, border_800, cyan, decodeColor, default, disabled, emerald, encodeColor, extractColor, fill_500, focus, focusWithin, focus_ring_500, focus_ring_offset_600, focus_ring_within_600, from, fuchsia, gray, green, groupHover, hover, indigo, levels, lg, lime, list, md, orange, pink, placeholder_100, primary, purple, red, ring_200, ring_300, ring_500, ring_600, ring_offset_600, ring_offset_900, rose, selectable, sky, sm, stroke_500, teal, text_100, text_200, text_300, text_400, text_500, text_600, text_700, text_800, toString, violet, white, xl, xxl, yellow)
+module Libs.Tailwind exposing (Color, ColorLevel, TwClass, active, all, amber, batch, bg_100, bg_200, bg_300, bg_400, bg_50, bg_500, bg_600, bg_700, bg_800, bg_900, black, blue, border_300, border_400, border_500, border_600, border_700, border_800, cyan, decodeColor, default, disabled, emerald, encodeColor, extractColor, fill_500, focus, focusWithin, focus_ring_500, focus_ring_offset_600, focus_ring_within_600, from, from_300, from_600, fuchsia, gray, green, groupHover, hover, indigo, levels, lg, lime, list, md, orange, pink, placeholder_100, primary, purple, red, ring_200, ring_300, ring_500, ring_600, ring_700, ring_offset_600, ring_offset_900, rose, selectable, sky, sm, stroke_500, teal, text_100, text_200, text_300, text_400, text_500, text_600, text_700, text_800, toString, to_200, to_500, violet, white, xl, xxl, yellow)
 
 import Json.Decode as Decode
 import Json.Encode as Encode exposing (Value)
@@ -171,6 +171,16 @@ border_500 (Color color) =
     "border-" ++ color ++ "-500"
 
 
+border_600 : Color -> TwClass
+border_600 (Color color) =
+    "border-" ++ color ++ "-600"
+
+
+border_700 : Color -> TwClass
+border_700 (Color color) =
+    "border-" ++ color ++ "-700"
+
+
 border_800 : Color -> TwClass
 border_800 (Color color) =
     "border-" ++ color ++ "-800"
@@ -201,6 +211,11 @@ ring_600 (Color color) =
     "ring-" ++ color ++ "-600"
 
 
+ring_700 : Color -> TwClass
+ring_700 (Color color) =
+    "ring-" ++ color ++ "-700"
+
+
 ring_offset_600 : Color -> TwClass
 ring_offset_600 (Color color) =
     "ring-offset-" ++ color ++ "-600"
@@ -256,6 +271,26 @@ text_800 (Color color) =
     "text-" ++ color ++ "-800"
 
 
+from_300 : Color -> TwClass
+from_300 (Color color) =
+    "from-" ++ color ++ "-300"
+
+
+from_600 : Color -> TwClass
+from_600 (Color color) =
+    "from-" ++ color ++ "-600"
+
+
+to_200 : Color -> TwClass
+to_200 (Color color) =
+    "to-" ++ color ++ "-200"
+
+
+to_500 : Color -> TwClass
+to_500 (Color color) =
+    "to-" ++ color ++ "-500"
+
+
 placeholder_100 : Color -> TwClass
 placeholder_100 (Color color) =
     "placeholder-" ++ color ++ "-100"

frontend/src/Models/Project/Layout.elm

@@ -10,6 +10,7 @@ import Models.Project.Group as Group exposing (Group)
 import Models.Project.TableName exposing (TableName)
 import Models.Project.TableProps as TableProps exposing (TableProps)
 import Models.Project.TableRow as TableRow exposing (TableRow)
+import PagesComponents.Organization_.Project_.Models.LinkLayout as LinkLayout exposing (LinkLayout)
 import PagesComponents.Organization_.Project_.Models.Memo as Memo exposing (Memo)
 import Time
 
@@ -19,14 +20,15 @@ type alias Layout =
     , tableRows : List TableRow
     , groups : List Group
     , memos : List Memo
+    , links : List LinkLayout
     , createdAt : Time.Posix
     , updatedAt : Time.Posix
     }
 
 
 empty : Time.Posix -> Layout
 empty now =
-    { tables = [], tableRows = [], groups = [], memos = [], createdAt = now, updatedAt = now }
+    { tables = [], tableRows = [], groups = [], memos = [], links = [], createdAt = now, updatedAt = now }
 
 
 encode : Layout -> Value
@@ -36,25 +38,27 @@ encode value =
         , ( "tableRows", value.tableRows |> Encode.withDefault (Encode.list TableRow.encode) [] )
         , ( "groups", value.groups |> Encode.withDefault (Encode.list Group.encode) [] )
         , ( "memos", value.memos |> Encode.withDefault (Encode.list Memo.encode) [] )
+        , ( "links", value.links |> Encode.withDefault (Encode.list LinkLayout.encode) [] )
         , ( "createdAt", value.createdAt |> Time.encode )
         , ( "updatedAt", value.updatedAt |> Time.encode )
         ]
 
 
 decode : Decode.Decoder Layout
 decode =
-    Decode.map6 Layout
+    Decode.map7 Layout
         (Decode.field "tables" (Decode.list TableProps.decode))
         (Decode.defaultField "tableRows" (Decode.list TableRow.decode) [])
         (Decode.defaultField "groups" (Decode.list Group.decode) [])
         (Decode.defaultField "memos" (Decode.list Memo.decode) [])
+        (Decode.defaultField "links" (Decode.list LinkLayout.decode) [])
         (Decode.field "createdAt" Time.decode)
         (Decode.field "updatedAt" Time.decode)
 
 
 docLayout : Layout
 docLayout =
-    { tables = [], tableRows = [], groups = [], memos = [], createdAt = Time.zero, updatedAt = Time.zero }
+    { tables = [], tableRows = [], groups = [], memos = [], links = [], createdAt = Time.zero, updatedAt = Time.zero }
 
 
 doc : List ( TableName, List ColumnName ) -> Layout

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

@@ -1,4 +1,4 @@
-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)
+module PagesComponents.Organization_.Project_.Models exposing (AmlSidebar, AmlSidebarMsg(..), ConfirmDialog, ContextMenu, FindPathMsg(..), GroupEdit, GroupMsg(..), HelpDialog, HelpMsg(..), LayoutMsg(..), LinkMsg(..), MemoEdit, MemoMsg(..), ModalDialog, Model, Msg(..), NavbarModel, NotesDialog, ProjectSettingsDialog, ProjectSettingsMsg(..), PromptDialog, SchemaAnalysisDialog, SchemaAnalysisMsg(..), SearchModel, VirtualRelation, VirtualRelationMsg(..), confirm, confirmDanger, emptyModel, prompt, promptSelect, simplePrompt, simplePromptSelect)
 
 import Components.Atoms.Icon exposing (Icon(..))
 import Components.Organisms.Table exposing (TableHover)
@@ -64,6 +64,8 @@ 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.LinkLayout exposing (LinkLayout)
+import PagesComponents.Organization_.Project_.Models.LinkLayoutId exposing (LinkLayoutId)
 import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo)
 import PagesComponents.Organization_.Project_.Models.MemoId exposing (MemoId)
 import PagesComponents.Organization_.Project_.Models.NotesMsg exposing (NotesMsg)
@@ -268,6 +270,7 @@ type Msg
     | TablePosition TableId Position.Grid
     | TableRowPosition TableRow.Id Position.Grid
     | MemoPosition MemoId Position.Grid
+    | LinkPosition LinkLayoutId Position.Grid
     | TableOrder TableId Int
     | TableColor TableId Color Bool
     | MoveColumn ColumnRef Int
@@ -290,6 +293,7 @@ type Msg
     | ColorMsg ColorMsg
     | GroupMsg GroupMsg
     | MemoMsg MemoMsg
+    | LinkMsg LinkMsg
     | ShowTableRow RowQuery (Maybe TableRow.SuccessState) (Maybe PositionHint) String
     | DeleteTableRow TableRow.Id
     | UnDeleteTableRow_ Int TableRow
@@ -372,6 +376,14 @@ type MemoMsg
     | MUnDelete Int Memo
 
 
+type LinkMsg
+    = LLCreate Position.Grid LayoutName
+    | LLUpdate LinkLayoutId LayoutName
+    | LLSetColor LinkLayoutId (Maybe Color)
+    | LLDelete LinkLayoutId
+    | LLUnDelete Int LinkLayout
+
+
 type AmlSidebarMsg
     = AOpen (Maybe SourceId)
     | AClose
@@ -472,6 +484,7 @@ prompt title content input message =
         , message = content
         , placeholder = ""
         , multiline = False
+        , choices = []
         , confirm = "Ok"
         , cancel = "Cancel"
         , onConfirm = message >> T.send
@@ -488,8 +501,43 @@ simplePrompt label message =
         , message = text ""
         , placeholder = ""
         , multiline = False
+        , choices = []
         , confirm = "Ok"
         , cancel = "Cancel"
         , onConfirm = message >> T.send
         }
         ""
+
+
+promptSelect : String -> List String -> String -> (String -> Msg) -> Msg
+promptSelect label choices input message =
+    PromptOpen
+        { color = Tw.blue
+        , icon = Just QuestionMarkCircle
+        , title = label
+        , message = text ""
+        , placeholder = ""
+        , multiline = False
+        , choices = choices
+        , confirm = "Ok"
+        , cancel = "Cancel"
+        , onConfirm = message >> T.send
+        }
+        input
+
+
+simplePromptSelect : String -> List String -> (String -> Msg) -> Msg
+simplePromptSelect label choices message =
+    PromptOpen
+        { color = Tw.blue
+        , icon = Just QuestionMarkCircle
+        , title = label
+        , message = text ""
+        , placeholder = ""
+        , multiline = False
+        , choices = choices
+        , confirm = "Ok"
+        , cancel = "Cancel"
+        , onConfirm = message >> T.send
+        }
+        (choices |> List.head |> Maybe.withDefault "")

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

@@ -1,4 +1,4 @@
-module PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout, ErdLayoutItem, create, createMemo, empty, getSelected, isEmpty, mapSelected, nonEmpty, setSelected, unpack)
+module PagesComponents.Organization_.Project_.Models.ErdLayout exposing (ErdLayout, ErdLayoutItem, create, createLink, createMemo, empty, getSelected, isEmpty, mapSelected, nonEmpty, setSelected, unpack)
 
 import Dict exposing (Dict)
 import Libs.Dict as Dict
@@ -8,14 +8,17 @@ 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.LayoutName exposing (LayoutName)
 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.LinkLayout exposing (LinkLayout)
+import PagesComponents.Organization_.Project_.Models.LinkLayoutId as LinkLayoutId exposing (LinkLayoutId)
 import PagesComponents.Organization_.Project_.Models.Memo exposing (Memo)
 import PagesComponents.Organization_.Project_.Models.MemoId as MemoId exposing (MemoId)
-import Services.Lenses as Lenses exposing (mapMemos, mapProps, mapTableRows, mapTables)
+import Services.Lenses as Lenses exposing (mapLinks, mapMemos, mapProps, mapTableRows, mapTables)
 import Set
 import Time
 
@@ -26,6 +29,7 @@ type alias ErdLayout =
     , tableRows : List TableRow
     , groups : List Group
     , memos : List Memo
+    , links : List LinkLayout
     , createdAt : Time.Posix
     , updatedAt : Time.Posix
     }
@@ -42,14 +46,15 @@ empty now =
     , tableRows = []
     , groups = []
     , memos = []
+    , links = []
     , createdAt = now
     , updatedAt = now
     }
 
 
 isEmpty : ErdLayout -> Bool
 isEmpty layout =
-    List.isEmpty layout.tables && List.isEmpty layout.tableRows && List.isEmpty layout.memos
+    List.isEmpty layout.tables && List.isEmpty layout.tableRows && List.isEmpty layout.memos && List.isEmpty layout.links
 
 
 nonEmpty : ErdLayout -> Bool
@@ -64,6 +69,7 @@ create relationsByTable layout =
     , tableRows = layout.tableRows
     , groups = layout.groups
     , memos = layout.memos
+    , links = layout.links
     , createdAt = layout.createdAt
     , updatedAt = layout.updatedAt
     }
@@ -75,6 +81,7 @@ unpack layout =
     , tableRows = layout.tableRows
     , groups = layout.groups
     , memos = layout.memos
+    , links = layout.links
     , createdAt = layout.createdAt
     , updatedAt = layout.updatedAt
     }
@@ -85,6 +92,7 @@ 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))
+        ++ (layout.links |> List.filter .selected |> List.map (.id >> LinkLayoutId.toHtmlId))
 
 
 setSelected : List HtmlId -> ErdLayout -> ErdLayout
@@ -93,6 +101,7 @@ setSelected htmlIds 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))))
+        |> mapLinks (List.map (\l -> l |> Lenses.mapSelected (\_ -> htmlIds |> List.member (LinkLayoutId.toHtmlId l.id))))
 
 
 mapSelected : (ErdLayoutItem -> Bool -> Bool) -> ErdLayout -> ErdLayout
@@ -101,6 +110,7 @@ mapSelected transform 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 })))
+        |> mapLinks (List.map (\l -> l |> Lenses.mapSelected (transform { id = LinkLayoutId.toHtmlId l.id, position = l.position, size = l.size })))
 
 
 createMemo : ErdLayout -> Position.Grid -> Memo
@@ -117,3 +127,19 @@ createMemo layout position =
     , color = Nothing
     , selected = False
     }
+
+
+createLink : ErdLayout -> Position.Grid -> LayoutName -> LinkLayout
+createLink layout position target =
+    let
+        id : LinkLayoutId
+        id =
+            (layout.links |> List.map .id |> List.maximum |> Maybe.withDefault 0) + 1
+    in
+    { id = id
+    , target = target
+    , position = position |> Position.moveGrid { dx = 0, dy = 0 }
+    , size = Size 245 75 |> Size.canvas
+    , color = Nothing
+    , selected = False
+    }