From 3481648079a6d1353e1b32259ec1ea40c9111b13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simon=20H=C3=B8jberg?= Date: Fri, 9 Aug 2024 15:15:21 -0400 Subject: [PATCH] Replace Syntax.Linked with Syntax.SyntaxConfig Expand Linked to support configurable syntax help tooltips with a builder pattern and rename it SyntaxConfig. --- src/Code/Definition/Doc.elm | 23 +++++--- src/Code/Definition/Readme.elm | 4 +- src/Code/Definition/Source.elm | 2 +- src/Code/DefinitionDetailTooltip.elm | 10 ++-- src/Code/DefinitionSummaryTooltip.elm | 10 ++-- src/Code/ReadmeCard.elm | 4 +- src/Code/Source/SourceViewConfig.elm | 24 ++++---- src/Code/Syntax.elm | 8 +-- src/Code/Syntax/Linked.elm | 36 ------------ src/Code/Syntax/SyntaxConfig.elm | 64 ++++++++++++++++++++++ src/Code/Syntax/SyntaxSegment.elm | 79 ++++++++++++++++----------- src/Code/Workspace/WorkspaceItem.elm | 16 +++--- src/css/ui/components/by-at.css | 3 +- 13 files changed, 167 insertions(+), 116 deletions(-) delete mode 100644 src/Code/Syntax/Linked.elm create mode 100644 src/Code/Syntax/SyntaxConfig.elm diff --git a/src/Code/Definition/Doc.elm b/src/Code/Definition/Doc.elm index 5f544c14..8149ad53 100644 --- a/src/Code/Definition/Doc.elm +++ b/src/Code/Definition/Doc.elm @@ -17,7 +17,7 @@ import Code.Definition.Source as Source import Code.Definition.Term exposing (TermSignature(..)) import Code.Source.SourceViewConfig as SourceViewConfig import Code.Syntax as Syntax exposing (Syntax) -import Code.Syntax.Linked exposing (Linked(..), LinkedWithTooltipConfig) +import Code.Syntax.SyntaxConfig exposing (SyntaxConfig) import Dict exposing (Dict) import Html exposing @@ -389,17 +389,14 @@ toString sep doc = "" -view : LinkedWithTooltipConfig msg -> (FoldId -> msg) -> DocFoldToggles -> Doc -> Html msg -view linkedCfg toggleFoldMsg docFoldToggles document = +view : SyntaxConfig msg -> (FoldId -> msg) -> DocFoldToggles -> Doc -> Html msg +view syntaxConfig toggleFoldMsg docFoldToggles document = let viewSignature = - Source.viewTermSignature (SourceViewConfig.rich linkedCfg) - - linked = - LinkedWithTooltip linkedCfg + Source.viewTermSignature (SourceViewConfig.rich syntaxConfig) viewSyntax = - Syntax.view linked + Syntax.view syntaxConfig view_ sectionLevel doc = let @@ -577,7 +574,15 @@ view linkedCfg toggleFoldMsg docFoldToggles document = a [ class "named-link", href h, rel "noopener", target "_blank" ] [ viewAtCurrentSectionLevel label ] ReferenceHref ref -> - Click.view [ class "named-link" ] [ viewAtCurrentSectionLevel label ] (linkedCfg.toClick ref) + case syntaxConfig.toClick of + Just toClick -> + Click.view [ class "named-link" ] + [ viewAtCurrentSectionLevel label ] + (toClick ref) + + _ -> + span [ class "named-link" ] + [ viewAtCurrentSectionLevel label ] InvalidHref -> span [ class "named-link invalid-href" ] [ viewAtCurrentSectionLevel label ] diff --git a/src/Code/Definition/Readme.elm b/src/Code/Definition/Readme.elm index 31997c21..0ff44d33 100644 --- a/src/Code/Definition/Readme.elm +++ b/src/Code/Definition/Readme.elm @@ -1,7 +1,7 @@ module Code.Definition.Readme exposing (..) import Code.Definition.Doc as Doc exposing (Doc, DocFoldToggles, FoldId) -import Code.Syntax.Linked exposing (LinkedWithTooltipConfig) +import Code.Syntax.SyntaxConfig exposing (SyntaxConfig) import Html exposing (Html, div) import Html.Attributes exposing (class) import Json.Decode as Decode @@ -20,7 +20,7 @@ type Readme view : - LinkedWithTooltipConfig msg + SyntaxConfig msg -> (FoldId -> msg) -> DocFoldToggles -> Readme diff --git a/src/Code/Definition/Source.elm b/src/Code/Definition/Source.elm index a2002d9c..d396b840 100644 --- a/src/Code/Definition/Source.elm +++ b/src/Code/Definition/Source.elm @@ -154,4 +154,4 @@ viewCode viewConfig content = viewSyntax : SourceViewConfig msg -> (Syntax.Syntax -> Html msg) viewSyntax viewConfig = - Syntax.view (SourceViewConfig.toSyntaxLinked viewConfig) + Syntax.view (SourceViewConfig.toSyntaxConfig viewConfig) diff --git a/src/Code/DefinitionDetailTooltip.elm b/src/Code/DefinitionDetailTooltip.elm index 4dbd57e4..79bd7095 100644 --- a/src/Code/DefinitionDetailTooltip.elm +++ b/src/Code/DefinitionDetailTooltip.elm @@ -11,7 +11,7 @@ import Code.Definition.Type as Type exposing (Type(..), TypeDetail) import Code.FullyQualifiedName as FQN import Code.Hash as Hash import Code.Source.SourceViewConfig as SourceViewConfig -import Code.Syntax.Linked exposing (Linked(..), TooltipConfig) +import Code.Syntax.SyntaxConfig as SyntaxConfig exposing (TooltipConfig) import Dict exposing (Dict) import Html exposing (div) import Html.Attributes exposing (class) @@ -161,16 +161,16 @@ viewDetail detail = viewDetail_ s = case s of TermHover (Term _ _ { info, source }) -> - Source.viewTermSource (SourceViewConfig.rich_ NotLinked) info.name source + Source.viewTermSource (SourceViewConfig.rich_ SyntaxConfig.empty) info.name source TypeHover (Type _ _ { source }) -> - Source.viewTypeSource (SourceViewConfig.rich_ NotLinked) source + Source.viewTypeSource (SourceViewConfig.rich_ SyntaxConfig.empty) source AbilityConstructorHover (AbilityConstructor _ { source }) -> - Source.viewTypeSource (SourceViewConfig.rich_ NotLinked) source + Source.viewTypeSource (SourceViewConfig.rich_ SyntaxConfig.empty) source DataConstructorHover (DataConstructor _ { source }) -> - Source.viewTypeSource (SourceViewConfig.rich_ NotLinked) source + Source.viewTypeSource (SourceViewConfig.rich_ SyntaxConfig.empty) source loading = Tooltip.rich diff --git a/src/Code/DefinitionSummaryTooltip.elm b/src/Code/DefinitionSummaryTooltip.elm index 15be1de4..a42141f1 100644 --- a/src/Code/DefinitionSummaryTooltip.elm +++ b/src/Code/DefinitionSummaryTooltip.elm @@ -10,7 +10,7 @@ import Code.Definition.Type as Type exposing (Type(..), TypeSummary, typeSourceS import Code.FullyQualifiedName as FQN import Code.Hash as Hash import Code.Syntax as Syntax -import Code.Syntax.Linked exposing (Linked(..), TooltipConfig) +import Code.Syntax.SyntaxConfig as SyntaxConfig exposing (TooltipConfig) import Code.Syntax.SyntaxSegment as SyntaxSegment import Dict exposing (Dict) import Html exposing (div, span, text) @@ -205,19 +205,19 @@ viewSummary summary = viewSummary_ s = case s of TermHover (Term _ _ { signature }) -> - Syntax.view NotLinked (termSignatureSyntax signature) + Syntax.view SyntaxConfig.empty (termSignatureSyntax signature) TypeHover (Type h _ { fqn, source }) -> source |> viewTypeSourceSyntax h fqn - |> Maybe.map (Syntax.view NotLinked) + |> Maybe.map (Syntax.view SyntaxConfig.empty) |> Maybe.withDefault (viewBuiltinType h fqn) AbilityConstructorHover (AbilityConstructor _ { signature }) -> - Syntax.view NotLinked (termSignatureSyntax signature) + Syntax.view SyntaxConfig.empty (termSignatureSyntax signature) DataConstructorHover (DataConstructor _ { signature }) -> - Syntax.view NotLinked (termSignatureSyntax signature) + Syntax.view SyntaxConfig.empty (termSignatureSyntax signature) loading = Tooltip.rich diff --git a/src/Code/ReadmeCard.elm b/src/Code/ReadmeCard.elm index 050c9fd0..af0bf35e 100644 --- a/src/Code/ReadmeCard.elm +++ b/src/Code/ReadmeCard.elm @@ -5,7 +5,7 @@ import Code.Definition.Doc as Doc exposing (DocFoldToggles) import Code.Definition.Readme as Readme exposing (Readme) import Code.Definition.Reference exposing (Reference) import Code.DefinitionSummaryTooltip as DefinitionSummaryTooltip -import Code.Syntax.Linked exposing (linkedWithTooltipConfig) +import Code.Syntax.SyntaxConfig as SyntaxConfig import Html exposing (Html, p) import UI.Button as Button import UI.Card as Card exposing (Card) @@ -71,7 +71,7 @@ asCard : Model -> Readme -> Card Msg asCard model readme = let syntaxConfig = - linkedWithTooltipConfig + SyntaxConfig.default (OpenReference >> Click.onClick) (DefinitionSummaryTooltip.tooltipConfig DefinitionSummaryTooltipMsg diff --git a/src/Code/Source/SourceViewConfig.elm b/src/Code/Source/SourceViewConfig.elm index 797a633c..1306ff3e 100644 --- a/src/Code/Source/SourceViewConfig.elm +++ b/src/Code/Source/SourceViewConfig.elm @@ -5,24 +5,24 @@ module Code.Source.SourceViewConfig exposing , rich , rich_ , toClassName - , toSyntaxLinked + , toSyntaxConfig ) -import Code.Syntax.Linked exposing (Linked(..), LinkedWithTooltipConfig) +import Code.Syntax.SyntaxConfig as SyntaxConfig exposing (SyntaxConfig) type SourceViewConfig msg - = Rich (Linked msg) + = Rich (SyntaxConfig msg) | Monochrome | Plain -rich : LinkedWithTooltipConfig msg -> SourceViewConfig msg -rich linkedWithTooltip = - rich_ (LinkedWithTooltip linkedWithTooltip) +rich : SyntaxConfig msg -> SourceViewConfig msg +rich syntaxConfig = + rich_ syntaxConfig -rich_ : Linked msg -> SourceViewConfig msg +rich_ : SyntaxConfig msg -> SourceViewConfig msg rich_ = Rich @@ -54,11 +54,11 @@ toClassName viewConfig = "plain" -toSyntaxLinked : SourceViewConfig msg -> Linked msg -toSyntaxLinked viewConfig = +toSyntaxConfig : SourceViewConfig msg -> SyntaxConfig msg +toSyntaxConfig viewConfig = case viewConfig of - Rich linked -> - linked + Rich syntaxConfig -> + syntaxConfig _ -> - NotLinked + SyntaxConfig.empty diff --git a/src/Code/Syntax.elm b/src/Code/Syntax.elm index 6b361840..3e94d279 100644 --- a/src/Code/Syntax.elm +++ b/src/Code/Syntax.elm @@ -12,7 +12,7 @@ module Code.Syntax exposing import Code.Definition.Reference as Reference exposing (Reference) import Code.HashQualified as HQ -import Code.Syntax.Linked exposing (Linked) +import Code.Syntax.SyntaxConfig exposing (SyntaxConfig) import Code.Syntax.SyntaxSegment as SyntaxSegment exposing (..) import Html exposing (Html, span) import Html.Attributes exposing (class) @@ -103,12 +103,12 @@ foldl f init (Syntax segments) = -- VIEW -view : Linked msg -> Syntax -> Html msg -view linked (Syntax segments) = +view : SyntaxConfig msg -> Syntax -> Html msg +view syntaxConfig (Syntax segments) = let renderedSegments = segments - |> NEL.map (SyntaxSegment.view linked) + |> NEL.map (SyntaxSegment.view syntaxConfig) |> NEL.toList in span [ class "syntax" ] renderedSegments diff --git a/src/Code/Syntax/Linked.elm b/src/Code/Syntax/Linked.elm deleted file mode 100644 index 121e312f..00000000 --- a/src/Code/Syntax/Linked.elm +++ /dev/null @@ -1,36 +0,0 @@ -module Code.Syntax.Linked exposing (..) - -import Code.Definition.Reference exposing (Reference) -import UI.Click exposing (Click) -import UI.Tooltip exposing (Tooltip) - - -type alias TooltipConfig msg = - { toHoverStart : Reference -> msg - , toHoverEnd : Reference -> msg - , toTooltip : Reference -> Maybe (Tooltip msg) - } - - -type alias ToClick msg = - Reference -> Click msg - - -type alias LinkedWithTooltipConfig msg = - { toClick : ToClick msg - , tooltip : TooltipConfig msg - } - - -type Linked msg - = Linked (ToClick msg) - | LinkedWithTooltip (LinkedWithTooltipConfig msg) - | NotLinked - - -linkedWithTooltipConfig : - ToClick msg - -> TooltipConfig msg - -> LinkedWithTooltipConfig msg -linkedWithTooltipConfig toClick tooltipConfig = - { toClick = toClick, tooltip = tooltipConfig } diff --git a/src/Code/Syntax/SyntaxConfig.elm b/src/Code/Syntax/SyntaxConfig.elm new file mode 100644 index 00000000..be5c4366 --- /dev/null +++ b/src/Code/Syntax/SyntaxConfig.elm @@ -0,0 +1,64 @@ +module Code.Syntax.SyntaxConfig exposing (..) + +import Code.Definition.Reference exposing (Reference) +import UI.Click exposing (Click) +import UI.Tooltip exposing (Tooltip) + + +type alias TooltipConfig msg = + { toHoverStart : Reference -> msg + , toHoverEnd : Reference -> msg + , toTooltip : Reference -> Maybe (Tooltip msg) + } + + +type alias ToClick msg = + Reference -> Click msg + + +type alias SyntaxConfig msg = + { toClick : Maybe (ToClick msg) + , dependencyTooltip : Maybe (TooltipConfig msg) + , showSyntaxHelpTooltip : Bool + } + + + +-- CREATE + + +empty : SyntaxConfig msg +empty = + { toClick = Nothing, dependencyTooltip = Nothing, showSyntaxHelpTooltip = False } + + +default : ToClick msg -> TooltipConfig msg -> SyntaxConfig msg +default toClick tooltipConfig = + empty + |> withToClick toClick + |> withDependencyTooltip tooltipConfig + |> withSyntaxHelp + + + +-- MODIFY + + +withToClick : ToClick msg -> SyntaxConfig msg -> SyntaxConfig msg +withToClick toClick cfg = + { cfg | toClick = Just toClick } + + +withDependencyTooltip : TooltipConfig msg -> SyntaxConfig msg -> SyntaxConfig msg +withDependencyTooltip tooltipConfig cfg = + { cfg | dependencyTooltip = Just tooltipConfig } + + +withSyntaxHelp : SyntaxConfig msg -> SyntaxConfig msg +withSyntaxHelp cfg = + { cfg | showSyntaxHelpTooltip = True } + + +withoutSyntaxHelp : SyntaxConfig msg -> SyntaxConfig msg +withoutSyntaxHelp cfg = + { cfg | showSyntaxHelpTooltip = False } diff --git a/src/Code/Syntax/SyntaxSegment.elm b/src/Code/Syntax/SyntaxSegment.elm index 1cb0d3fd..a22e526b 100644 --- a/src/Code/Syntax/SyntaxSegment.elm +++ b/src/Code/Syntax/SyntaxSegment.elm @@ -4,7 +4,7 @@ import Code.Definition.Reference as Reference import Code.FullyQualifiedName as FQN exposing (FQN) import Code.Hash as Hash exposing (Hash) import Code.HashQualified as HQ -import Code.Syntax.Linked exposing (Linked(..)) +import Code.Syntax.SyntaxConfig exposing (SyntaxConfig) import Code.Syntax.SyntaxSegmentHelp as SyntaxSegmentHelp import Html exposing (Html, span, text) import Html.Attributes exposing (class, classList) @@ -192,8 +192,8 @@ viewFQN fqn = |> span [ class "fqn" ] -view : Linked msg -> SyntaxSegment -> Html msg -view linked ((SyntaxSegment sType sText) as segment) = +view : SyntaxConfig msg -> SyntaxSegment -> Html msg +view syntaxConfig ((SyntaxSegment sType sText) as segment) = let ref = case sType of @@ -284,42 +284,59 @@ view linked ((SyntaxSegment sType sText) as segment) = else view_ (text sText) in - case ( linked, ref ) of - ( Linked click, Just r ) -> - content - (\c -> - Click.view - [ class className ] - [ c ] - (click r) - ) + case ref of + Just r -> + let + toAttrsAndContent c = + case syntaxConfig.dependencyTooltip of + Just tooltip -> + let + content_ = + case tooltip.toTooltip r of + Just t -> + Tooltip.view c t - ( LinkedWithTooltip l, Just r ) -> - content - (\c -> + Nothing -> + c + in + ( [ class className + , onMouseEnter (tooltip.toHoverStart r) + , onMouseLeave (tooltip.toHoverEnd r) + ] + , [ content_ ] + ) + + _ -> + ( [ class className ], [ c ] ) + in + case syntaxConfig.toClick of + Just toClick -> let - content_ = - case l.tooltip.toTooltip r of - Just t -> - Tooltip.view c t + f c = + let + ( attrs, content_ ) = + toAttrsAndContent c + in + Click.view attrs content_ (toClick r) + in + content f - Nothing -> - c + Nothing -> + let + f c = + let + ( attrs, content_ ) = + toAttrsAndContent c + in + span attrs content_ in - Click.view - [ class className - , onMouseEnter (l.tooltip.toHoverStart r) - , onMouseLeave (l.tooltip.toHoverEnd r) - ] - [ content_ ] - (l.toClick r) - ) + content f _ -> content (\c -> - case helpForSegment segment of - Just help -> + case ( syntaxConfig.showSyntaxHelpTooltip, helpForSegment segment ) of + ( True, Just help ) -> let tooltip = Tooltip.rich help diff --git a/src/Code/Workspace/WorkspaceItem.elm b/src/Code/Workspace/WorkspaceItem.elm index 7912bbec..3c220fd4 100644 --- a/src/Code/Workspace/WorkspaceItem.elm +++ b/src/Code/Workspace/WorkspaceItem.elm @@ -14,7 +14,7 @@ import Code.FullyQualifiedName as FQN exposing (FQN) import Code.Hash as Hash exposing (Hash) import Code.HashQualified as HQ import Code.Source.SourceViewConfig as SourceViewConfig exposing (SourceViewConfig) -import Code.Syntax.Linked exposing (LinkedWithTooltipConfig, linkedWithTooltipConfig) +import Code.Syntax.SyntaxConfig as SyntaxConfig exposing (SyntaxConfig) import Code.Workspace.Zoom as Zoom exposing (Zoom(..)) import Html exposing (Attribute, Html, div, h3, header, section, span, text) import Html.Attributes exposing (class, classList, id, title) @@ -465,7 +465,7 @@ viewInfo namespaceActionMenu ref hash_ info category = ] -viewDoc : LinkedWithTooltipConfig Msg -> Reference -> DocVisibility -> DocFoldToggles -> Doc -> Html Msg +viewDoc : SyntaxConfig Msg -> Reference -> DocVisibility -> DocFoldToggles -> Doc -> Html Msg viewDoc syntaxConfig ref docVisibility docFoldToggles doc = let ( showFullDoc, shownInFull ) = @@ -554,7 +554,7 @@ viewSource zoom onSourceToggleClick sourceConfig item = |> viewToggableSource (FoldToggle.disabled |> FoldToggle.isClosed isBuiltin_) -viewItem : LinkedWithTooltipConfig Msg -> NamespaceActionMenu -> Reference -> ItemData -> Bool -> Html Msg +viewItem : SyntaxConfig Msg -> NamespaceActionMenu -> Reference -> ItemData -> Bool -> Html Msg viewItem syntaxConfig namespaceActionMenu ref data isFocused = let ( zoomClass, rowZoomToggle, sourceZoomToggle ) = @@ -630,7 +630,7 @@ viewItem syntaxConfig namespaceActionMenu ref data isFocused = foldRow -viewPresentationItem : LinkedWithTooltipConfig Msg -> Reference -> ItemData -> Html Msg +viewPresentationItem : SyntaxConfig Msg -> Reference -> ItemData -> Html Msg viewPresentationItem syntaxConfig ref data = case data.item of TermItem (Term _ category detail) -> @@ -714,8 +714,8 @@ view { definitionSummaryTooltip, namespaceActionMenu } viewMode workspaceItem is Success ref data -> let - linkedWithTooltipConfig_ = - linkedWithTooltipConfig + syntaxConfig = + SyntaxConfig.default (OpenReference ref >> Click.onClick) (DefinitionSummaryTooltip.tooltipConfig DefinitionSummaryTooltipMsg @@ -724,10 +724,10 @@ view { definitionSummaryTooltip, namespaceActionMenu } viewMode workspaceItem is in case viewMode of ViewMode.Regular -> - viewItem linkedWithTooltipConfig_ namespaceActionMenu ref data isFocused + viewItem syntaxConfig namespaceActionMenu ref data isFocused ViewMode.Presentation -> - viewPresentationItem linkedWithTooltipConfig_ ref data + viewPresentationItem syntaxConfig ref data diff --git a/src/css/ui/components/by-at.css b/src/css/ui/components/by-at.css index c82901f2..ade5f056 100644 --- a/src/css/ui/components/by-at.css +++ b/src/css/ui/components/by-at.css @@ -16,7 +16,8 @@ padding-top: 1px; } -a.by-at, a.by-at:visited { +a.by-at, +a.by-at:visited { color: var(--u-color_text_subdued); }