Line.hs

-- |
--
-- Module      : Snippet.Line
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Snippet.Line
  ( Line
  , lineNumber
  , lineContent
  , linesFromRegion
  ) where

import Prelude

import Control.Applicative ((<|>))
import Control.Monad (guard)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Prettyprinter (Doc, alterAnnotations, annotate, pretty, reAnnotate)
import Snippet.Pretty.Ann
import Snippet.Region

data Line = Line
  { number :: LineNumber
  , length :: Int
  -- ^ Length
  --
  -- Stored at construction because 'Color' will lose it
  , content :: LineContent
  }

data LineNumber
  = At Int
  | Under Int

data LineContent
  = Plain Int Text
  | Color (Doc Ann)

lineAt :: Int -> Text -> Line
lineAt n t =
  Line
    { number = At n
    , length = T.length t
    , content = Plain 0 t
    }

linesAt :: Int -> NonEmpty Text -> [Line]
linesAt n = zipWith lineAt [n ..] . toList

-- | Return a line's number (only if it's a real, numbered line)
lineNumber :: Line -> Maybe Int
lineNumber line =
  case line.number of
    At n -> Just n
    _ -> Nothing

-- | Return a line's number, or that of the one it's under
lineNumber' :: Line -> Int
lineNumber' line =
  case line.number of
    At n -> n
    Under n -> n

lineContent :: Line -> Doc Ann
lineContent = alterAnnotations dropPlain . lineContent'
 where
  -- We use zero-focus annotations to mark parts of text that can/should be
  -- re-annotated when nested. But they add extra reset escapes to the output,
  -- so we'll drop them at the end of processing.
  dropPlain = \case
    AnnFocused 0 -> []
    ann -> [ann]

-- | 'lineContent', but without dropping the @'AnnFocused' 0@ annotations
lineContent' :: Line -> Doc Ann
lineContent' line =
  case line.content of
    Plain i t -> plain $ T.replicate i " " <> t
    Color d -> d

-- | Built (focused) lines from a region and source lines
linesFromRegion :: Region -> Maybe Int -> NonEmpty Text -> [Line]
linesFromRegion region mStartLine = insideOut focusRegion region . linesAt sl
 where
  sl = fromMaybe region.startLine mStartLine

focusRegion :: Region -> [Line] -> [Line]
focusRegion region = alterLines $ \line -> do
  let
    sl = region.startLine
    el = fromMaybe sl region.endLine
    sc = fromMaybe 1 region.startColumn
    ec = fromMaybe (line.length + 1) region.endColumn

    oneLine = do
      guard $ el == sl
      n <- lineNumber line
      guard $ n == region.startLine

      -- inside-out and one-line rules mean we'll never see indent here
      Plain 0 content <- pure line.content

      let
        spaces = T.replicate (sc - 1) " "
        marker = T.replicate (ec - sc) "^"

        (pre, marked, post) = markLine sc (Just ec) content

        doc = plain pre <> focus marked <> plain post

      pure
        [ line {content = Color doc}
        , underline n spaces marker $ regionMessage (ec + 2) region
        ]

    startLine = do
      n <- lineNumber line
      guard $ n == sl
      Plain i content <- pure line.content

      let (pre, marked, post) = markLine sc (Just ec) content

      if T.null $ T.strip pre
        then do
          let
            marker = "╭─" <> T.replicate (i + sc - 2) "─"
            doc =
              focus (marker <> " " <> marked <> post)
                <> regionMessage (i + ec + 2) region

          pure [line {content = Color doc}]
        else do
          let
            marker = "╭─" <> T.replicate (i + sc - 1) "─" <> "^"
            doc =
              "  "
                <> pretty (T.replicate i " ")
                <> pretty pre
                <> focus (marked <> post)

          pure
            [ line {content = Color doc}
            , underline n "" marker $ regionMessage (i + ec) region
            ]

    inRegion = do
      let n = lineNumber' line
      guard $ n > sl && n < el

      pure [line {content = Color $ inRegionLine line}]

    endLine = do
      n <- lineNumber line
      guard $ n == el
      Plain i _ <- pure line.content

      let marker = "╰─" <> T.replicate (i + ec - 2) "─" <> "^"

      pure
        [ line {content = Color $ inRegionLine line}
        , underline n "" marker mempty
        ]

    shiftLine = do
      -- Don't do this for one-line regions
      guard $ el /= sl
      Plain i c <- pure line.content
      guard $ not $ T.null c
      pure [line {content = Plain (i + 2) c}]

  oneLine <|> startLine <|> inRegion <|> endLine <|> shiftLine <|> Just [line]

inRegionLine :: Line -> Doc Ann
inRegionLine line =
  if line.length == 0
    then focus "│"
    else focus "│ " <> refocus (lineContent' line)

underline :: Int -> Text -> Text -> Doc Ann -> Line
underline n prefix marker post =
  Line
    { number = Under n
    , length = T.length prefix + T.length marker
    , content = Color $ pretty prefix <> focus marker <> post
    }

-- | Run a function on nested 'Region's on sub-regions before parents
insideOut :: (Region -> a -> a) -> Region -> a -> a
insideOut f region a = case region.subRegion of
  Nothing -> f region a
  Just sr -> f region $ insideOut f sr a

alterLines :: (Line -> Maybe [Line]) -> [Line] -> [Line]
alterLines f = concatMap $ \l -> fromMaybe [l] $ f l

plain :: Text -> Doc Ann
plain = annotate (AnnFocused 0) . pretty

focus :: Text -> Doc Ann
focus = annotate (AnnFocused 1) . pretty

markLine :: Int -> Maybe Int -> Text -> (Text, Text, Text)
markLine sc mec t = (pre, marked, post)
 where
  (pre, rest) = T.splitAt (sc - 1) t
  (marked, post) = case mec of
    Nothing -> (rest, "")
    Just ec -> T.splitAt (ec - sc) rest

refocus :: Doc Ann -> Doc Ann
refocus = reAnnotate go
 where
  go = \case
    AnnFocused i -> AnnFocused $ i + 1
    x -> x

regionMessage :: Int -> Region -> Doc Ann
regionMessage sc region = maybe mempty (message sc) region.message

message :: Int -> Text -> Doc Ann
message sc m =
  mconcat
    [ " "
    , annotate AnnDecoration ("•" <> pretty bar <> "┤")
    , annotate AnnMessage $ pretty m
    ]
 where
  bar = T.replicate (max 2 barLen) "─"
  barLen = rightEdge - T.length m - sc - 3

rightEdge :: Int
rightEdge = 72