SourceWindow.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Ghcitui.Brick.SourceWindow
    ( SourceWindow (srcElements)

      -- * Creation
    , mkSourcWindow

      -- * Rendering
    , renderSourceWindow

      -- * Event Handling
    , ScrollDir (..)
    , scrollTo
    , srcWindowScrollPage
    , srcWindowMoveSelectionBy
    , srcWindowReplace
    , setSelectionTo
    , updateVerticalSpace

      -- * Lenses
    , srcElementsL
    , srcNameL
    , srcSelectedLineL
    , srcWindowStartL
    , srcWindowVerticalSpaceL

      -- * Misc
    , srcWindowLength
    ) where

import qualified Brick as B
import Control.Error (fromMaybe)
import qualified Data.Text as T
import qualified Data.Vector as Vec
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens
import Lens.Micro.TH (makeLensesFor)

import qualified Ghcitui.Util as Util

-- | Hold data regarding a code source viewing window.
data SourceWindow name elem = SourceWindow
    { srcElements :: !(Vec.Vector elem)
    -- ^ The actual entries for each source window.
    , srcWindowStart :: !Int
    -- ^ The starting position of the window, as a line number (1-indexed).
    -- No lines before this line number is rendered.
    , srcWindowVerticalSpace :: !(Maybe Int)
    -- ^ The maximum amount of visible lines at any point in time.
    , srcName :: !name
    -- ^ The name of the window.
    , srcSelectedLine :: !(Maybe Int)
    -- ^ The currently selected line in the window.
    }
    deriving (Show)

makeLensesFor
    [ ("srcElements", "srcElementsL")
    , ("srcWindowStart", "srcWindowStartL")
    , ("srcWindowVerticalSpace", "srcWindowVerticalSpaceL")
    , ("srcName", "srcNameL")
    , ("srcSelectedLine", "srcSelectedLineL")
    ]
    ''SourceWindow

-- | The difference between the last rendered line and the first rendered line.
srcWindowLineDiffCount :: SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount SourceWindow{srcWindowVerticalSpace = Just sWVS} = pure $ sWVS - 1
srcWindowLineDiffCount _ = Nothing

-- | The line number of the last viewable line in the window.
getLastRenderedLine :: SourceWindow name elem -> Maybe Int
getLastRenderedLine srcW@SourceWindow{srcWindowStart} = do
    diffCount <- srcWindowLineDiffCount srcW
    pure $ diffCount + srcWindowStart

-- | Render a 'SourceWindow' into a Brick 'B.Widget'.
renderSourceWindow
    :: (Ord n)
    => (Int -> Bool -> e -> B.Widget n)
    -- ^ Render function.
    -> SourceWindow n e
    -- ^ 'SourceWindow' to render.
    -> B.Widget n
    -- ^ The newly created widget.
renderSourceWindow func srcW = B.reportExtent (srcName srcW) (B.Widget B.Greedy B.Greedy renderM)
  where
    renderM = do
        c <- B.getContext
        let availableHeight = c ^. B.availHeightL + 1
        let renderHeight = Util.clamp (1, remainingElements) availableHeight
        let slicedElems = Vec.slice startZeroIdx renderHeight elems
        let drawnElems =
                [ func idx (Just idx == srcSelectedLine srcW) e
                | (idx, e) <- zip [srcWindowStart srcW ..] . Vec.toList $ slicedElems
                ]
        let trailingSpaces = availableHeight - length drawnElems
        -- This is a fairly weird list comprehension, since it either has only one element
        -- or none. But it works, and is for some reason recommended by hlint. Ugh.
        let trailingSpaceWidgets = [B.txt (T.replicate trailingSpaces "\n") | trailingSpaces > 0]
        B.render
            . B.vBox
            $ drawnElems <> trailingSpaceWidgets
    startZeroIdx = Util.clamp (0, srcWindowLength srcW - 1) $ srcWindowStart srcW - 1
    remainingElements = srcWindowLength srcW - startZeroIdx
    elems = srcElements srcW

{- | Return the length of the full contents of the source code stored in the window.

     Note, does NOT return the current length/height/size of the rendered widget.
-}
srcWindowLength :: SourceWindow n e -> Int
srcWindowLength = Vec.length . srcElements

{- | Set the source window end line inside of the given 'EventM' Monad.
     This is primarily for internal consistency, and is cheap. It should be called any time
     the srcWindowStart changes.
-}
updateVerticalSpace :: (Ord n) => SourceWindow n e -> B.EventM n m (SourceWindow n e)
updateVerticalSpace srcW@SourceWindow{srcName {- , srcContainerName -}} = do
    mSrcNameExtent <- B.lookupExtent srcName
    let mSpace = case mSrcNameExtent of
            Just extent ->
                Just . snd . B.extentSize $ extent
            _ -> Nothing
    pure (Lens.set srcWindowVerticalSpaceL mSpace srcW)

-- | Scroll to a given position, and move the source line along the way if needed.
scrollTo :: Int -> SourceWindow n e -> SourceWindow n e
scrollTo pos srcW@SourceWindow{srcWindowVerticalSpace = Just vSpace} =
    srcW{srcWindowStart = clampedPos, srcSelectedLine = newSelection}
  where
    -- Clamp between start line and one window away from the end.
    clampedPos = Util.clamp (1, srcWindowLength srcW - vSpace) pos

    newSelection
        | -- Choose the starting line if we're trying to go past the beginning.
          isScrollingPastStart =
            Just 1
        | -- Choose the last line if we're trying to go past the end.
          isScrollingPastEnd =
            Just $ srcWindowLength srcW
        | otherwise = newClampedSelectedLine
    isScrollingPastStart = pos < 1
    isScrollingPastEnd = pos >= srcWindowLength srcW -- Using >= because of a hack.
    newClampedSelectedLine :: Maybe Int
    newClampedSelectedLine = do
        ssl <- srcSelectedLine srcW
        diffCount <- srcWindowLineDiffCount srcW
        pure $ Util.clamp (clampedPos, clampedPos + diffCount) ssl
scrollTo _ srcW = srcW

-- | Direction to scroll by.
data ScrollDir = Up | Down deriving (Eq, Show)

-- | Scroll by a full page in a direction.
srcWindowScrollPage :: (Ord n) => ScrollDir -> SourceWindow n e -> B.EventM n m (SourceWindow n e)
srcWindowScrollPage dir srcW = srcWindowScrollPage' dir <$> updateVerticalSpace srcW

srcWindowScrollPage' :: ScrollDir -> SourceWindow n e -> SourceWindow n e
srcWindowScrollPage' dir srcW@SourceWindow{srcWindowStart} =
    case dir of
        Up -> scrollTo onePageUpPos srcW
        Down -> scrollTo (fromMaybe srcWindowStart (getLastRenderedLine srcW)) srcW
  where
    onePageUpPos = srcWindowStart - vSpace + 1 -- Plus one to preserve the top line.
    vSpace = fromMaybe 0 (srcWindowVerticalSpace srcW)

-- | Set the selection to a given position, and scroll the window accordingly.
setSelectionTo
    :: (Ord n)
    => Int
    -- ^ Line number to set the selection to (1-indexed)
    -> SourceWindow n e
    -- ^ Source window to update.
    -> B.EventM n m (SourceWindow n e)
setSelectionTo pos srcW = do
    srcW' <- updateVerticalSpace srcW
    case (getLastRenderedLine srcW', srcSelectedLine srcW') of
        (Just end, Just oldSelectedLine) -> do
            let delta = pos - oldSelectedLine
            if pos < srcWindowStart srcW' || pos > end
                then srcWindowMoveSelectionBy delta srcW
                else do
                    pure $ srcW{srcSelectedLine = Just pos}
        _ -> setSelectionToFallback pos srcW'

-- | Fallback function for setting the source window selection line, when we can't set it properly.
setSelectionToFallback :: Int -> SourceWindow name elem -> B.EventM name m (SourceWindow name elem)
setSelectionToFallback pos srcW = pure $ srcW{srcSelectedLine = Just pos, srcWindowStart = pos}

-- | Move the selected line by a given amount.
srcWindowMoveSelectionBy
    :: (Ord n)
    => Int
    -- ^ Delta to move the selected line.
    -> SourceWindow n e
    -- ^ Source window to update.
    -> B.EventM n m (SourceWindow n e)
srcWindowMoveSelectionBy amnt sw = do
    srcW <- updateVerticalSpace sw
    case (getLastRenderedLine srcW, srcWindowLineDiffCount srcW, srcSelectedLine srcW) of
        (Just end, Just renderHeight, Just oldSLine)
            | newSLine < srcWindowStart srcW ->
                pure $ scrollTo newSLine srcW{srcSelectedLine = Just newSLine}
            | newSLine > end ->
                pure $ scrollTo (newSLine - renderHeight) srcW{srcSelectedLine = Just newSLine}
            | otherwise -> pure $ srcW{srcSelectedLine = Just newSLine}
          where
            newSLine = Util.clamp (1, Vec.length (srcElements srcW)) $ oldSLine + amnt
        _ -> pure srcW

{- | Replace the contents of a given source window, and reset the pseudo-viewport's position
     to the top.
-}
srcWindowReplace :: (Foldable f) => f e -> SourceWindow n e -> SourceWindow n e
srcWindowReplace foldable srcW =
    srcW{srcSelectedLine = Just 1, srcWindowStart = 1, srcElements = elems}
  where
    elems = Vec.fromList . foldr (:) [] $ foldable

-- | Create a new source window from some text.
mkSourcWindow
    :: n
    -- ^ Name for the source window.
    -> T.Text
    -- ^ Text contents of the source window (to be split up).
    -> SourceWindow n T.Text
mkSourcWindow sourceWindowName text =
    SourceWindow
        { srcElements = lineVec
        , srcWindowStart = 1
        , srcSelectedLine = Just 1
        , srcName = sourceWindowName
        , srcWindowVerticalSpace = Nothing
        }
  where
    lineVec = Vec.fromList (T.lines text)