Crop long definition docs

src/Workspace.elm

@@ -68,6 +68,7 @@ type Msg
     = NoOp
     | Find
     | FetchItemFinished Reference (Result Http.Error Item)
+    | IsDocCropped Reference (Result Dom.Error Bool)
     | Keydown KeyboardEvent
     | KeyboardShortcutMsg KeyboardShortcut.Msg
     | WorkspaceItemMsg WorkspaceItem.Msg
@@ -92,22 +93,53 @@ update env msg ({ workspaceItems } as model) =
 
         FetchItemFinished ref itemResult ->
             let
-                workspaceItem =
+                ( workspaceItem, cmd ) =
                     case itemResult of
                         Err e ->
-                            WorkspaceItem.Failure ref e
+                            ( WorkspaceItem.Failure ref e, Cmd.none )
 
                         Ok i ->
-                            WorkspaceItem.fromItem ref i
+                            let
+                                c =
+                                    -- Docs items are always shown in full and never cropped
+                                    if WorkspaceItem.isDocItem i then
+                                        Cmd.none
+
+                                    else
+                                        isDocCropped ref
+                            in
+                            ( WorkspaceItem.fromItem ref i, c )
 
                 nextWorkspaceItems =
                     WorkspaceItems.replace workspaceItems ref workspaceItem
             in
             ( { model | workspaceItems = nextWorkspaceItems }
-            , Cmd.none
+            , cmd
             , openDefinitionsFocusToOutMsg nextWorkspaceItems
             )
 
+        IsDocCropped ref res ->
+            let
+                visibility =
+                    case res of
+                        Ok True ->
+                            WorkspaceItem.Cropped
+
+                        Ok False ->
+                            WorkspaceItem.NotCropped
+
+                        -- If we can't tell, better make it fully visible, than Unknown
+                        Err _ ->
+                            WorkspaceItem.MadeFullyVisible
+
+                updateVisibility d =
+                    { d | docVisibility = visibility }
+            in
+            ( { model | workspaceItems = WorkspaceItems.updateData updateVisibility ref workspaceItems }
+            , Cmd.none
+            , None
+            )
+
         Keydown event ->
             let
                 ( keyboardShortcut, kCmd ) =
@@ -135,38 +167,30 @@ update env msg ({ workspaceItems } as model) =
 
                 WorkspaceItem.UpdateZoom ref zoom ->
                     let
-                        updateMatching workspaceItem =
-                            case workspaceItem of
-                                Success r d ->
-                                    if ref == r then
-                                        Success r { d | zoom = zoom }
-
-                                    else
-                                        workspaceItem
+                        updateZoom d =
+                            { d | zoom = zoom }
+                    in
+                    ( { model | workspaceItems = WorkspaceItems.updateData updateZoom ref workspaceItems }
+                    , Cmd.none
+                    , None
+                    )
 
-                                _ ->
-                                    workspaceItem
+                WorkspaceItem.ShowFullDoc ref ->
+                    let
+                        updateDocVisibility d =
+                            { d | docVisibility = WorkspaceItem.MadeFullyVisible }
                     in
-                    ( { model | workspaceItems = WorkspaceItems.map updateMatching workspaceItems }
+                    ( { model | workspaceItems = WorkspaceItems.updateData updateDocVisibility ref workspaceItems }
                     , Cmd.none
                     , None
                     )
 
                 WorkspaceItem.ToggleDocFold ref docId ->
                     let
-                        updateMatching workspaceItem =
-                            case workspaceItem of
-                                Success r d ->
-                                    if ref == r then
-                                        Success r { d | docFoldToggles = Doc.toggleFold d.docFoldToggles docId }
-
-                                    else
-                                        workspaceItem
-
-                                _ ->
-                                    workspaceItem
+                        updateDocFoldToggles d =
+                            { d | docFoldToggles = Doc.toggleFold d.docFoldToggles docId }
                     in
-                    ( { model | workspaceItems = WorkspaceItems.map updateMatching workspaceItems }
+                    ( { model | workspaceItems = WorkspaceItems.updateData updateDocFoldToggles ref workspaceItems }
                     , Cmd.none
                     , None
                     )
@@ -376,6 +400,17 @@ fetchDefinition perspective ref =
         |> Api.toRequest WorkspaceItem.decodeItem (FetchItemFinished ref)
 
 
+isDocCropped : Reference -> Cmd Msg
+isDocCropped ref =
+    let
+        id =
+            "definition-doc-" ++ Reference.toString ref
+    in
+    Dom.getViewportOf id
+        |> Task.map (\v -> v.viewport.height < v.scene.height)
+        |> Task.attempt (IsDocCropped ref)
+
+
 scrollToDefinition : Reference -> Cmd Msg
 scrollToDefinition ref =
     let

src/Workspace/WorkspaceItem.elm

@@ -22,6 +22,7 @@ import List.Nonempty as NEL
 import Maybe.Extra as MaybeE
 import String.Extra exposing (pluralize)
 import UI
+import UI.Button as Button
 import UI.FoldToggle as FoldToggle
 import UI.Icon as Icon exposing (Icon)
 import UI.Tooltip as Tooltip
@@ -32,12 +33,22 @@ import Workspace.Zoom exposing (Zoom(..))
 type WorkspaceItem
     = Loading Reference
     | Failure Reference Http.Error
-    | Success
-        Reference
-        { item : Item
-        , zoom : Zoom
-        , docFoldToggles : DocFoldToggles
-        }
+    | Success Reference ItemData
+
+
+type DocVisibility
+    = Unknown
+    | Cropped
+    | NotCropped
+    | MadeFullyVisible
+
+
+type alias ItemData =
+    { item : Item
+    , zoom : Zoom
+    , docFoldToggles : DocFoldToggles
+    , docVisibility : DocVisibility
+    }
 
 
 type alias WithDoc =
@@ -70,6 +81,7 @@ type Msg
     | ToggleDocFold Reference Doc.FoldId
     | ChangePerspectiveToNamespace FQN
     | FindWithinNamespace FQN
+    | ShowFullDoc Reference
 
 
 fromItem : Reference -> Item -> WorkspaceItem
@@ -85,11 +97,19 @@ fromItem ref item =
 
             else
                 Near
+
+        docVisibility =
+            if isDocItem item then
+                MadeFullyVisible
+
+            else
+                Unknown
     in
     Success ref
         { item = item
         , zoom = zoom
         , docFoldToggles = Doc.emptyDocFoldToggles
+        , docVisibility = docVisibility
         }
 
 
@@ -269,9 +289,47 @@ viewInfo zoom onClick_ hash info category =
         ]
 
 
-viewDoc : Reference -> DocFoldToggles -> Doc -> Html Msg
-viewDoc ref docFoldToggles doc =
-    div [ class "workspace-item-definition-doc" ] [ Doc.view (OpenReference ref) (ToggleDocFold ref) docFoldToggles doc ]
+viewDoc : Reference -> DocVisibility -> DocFoldToggles -> Doc -> Html Msg
+viewDoc ref docVisibility docFoldToggles doc =
+    let
+        ( showFullDoc, shownInFull ) =
+            case docVisibility of
+                Unknown ->
+                    ( UI.nothing, False )
+
+                Cropped ->
+                    ( div [ class "show-full-doc" ]
+                        [ Button.iconThenLabel (ShowFullDoc ref) Icon.arrowDown "Show full documentation"
+                            |> Button.small
+                            |> Button.view
+                        ]
+                    , False
+                    )
+
+                _ ->
+                    ( UI.nothing, True )
+
+        classes =
+            classList
+                [ ( "workspace-item-definition-doc", True )
+                , ( "shown-in-full", shownInFull )
+                ]
+    in
+    div [ classes ]
+        [ div [ class "definition-doc-columns" ]
+            [ div [ class "icon-column" ] [ Icon.view Icon.doc ]
+            , div
+                [ class "doc-column"
+                , id ("definition-doc-" ++ Reference.toString ref)
+                ]
+                [ Doc.view (OpenReference ref)
+                    (ToggleDocFold ref)
+                    docFoldToggles
+                    doc
+                ]
+            ]
+        , showFullDoc
+        ]
 
 
 {-| TODO: Yikes, this isn't great. Needs cleanup
@@ -326,11 +384,7 @@ viewSource zoom onSourceToggleClick sourceConfig item =
                 |> Tuple.mapBoth viewLineGutter (viewToggableSource (FoldToggle.disabled |> FoldToggle.open))
 
 
-viewItem :
-    Reference
-    -> { item : Item, zoom : Zoom, docFoldToggles : DocFoldToggles }
-    -> Bool
-    -> Html Msg
+viewItem : Reference -> ItemData -> Bool -> Html Msg
 viewItem ref data isFocused =
     let
         ( zoomClass, infoZoomToggle, sourceZoomToggle ) =
@@ -352,7 +406,7 @@ viewItem ref data isFocused =
 
         viewDoc_ doc =
             doc
-                |> Maybe.map (viewDoc ref data.docFoldToggles)
+                |> Maybe.map (viewDoc ref data.docVisibility data.docFoldToggles)
                 |> Maybe.withDefault UI.nothing
 
         viewContent doc =

src/Workspace/WorkspaceItems.elm

@@ -399,6 +399,28 @@ prev items =
 -- TRANFORM
 
 
+updateData :
+    (WorkspaceItem.ItemData -> WorkspaceItem.ItemData)
+    -> Reference
+    -> WorkspaceItems
+    -> WorkspaceItems
+updateData f ref wItems =
+    let
+        update_ workspaceItem =
+            case workspaceItem of
+                WorkspaceItem.Success r d ->
+                    if ref == r then
+                        WorkspaceItem.Success r (f d)
+
+                    else
+                        workspaceItem
+
+                _ ->
+                    workspaceItem
+    in
+    map update_ wItems
+
+
 map :
     (WorkspaceItem -> WorkspaceItem)
     -> WorkspaceItems

src/css/definition-doc.css

@@ -306,6 +306,7 @@
 }
 .definition-doc h1:first-child {
   margin-top: 0;
+  line-height: 1.1;
 }
 
 .definition-doc h2 {

src/css/themes/unison/light.css

@@ -68,6 +68,12 @@
   --color-workspace-item-fg: var(--color-gray-darken-30);
   --color-workspace-item-mg: var(--color-gray-lighten-60);
   --color-workspace-item-bg: var(--color-gray-lighten-100);
+  --color-workspace-item-bg-faded: rgba(
+    255,
+    255,
+    255,
+    0.5
+  ); /* 50% gray-lighten-100 */
   --color-workspace-item-source-bg: transparent;
   --color-workspace-item-subtle-fg: var(--color-gray-lighten-30);
   --color-workspace-item-subtle-bg: var(--color-gray-lighten-60);
@@ -85,9 +91,17 @@
   --color-workspace-item-focus-mg: var(--color-gray-lighten-55);
   --color-workspace-item-focus-source-bg: transparent;
   --color-workspace-item-focus-bg: var(--color-gray-lighten-60);
+  --color-workspace-item-focus-bg-faded: rgba(
+    250,
+    250,
+    251,
+    0.5
+  ); /* 50% gray-lighten-60 */
   --color-workspace-item-focus-bg-em: var(--color-gray-lighten-50);
   --color-workspace-item-focus-content-border: var(--color-gray-lighten-50);
   --color-workspace-item-focus-border: var(--color-gray-lighten-50);
+  --color-workspace-item-cropped-control-border: var(--color-gray-lighten-30);
+  --color-workspace-item-cropped-control-shadow: var(--color-gray-lighten-45);
 
   --color-doc-fg: var(--color-gray-darken-30);
   --color-doc-bg: var(--color-gray-lighten-100);