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

@@ -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 ]

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

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)

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

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

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

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

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

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 }