Line.hs

-- | Pure single-line editing state, keys and width-aware windowing.
module Ansiform.Internal.Line
    ( LineState (..)
    , LineKey (..)
    , applyLineKey
    , visibleLine
    ) where

import Ansiform.Internal.Width (charWidth, textWidth)
--------------------------------------------------------------------------------
import Data.Char (isPrint)

-- Line State
--------------------------------------------------------------------------------

-- | An immutable single-line buffer and its cursor.
--   The cursor is a zero-based code-point index.
data LineState = LineState
    { lineText :: String
    -- ^ Current contents of the buffer.
    , lineCursor :: Int
    -- ^ Cursor position as a code-point index into 'lineText'.
    }
    deriving (Eq, Show)

-- | Editing keys understood by the line editor.
data LineKey
    = -- | Insert a printable character at the cursor.
      LineInsert Char
    | -- | Delete the character before the cursor.
      LineBackspace
    | -- | Delete the character at the cursor.
      LineDelete
    | -- | Move the cursor one code point to the left.
      LineMoveLeft
    | -- | Move the cursor one code point to the right.
      LineMoveRight
    | -- | Move the cursor to the start of the buffer.
      LineMoveHome
    | -- | Move the cursor to the end of the buffer.
      LineMoveEnd
    deriving (Eq, Show)

-- Pure Editing
--------------------------------------------------------------------------------

-- | Applies one key to the buffer, returning a new state.
--   Movement stops at the buffer boundaries, deletion at either boundary is a
--   no-op, and non-printable characters are ignored by 'LineInsert'.
applyLineKey :: LineKey -> LineState -> LineState
applyLineKey key (LineState text cursor) = case key of
    LineInsert c
        | isPrint c ->
            let (before, after) = splitAt position text
             in LineState (before ++ (c : after)) (position + 1)
        | otherwise -> LineState text position
    LineBackspace
        | position <= 0 -> LineState text position
        | otherwise ->
            let (before, after) = splitAt position text
             in LineState (init before ++ after) (position - 1)
    LineDelete
        | position >= length text -> LineState text position
        | otherwise ->
            LineState (take position text ++ drop (position + 1) text) position
    LineMoveLeft -> LineState text (max 0 (position - 1))
    LineMoveRight -> LineState text (min (length text) (position + 1))
    LineMoveHome -> LineState text 0
    LineMoveEnd -> LineState text (length text)
  where
    position = max 0 (min (length text) cursor)

-- | Selects the substring and cursor offset that fit in a terminal width.
--   The first argument is the number of columns available to the editor.
--   One column is reserved for the cursor, so a full window leaves the cursor
--   inside the terminal. When the buffer does not fit, the window scrolls so
--   that the cursor stays visible. Widths come from 'charWidth', so wide
--   characters and combining marks keep the cursor aligned.
visibleLine :: Int -> LineState -> (String, Int)
visibleLine width (LineState text cursor) = (window, windowCursor)
  where
    usable = max 1 (width - 1)
    position = max 0 (min (length text) cursor)
    cursorColumn = textWidth (take position text)
    start = windowStart usable cursorColumn text
    afterStart = drop start text
    window = takeWindow usable afterStart
    windowCursor = textWidth (take (position - start) afterStart)

-- Finds the first code point that leaves at most the usable width before the
-- cursor.
windowStart :: Int -> Int -> String -> Int
windowStart usable = go 0
  where
    go index remaining _
        | remaining <= usable = index
    go index remaining (c : cs) =
        go (index + 1) (remaining - charWidth c) cs
    go index _ [] = index

-- Takes code points from the start while they fit in the usable width.
takeWindow :: Int -> String -> String
takeWindow usable = go 0
  where
    go _ [] = []
    go used (c : cs)
        | used + charWidth c > usable = []
        | otherwise = c : go (used + charWidth c) cs