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
    , updateSrcWindowEnd
    , srcWindowMoveSelectionBy
    , srcWindowReplace
    , setSelectionTo

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

      -- * 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.
    , srcWindowEnd :: !(Maybe Int)
    , srcName :: !name
    -- ^ The name of the window.
    , srcSelectedLine :: !(Maybe Int)
    -- ^ The currently selected line in the window.
    }
    deriving (Show)

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

-- | 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.
updateSrcWindowEnd :: (Ord n) => SourceWindow n e -> B.EventM n m (SourceWindow n e)
updateSrcWindowEnd srcW@SourceWindow{srcWindowStart, srcName} = do
    mExtent <- B.lookupExtent srcName
    let end = case mExtent of
            Just extent ->
                -- -1 offset since the end is inclusive.
                Just $ (snd . B.extentSize $ extent) + srcWindowStart - 1
            _ -> Nothing
    pure (Lens.set srcWindowEndL end 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{srcWindowEnd = Just windowEnd} =
    srcW{srcWindowStart = clampedPos, srcSelectedLine = newSelection}
  where
    clampedPos = Util.clamp (1, srcWindowLength srcW - renderHeight) 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
    renderHeight = windowEnd - srcWindowStart srcW
    isScrollingPastStart = pos < 1
    isScrollingPastEnd = pos >= srcWindowLength srcW -- Using >= because of a hack.
    newClampedSelectedLine =
        Util.clamp
            (clampedPos, clampedPos + renderHeight)
            <$> srcSelectedLine srcW
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 <$> updateSrcWindowEnd srcW

-- | Internal helper.
srcWindowScrollPage' :: ScrollDir -> SourceWindow n e -> SourceWindow n e
srcWindowScrollPage' dir srcW =
    case dir of
        Up ->
            let renderHeight = windowEnd - srcWindowStart srcW
             in scrollTo (srcWindowStart srcW - renderHeight) srcW
        Down -> scrollTo windowEnd srcW
  where
    windowEnd = fromMaybe 1 $ srcWindowEnd 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@SourceWindow{srcSelectedLine = Just sl, srcWindowEnd = Just end} =
    if pos < srcWindowStart srcW || pos > end
        then srcWindowMoveSelectionBy delta srcW
        else do
            pure $ srcW{srcSelectedLine = Just pos}
  where
    delta = pos - sl
setSelectionTo _ srcW = pure srcW

-- | 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' <- updateSrcWindowEnd sw
    case srcWindowEnd srcW' of
        Just end -> do
            let start = srcWindowStart srcW'
            let mSLine = srcSelectedLine srcW'
            let renderHeight = end - start
            pure $ case mSLine of
                Just sLine
                    | newSLine < start ->
                        scrollTo newSLine srcW'{srcSelectedLine = Just newSLine}
                    | newSLine > end ->
                        scrollTo (newSLine - renderHeight) srcW'{srcSelectedLine = Just newSLine}
                    | otherwise -> srcW'{srcSelectedLine = Just newSLine}
                  where
                    newSLine = Util.clamp (1, Vec.length (srcElements srcW')) $ sLine + amnt
                _ -> srcW'
        Nothing -> 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 name text =
    SourceWindow
        { srcElements = lineVec
        , srcWindowStart = 1
        , srcSelectedLine = Just 1
        , srcName = name
        , srcWindowEnd = Nothing
        }
  where
    lineVec = Vec.fromList (T.lines text)