snippet-0.1.0.1: src/Snippet/Pretty.hs
-- |
--
-- Module : Snippet.Pretty
-- Copyright : (c) 2026 Patrick Brisbin
-- License : AGPL-3
-- Maintainer : pbrisbin@gmail.com
-- Stability : experimental
-- Portability : POSIX
module Snippet.Pretty
( Ann (..)
, annToAnsi
, prettySnippet
, prettySnippetFill
, snippetGutterWidth
) where
import Prelude
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import Prettyprinter hiding (line)
import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), colorDull)
import Snippet.Line
import Snippet.Region
import Snippet.Snippet
data Ann
= -- | Line numbers and left-hand bar
AnnGutter
| -- | Focused line content
AnnFocused
annToAnsi :: Ann -> AnsiStyle
annToAnsi = \case
AnnGutter -> colorDull Blue
AnnFocused -> colorDull Green
-- | A 'Snippet's gutter fits the digits of its maximum (i.e. end) line number,
-- plus 1 character of whitespace.
snippetGutterWidth :: Snippet -> Int
snippetGutterWidth snippet = length (show @Int el) + 1
where
sl = snippet.region.startLine
el = fromMaybe sl snippet.region.endLine
prettySnippet :: Snippet -> Doc Ann
prettySnippet snippet = prettySnippetFill w snippet
where
w = length (show @Int el) + 1
sl = snippet.region.startLine
el = fromMaybe sl snippet.region.endLine
-- | 'prettySnippet' but fill the left gutter to the given width
--
--
-- This is useful if multiple snippets are being rendered together and their
-- line-numbers are different numbers of digits. You can compute the maximum
-- width on the outside (see 'snippetGutterWidth') and pass it so they all
-- align.
--
-- For example:
--
-- @
-- >>> vsep [prettySnippet a, prettySnippet b]
-- ┌─ a
-- │
-- 1 │ ...
-- │
-- ┌─ b
-- │
-- 15 │ ...
-- │
-- @
--
--
-- @
-- >>> vsep [prettySnippetFill 2 a, prettySnippetFill 2 b]
-- ┌─
-- │
-- 1 │ ...
-- │
-- ┌─ b
-- │
-- 15 │ ...
-- │
-- @
prettySnippetFill :: Int -> Snippet -> Doc Ann
prettySnippetFill w snippet =
vsep
[ indent w
$ annotate AnnGutter "┌─"
<+> pretty (snippet.uri)
<> ":"
<> pretty snippet.region.startLine
<> ":"
<> pretty snippet.region.startColumn
, indent w $ annotate AnnGutter "│"
, prettyLines w snippet.lines
]
prettyLines :: Int -> NonEmpty Line -> Doc Ann
prettyLines w = vsep . map (prettyLine w) . toList
prettyLine :: Int -> Line -> Doc Ann
prettyLine w line =
-- TODO: this is a fill-right, I want fill-left
annotate AnnGutter (fill w (maybe "" pretty line.number) <> "│")
<+> pretty line.pre
<> annotate AnnFocused (pretty line.focused)
<> pretty line.post