diff --git a/src/Code/Definition/AbilityConstructor.elm b/src/Code/Definition/AbilityConstructor.elm index 4dc4b5a1..80384a6f 100644 --- a/src/Code/Definition/AbilityConstructor.elm +++ b/src/Code/Definition/AbilityConstructor.elm @@ -6,6 +6,7 @@ module Code.Definition.AbilityConstructor exposing , AbilityConstructorSummary , decodeSignature , decodeSource + , rawSource ) import Code.Definition.Info exposing (Info) @@ -13,7 +14,7 @@ import Code.Definition.Term as Term exposing (TermSignature) import Code.Definition.Type as Type exposing (TypeSource) import Code.FullyQualifiedName exposing (FQN) import Code.Hash exposing (Hash) -import Code.Syntax exposing (Syntax) +import Code.Syntax as Syntax exposing (Syntax) import Json.Decode as Decode @@ -44,6 +45,20 @@ type alias AbilityConstructorListing = +-- HELPERS + + +rawSource : AbilityConstructorDetail -> Maybe String +rawSource (AbilityConstructor _ { source }) = + case source of + Type.Source stx -> + Just (Syntax.toString stx) + + Type.Builtin -> + Nothing + + + -- JSON DECODERS diff --git a/src/Code/Definition/DataConstructor.elm b/src/Code/Definition/DataConstructor.elm index 786d998d..77f12c72 100644 --- a/src/Code/Definition/DataConstructor.elm +++ b/src/Code/Definition/DataConstructor.elm @@ -6,6 +6,7 @@ module Code.Definition.DataConstructor exposing , DataConstructorSummary , decodeSignature , decodeSource + , rawSource ) import Code.Definition.Info exposing (Info) @@ -13,7 +14,7 @@ import Code.Definition.Term as Term exposing (TermSignature) import Code.Definition.Type as Type exposing (TypeSource) import Code.FullyQualifiedName exposing (FQN) import Code.Hash exposing (Hash) -import Code.Syntax exposing (Syntax) +import Code.Syntax as Syntax exposing (Syntax) import Json.Decode as Decode @@ -44,6 +45,20 @@ type alias DataConstructorListing = +-- HELPERS + + +rawSource : DataConstructorDetail -> Maybe String +rawSource (DataConstructor _ { source }) = + case source of + Type.Source stx -> + Just (Syntax.toString stx) + + Type.Builtin -> + Nothing + + + -- JSON DECODERS diff --git a/src/Code/Definition/Term.elm b/src/Code/Definition/Term.elm index e282a9a7..ebb6735d 100644 --- a/src/Code/Definition/Term.elm +++ b/src/Code/Definition/Term.elm @@ -11,6 +11,7 @@ module Code.Definition.Term exposing , decodeTermSource , isBuiltin , isBuiltinSource + , rawSource , termSignature , termSignatureSyntax ) @@ -67,6 +68,16 @@ type alias TermListing = -- HELPERS +rawSource : TermDetail d -> Maybe String +rawSource (Term _ _ d) = + case d.source of + Source _ stx -> + Just (Syntax.toString stx) + + Builtin _ -> + Nothing + + isBuiltin : TermDetail d -> Bool isBuiltin (Term _ _ d) = isBuiltinSource d.source diff --git a/src/Code/Definition/Type.elm b/src/Code/Definition/Type.elm index fd486dc4..dc210a9d 100644 --- a/src/Code/Definition/Type.elm +++ b/src/Code/Definition/Type.elm @@ -9,6 +9,7 @@ module Code.Definition.Type exposing , decodeTypeSource , isBuiltin , isBuiltinSource + , rawSource , typeSourceSyntax ) @@ -59,6 +60,16 @@ type alias TypeListing = -- HELPERS +rawSource : TypeDetail d -> Maybe String +rawSource (Type _ _ d) = + case d.source of + Source stx -> + Just (Syntax.toString stx) + + Builtin -> + Nothing + + isBuiltin : TypeDetail d -> Bool isBuiltin (Type _ _ d) = isBuiltinSource d.source diff --git a/src/Code/Syntax.elm b/src/Code/Syntax.elm index 3e94d279..d7d579a7 100644 --- a/src/Code/Syntax.elm +++ b/src/Code/Syntax.elm @@ -7,6 +7,7 @@ module Code.Syntax exposing , fromList , numLines , reference + , toString , view ) @@ -99,6 +100,14 @@ foldl f init (Syntax segments) = NEL.foldl f init segments +toString : Syntax -> String +toString (Syntax segments) = + segments + |> NEL.map SyntaxSegment.toString + |> NEL.toList + |> String.join "" + + -- VIEW diff --git a/src/Code/Syntax/SyntaxSegment.elm b/src/Code/Syntax/SyntaxSegment.elm index 97466003..1d07b2f1 100644 --- a/src/Code/Syntax/SyntaxSegment.elm +++ b/src/Code/Syntax/SyntaxSegment.elm @@ -73,6 +73,11 @@ type SyntaxType | DocKeyword +toString : SyntaxSegment -> String +toString (SyntaxSegment _ seg) = + seg + + -- VIEW diff --git a/src/Code/Workspace/WorkspaceItem.elm b/src/Code/Workspace/WorkspaceItem.elm index 3c220fd4..f3622de2 100644 --- a/src/Code/Workspace/WorkspaceItem.elm +++ b/src/Code/Workspace/WorkspaceItem.elm @@ -1,8 +1,8 @@ module Code.Workspace.WorkspaceItem exposing (..) -import Code.Definition.AbilityConstructor exposing (AbilityConstructor(..), AbilityConstructorDetail) +import Code.Definition.AbilityConstructor as AbilityConstructor exposing (AbilityConstructor(..), AbilityConstructorDetail) import Code.Definition.Category as Category exposing (Category) -import Code.Definition.DataConstructor exposing (DataConstructor(..), DataConstructorDetail) +import Code.Definition.DataConstructor as DataConstructor exposing (DataConstructor(..), DataConstructorDetail) import Code.Definition.Doc as Doc exposing (Doc, DocFoldToggles) import Code.Definition.Info as Info exposing (Info) import Code.Definition.Reference as Reference exposing (Reference) @@ -28,6 +28,7 @@ import UI import UI.ActionMenu as ActionMenu import UI.Button as Button import UI.Click as Click +import UI.CopyOnClick as CopyOnClick import UI.Divider as Divider import UI.FoldToggle as FoldToggle import UI.Icon as Icon @@ -409,8 +410,8 @@ viewInfoItem content = div [ class "workspace-item_info-item" ] content -viewInfoItems : NamespaceActionMenu -> Reference -> Hash -> Info -> Html Msg -viewInfoItems namespaceActionMenu ref hash_ info = +viewInfoItems : NamespaceActionMenu -> Reference -> Hash -> Maybe String -> Info -> Html Msg +viewInfoItems namespaceActionMenu ref hash_ rawSource info = let namespace = case info.namespace of @@ -452,16 +453,30 @@ viewInfoItems namespaceActionMenu ref hash_ info = hashInfoItem = Hash.view hash_ + + copyCodeToClipboard = + case rawSource of + Just s -> + div [ class "copy-code" ] + [ CopyOnClick.view s + (div [ class "button small subdued content-icon-then-label" ] + [ Icon.view Icon.clipboard, text "Copy full source" ] + ) + (Icon.view Icon.checkmark) + ] + + Nothing -> + UI.nothing in - div [ class "workspace-item_info-items" ] [ hashInfoItem, otherNames, namespace ] + div [ class "workspace-item_info-items" ] [ hashInfoItem, otherNames, namespace, copyCodeToClipboard ] -viewInfo : NamespaceActionMenu -> Reference -> Hash -> Info -> Category -> Html Msg -viewInfo namespaceActionMenu ref hash_ info category = +viewInfo : NamespaceActionMenu -> Reference -> Hash -> Maybe String -> Info -> Category -> Html Msg +viewInfo namespaceActionMenu ref hash_ rawSource info category = div [ class "workspace-item_info" ] [ div [ class "category-icon" ] [ Icon.view (Category.icon category) ] , h3 [ class "name" ] [ FQN.view info.name ] - , viewInfoItems namespaceActionMenu ref hash_ info + , viewInfoItems namespaceActionMenu ref hash_ rawSource info ] @@ -590,42 +605,42 @@ viewItem syntaxConfig namespaceActionMenu ref data isFocused = :: MaybeE.unwrap [] (\i -> [ i ]) (viewBuiltin data.item) ++ viewDoc_ doc - viewInfo_ hash_ info cat = - viewInfo namespaceActionMenu ref hash_ info cat + viewInfo_ hash_ rawSource info cat = + viewInfo namespaceActionMenu ref hash_ rawSource info cat foldRow = Just { zoom = data.zoom, toggle = rowZoomToggle } in case data.item of - TermItem (Term h category detail) -> + TermItem ((Term h category detail) as term) -> viewClosableRow ref attrs - (viewInfo_ h detail.info (Category.Term category)) + (viewInfo_ h (Term.rawSource term) detail.info (Category.Term category)) (viewContent detail.doc) foldRow - TypeItem (Type h category detail) -> + TypeItem ((Type h category detail) as type_) -> viewClosableRow ref attrs - (viewInfo_ h detail.info (Category.Type category)) + (viewInfo_ h (Type.rawSource type_) detail.info (Category.Type category)) (viewContent detail.doc) foldRow - DataConstructorItem (DataConstructor h detail) -> + DataConstructorItem ((DataConstructor h detail) as ctor) -> viewClosableRow ref attrs - (viewInfo_ h detail.info (Category.Type Type.DataType)) + (viewInfo_ h (DataConstructor.rawSource ctor) detail.info (Category.Type Type.DataType)) (viewContent Nothing) foldRow - AbilityConstructorItem (AbilityConstructor h detail) -> + AbilityConstructorItem ((AbilityConstructor h detail) as ctor) -> viewClosableRow ref attrs - (viewInfo_ h detail.info (Category.Type Type.AbilityType)) + (viewInfo_ h (AbilityConstructor.rawSource ctor) detail.info (Category.Type Type.AbilityType)) (viewContent Nothing) foldRow diff --git a/src/UI/CopyField.elm b/src/UI/CopyField.elm index 6e0d36e4..6751a116 100644 --- a/src/UI/CopyField.elm +++ b/src/UI/CopyField.elm @@ -51,20 +51,5 @@ view field = [] ] ] - , copyButton field.onCopy field.toCopy + , CopyOnClick.copyButton_ field.onCopy field.toCopy ] - - - --- HELPERS -------------------------------------------------------------------- - - -{-| We're not using UI.Button here since a click handler is added from -the webcomponent in JS land. --} -copyButton : (String -> msg) -> String -> Html msg -copyButton onCopyMsg toCopy = - CopyOnClick.view onCopyMsg - toCopy - (button [ class "button contained default" ] [ Icon.view Icon.clipboard ]) - (div [ class "copy-field_success" ] [ Icon.view Icon.checkmark ]) diff --git a/src/UI/CopyOnClick.elm b/src/UI/CopyOnClick.elm index 177f2702..80b4e8ab 100644 --- a/src/UI/CopyOnClick.elm +++ b/src/UI/CopyOnClick.elm @@ -1,9 +1,10 @@ module UI.CopyOnClick exposing (..) -import Html exposing (Attribute, Html, div, node) +import Html exposing (Attribute, Html, button, div, node) import Html.Attributes exposing (attribute, class) import Html.Events exposing (on) import Json.Decode as Decode +import UI.Icon as Icon onCopy : (String -> msg) -> Attribute msg @@ -12,8 +13,34 @@ onCopy msg = |> on "copy" -view : (String -> msg) -> String -> Html msg -> Html msg -> Html msg -view onCopyMsg toCopy trigger success = +view : String -> Html msg -> Html msg -> Html msg +view toCopy trigger success = + node "copy-on-click" + [ class "copy-on-click", attribute "text" toCopy ] + [ trigger, div [ class "copy-on-click_success" ] [ success ] ] + + +view_ : (String -> msg) -> String -> Html msg -> Html msg -> Html msg +view_ onCopyMsg toCopy trigger success = node "copy-on-click" [ class "copy-on-click", onCopy onCopyMsg, attribute "text" toCopy ] [ trigger, div [ class "copy-on-click_success" ] [ success ] ] + + +{-| We're not using UI.Button here since a click handler is added from +the webcomponent in JS land. +-} +copyButton : String -> Html msg +copyButton toCopy = + view + toCopy + (button [ class "button contained default" ] [ Icon.view Icon.clipboard ]) + (div [ class "copy-field_success" ] [ Icon.view Icon.checkmark ]) + + +copyButton_ : (String -> msg) -> String -> Html msg +copyButton_ onCopyMsg toCopy = + view_ onCopyMsg + toCopy + (button [ class "button contained default" ] [ Icon.view Icon.clipboard ]) + (div [ class "copy-field_success" ] [ Icon.view Icon.checkmark ]) diff --git a/src/css/code/workspace-item.css b/src/css/code/workspace-item.css index b2a6a446..50434132 100644 --- a/src/css/code/workspace-item.css +++ b/src/css/code/workspace-item.css @@ -132,6 +132,20 @@ opacity: 1; } +.workspace-item .workspace-item_header .copy-code .copy-on-click { + display: flex; + flex-direction: row; + align-items: center; + gap: 0.5rem; +} + +.workspace-item .workspace-item_header .copy-code .copy-on-click .copy-on-click_success { + margin-top: 2px; +} +.workspace-item .workspace-item_header .copy-code .copy-on-click .copy-on-click_success .icon { + color: var(--u-color_positive_icon-on-element_subdued); +} + .workspace-item .workspace-item_content { display: flex; flex-direction: column;