-- todo: there are terminal escape codes for marking URLs
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TupleSections #-}

-- | A pretty renderer for 'Diagnostic's. Can optionally render in color
module Chapelure.Handler.Colourful (render, Config (..), prettyConfig, asciiColorConfig, asciiPlainConfig) where

import Chapelure.Style
  ( DocText,
    Style,
    StyleColor (Color16, Color256, ColorRGB),
    styleFG,
    styleUnderline,
  )
import Chapelure.Types
  ( Column (..),
    Diagnostic (Diagnostic),
    Highlight (Highlight, spans),
    Line (..),
    Severity (Error, Info, Warning),
    Snippet (Snippet),
  )
import Data.Bifunctor (Bifunctor (first))
import Data.Colour (Colour, colourConvert)
import Data.Fixed (mod')
import Data.Foldable (Foldable (fold), toList)
import Data.List (mapAccumL)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Semigroup (Semigroup (stimes))
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Display (display)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.NonEmpty as DVNE
import HSLuv
  ( HSLuv (HSLuv),
    HSLuvHue (HSLuvHue),
    HSLuvLightness (HSLuvLightness),
    HSLuvSaturation (HSLuvSaturation),
    hsluvToColour,
  )
import Optics.Core ((<&>))
import Prettyprinter (LayoutOptions (LayoutOptions, layoutPageWidth), PageWidth (AvailablePerLine, Unbounded), Pretty (pretty), SimpleDocStream (..), annotate, brackets, hardline, indent, layoutPretty, space)
import System.Console.ANSI (Color (Blue, Red, Yellow), ColorIntensity (Vivid), Underlining (SingleUnderline), xterm24LevelGray)

-- Color generation
-- https://martin.ankerl.com/2009/12/09/how-to-create-random-colors-programmatically/
-- lightness between 0 and 100
spacedColors :: Double -> [Colour Double]
spacedColors :: Double -> [Colour Double]
spacedColors Double
lightness = (Double -> Colour Double) -> [Double] -> [Colour Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
hue -> HSLuv -> Colour Double
hsluvToColour (HSLuv -> Colour Double) -> HSLuv -> Colour Double
forall a b. (a -> b) -> a -> b
$ HSLuvHue -> HSLuvSaturation -> HSLuvLightness -> HSLuv
HSLuv (Double -> HSLuvHue
HSLuvHue (Double -> HSLuvHue) -> Double -> HSLuvHue
forall a b. (a -> b) -> a -> b
$ Double
hue Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
360.0) (Double -> HSLuvSaturation
HSLuvSaturation Double
100.0) (Double -> HSLuvLightness
HSLuvLightness Double
lightness)) [Double]
hues
  where
    goldenRatioConjugate :: Double
    goldenRatioConjugate :: Double
goldenRatioConjugate = Double
0.618033988749895

    hues :: [Double]
hues = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
x -> (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
goldenRatioConjugate) Double -> Double -> Double
forall a. Real a => a -> a -> a
`mod'` Double
1.0) [Item [Double]
1 ..]

headMempty :: Monoid a => [a] -> a
headMempty :: [a] -> a
headMempty [] = a
forall a. Monoid a => a
mempty
headMempty (a
a : [a]
_as) = a
a

-- | Configuration for rendering
data Config = Config
  { Config -> Word
tabWidth :: !Word,
    Config -> LayoutOptions
layoutOptions :: !LayoutOptions,
    Config -> Style
infoStyle :: !Style,
    Config -> Style
warningStyle :: !Style,
    Config -> Style
errorStyle :: !Style,
    Config -> Style
gutterStyle :: !Style,
    Config -> Style
linkStyle :: !Style,
    Config -> Bool
colourizeHighlights :: !Bool,
    Config -> Char
gutterVLine :: !Char,
    Config -> Char
gutterVBreak :: !Char,
    Config -> Char
gutterHLineHead :: !Char,
    Config -> Char
gutterHLineFoot :: !Char,
    Config -> Char
gutterCornerHead :: !Char,
    Config -> Char
gutterCornerFoot :: !Char,
    Config -> Text
locationLeftBracket :: !Text,
    Config -> Text
locationRightBracket :: !Text,
    Config -> Text
locationSeparator :: !Text,
    Config -> Char
highlightUnderLeft :: !Char,
    Config -> Char
highlightUnderRight :: !Char,
    Config -> Char
highlightUnder :: !Char,
    Config -> Char
highlightUnderDown :: !Char,
    Config -> Char
highlightTwospan :: !Char,
    Config -> Char
highlightConnector :: !Char,
    Config -> Char
highlightConnectionLeft :: !Char,
    Config -> Char
highlightConnectionRight :: !Char,
    Config -> Char
highlightHConnector :: !Char,
    Config -> Char
highlightHTee :: !Char,
    Config -> Char
highlightLabelTee :: !Char,
    Config -> Char
highlightCornerTop :: !Char,
    Config -> Char
highlightCornerBottom :: !Char
  }

prettyConfig, asciiColorConfig, asciiPlainConfig :: Config
-- | A pretty rendering configuration, making use of color and Unicode box-drawing characters
prettyConfig :: Config
prettyConfig =
  Config :: Word
-> LayoutOptions
-> Style
-> Style
-> Style
-> Style
-> Style
-> Bool
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Text
-> Text
-> Text
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Config
Config
    { $sel:tabWidth:Config :: Word
tabWidth = Word
4,
      $sel:layoutOptions:Config :: LayoutOptions
layoutOptions = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
80 Double
1.0),
      $sel:infoStyle:Config :: Style
infoStyle = StyleColor -> Style
styleFG (StyleColor -> Style) -> StyleColor -> Style
forall a b. (a -> b) -> a -> b
$ ColorIntensity -> Color -> StyleColor
Color16 ColorIntensity
Vivid Color
Blue,
      $sel:warningStyle:Config :: Style
warningStyle = StyleColor -> Style
styleFG (StyleColor -> Style) -> StyleColor -> Style
forall a b. (a -> b) -> a -> b
$ ColorIntensity -> Color -> StyleColor
Color16 ColorIntensity
Vivid Color
Yellow,
      $sel:errorStyle:Config :: Style
errorStyle = StyleColor -> Style
styleFG (StyleColor -> Style) -> StyleColor -> Style
forall a b. (a -> b) -> a -> b
$ ColorIntensity -> Color -> StyleColor
Color16 ColorIntensity
Vivid Color
Red,
      $sel:gutterStyle:Config :: Style
gutterStyle = StyleColor -> Style
styleFG (Word8 -> StyleColor
Color256 (Word8 -> StyleColor) -> Word8 -> StyleColor
forall a b. (a -> b) -> a -> b
$ Int -> Word8
xterm24LevelGray Int
12),
      $sel:linkStyle:Config :: Style
linkStyle = Underlining -> Style
styleUnderline Underlining
SingleUnderline,
      $sel:colourizeHighlights:Config :: Bool
colourizeHighlights = Bool
True,
      $sel:gutterVLine:Config :: Char
gutterVLine = Char
'│',
      $sel:gutterVBreak:Config :: Char
gutterVBreak = Char
'┆',
      $sel:gutterHLineHead:Config :: Char
gutterHLineHead = Char
' ',
      $sel:gutterHLineFoot:Config :: Char
gutterHLineFoot = Char
' ',
      $sel:gutterCornerHead:Config :: Char
gutterCornerHead = Char
'╭',
      $sel:gutterCornerFoot:Config :: Char
gutterCornerFoot = Char
'╯',
      $sel:locationLeftBracket:Config :: Text
locationLeftBracket = Text
"[",
      $sel:locationRightBracket:Config :: Text
locationRightBracket = Text
"]",
      $sel:locationSeparator:Config :: Text
locationSeparator = Text
":",
      $sel:highlightUnderLeft:Config :: Char
highlightUnderLeft = Char
'╰',
      $sel:highlightUnderRight:Config :: Char
highlightUnderRight = Char
'╯',
      $sel:highlightUnder:Config :: Char
highlightUnder = Char
'─',
      $sel:highlightUnderDown:Config :: Char
highlightUnderDown = Char
'┬',
      $sel:highlightTwospan:Config :: Char
highlightTwospan = Char
'├',
      $sel:highlightConnector:Config :: Char
highlightConnector = Char
'│',
      $sel:highlightConnectionLeft:Config :: Char
highlightConnectionLeft = Char
'╯',
      $sel:highlightConnectionRight:Config :: Char
highlightConnectionRight = Char
'╰',
      $sel:highlightHConnector:Config :: Char
highlightHConnector = Char
'─',
      $sel:highlightHTee:Config :: Char
highlightHTee = Char
'├',
      $sel:highlightLabelTee:Config :: Char
highlightLabelTee = Char
'┴',
      $sel:highlightCornerTop:Config :: Char
highlightCornerTop = Char
'╭',
      $sel:highlightCornerBottom:Config :: Char
highlightCornerBottom = Char
'╰'
    }
-- | A colorful ASCII rendering configuration
asciiColorConfig :: Config
asciiColorConfig =
  Config
prettyConfig
    { $sel:gutterVLine:Config :: Char
gutterVLine = Char
'|',
      $sel:gutterVBreak:Config :: Char
gutterVBreak = Char
':',
      $sel:gutterCornerHead:Config :: Char
gutterCornerHead = Char
'/',
      $sel:gutterCornerFoot:Config :: Char
gutterCornerFoot = Char
'/',
      $sel:highlightUnderLeft:Config :: Char
highlightUnderLeft = Char
'^',
      $sel:highlightUnderRight:Config :: Char
highlightUnderRight = Char
'^',
      $sel:highlightUnder:Config :: Char
highlightUnder = Char
'^',
      $sel:highlightUnderDown:Config :: Char
highlightUnderDown = Char
'^',
      $sel:highlightTwospan:Config :: Char
highlightTwospan = Char
'^',
      $sel:highlightConnector:Config :: Char
highlightConnector = Char
'|',
      $sel:highlightConnectionLeft:Config :: Char
highlightConnectionLeft = Char
'/',
      $sel:highlightConnectionRight:Config :: Char
highlightConnectionRight = Char
'\\',
      $sel:highlightHConnector:Config :: Char
highlightHConnector = Char
'-',
      $sel:highlightHTee:Config :: Char
highlightHTee = Char
'|',
      $sel:highlightLabelTee:Config :: Char
highlightLabelTee = Char
'*',
      $sel:highlightCornerTop:Config :: Char
highlightCornerTop = Char
'/',
      $sel:highlightCornerBottom:Config :: Char
highlightCornerBottom = Char
'\\'
    }
-- | A plain ASCII rendering configuration. Useful if the terminal supports neither colour nor box-drawing characters
asciiPlainConfig :: Config
asciiPlainConfig =
  Config
asciiColorConfig
    { $sel:infoStyle:Config :: Style
infoStyle = Style
forall a. Monoid a => a
mempty,
      $sel:warningStyle:Config :: Style
warningStyle = Style
forall a. Monoid a => a
mempty,
      $sel:errorStyle:Config :: Style
errorStyle = Style
forall a. Monoid a => a
mempty,
      $sel:gutterStyle:Config :: Style
gutterStyle = Style
forall a. Monoid a => a
mempty,
      $sel:linkStyle:Config :: Style
linkStyle = Style
forall a. Monoid a => a
mempty,
      $sel:colourizeHighlights:Config :: Bool
colourizeHighlights = Bool
False
    }

-- | What to render at the left of the line
data Gutter
  = --      ╭[source:line:column]
    Header (Maybe Text) Line Column
  | --      |
    HeaderSpace
  | -- line |
    Numbered Line
  | --      |
    Unnumbered (Maybe Semantic)
  | --      ┆
    Break
  | --      ╯
    Footer

-- | The meaning of an unnumbered line: used to connect up multi-line highlights
data Semantic
  = -- | Extra information in the footer
    FooterInfo
  | -- | Line contains the first connnector for highlight #[Int]
    FirstConnectorFor Int
  | -- | Line contains a connnector for highlight #[Int]
    MidConnectorFor Int
  | -- | Line contains the last connnector for highlight #[Int]
    LastConnectorFor Int

-- | What kind of multi-span label to render in a column
data MultiSpan
  = -- | No multi-span label here
    NoMulti
  | -- | A vertical connection
    Vee Style
  | -- | A vertical-right connection
    Tee Style TeeLocation

-- | Where a tee-junction of a multi-span is within the multi-span
data TeeLocation
  = TeeTop
  | TeeMid
  | TeeBottom

-- | A connector to labels and/or multi-spans
data Connector
  = -- | ╯ Connect to a label on the left
    LeftConnector
  | -- | ╰ Connect to a label on the right
    RightConnector
  | -- | ╯ Connect to a multi-span
    MultiConnector
  | -- | ┴ Connect to a multi-span and a label on the right
    MultiEndConnector

-- | How to render a particular line, and the line's semantics
data RenderLine = RenderLine
  { RenderLine -> Gutter
gutter :: Gutter,
    RenderLine -> [MultiSpan]
multispans :: [MultiSpan],
    RenderLine -> Word
contentOffset :: Word,
    RenderLine -> [(Text, Style)]
renderedContent :: [(Text, Style)],
    RenderLine -> Maybe (Style, Connector)
connector :: Maybe (Style, Connector)
  }

renderLine :: Config -> Word -> RenderLine -> DocText
renderLine :: Config -> Word -> RenderLine -> DocText
renderLine Config
config Word
pad (RenderLine Gutter
g [MultiSpan]
ms Word
co [(Text, Style)]
rc Maybe (Style, Connector)
conn) =
  Gutter -> DocText
goGutter Gutter
g
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> [MultiSpan] -> Word -> DocText
goMulti [MultiSpan]
ms Word
co
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> case Maybe (Style, Connector)
conn of
      Just (Style
connSt, Connector
RightConnector) -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
connSt (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightConnectionRight Config
config)
      Just (Style
connSt, Connector
MultiConnector) -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
connSt (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightConnectionLeft Config
config)
      Just (Style
connSt, Connector
MultiEndConnector) -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
connSt (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightLabelTee Config
config)
      Maybe (Style, Connector)
_ -> DocText
forall a. Monoid a => a
mempty
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
forall ann. Doc ann
space
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> [(Text, Style)] -> DocText
goContent [(Text, Style)]
rc
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> case Maybe (Style, Connector)
conn of
      Just (Style
connSt, Connector
LeftConnector) -> DocText
forall ann. Doc ann
space DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
connSt (Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightConnectionLeft Config
config))
      Maybe (Style, Connector)
_ -> DocText
forall a. Monoid a => a
mempty
    DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
forall ann. Doc ann
hardline
  where
    goGutter :: Gutter -> DocText
    goGutter :: Gutter -> DocText
goGutter =
      Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate (Config -> Style
gutterStyle Config
config)
        (DocText -> DocText) -> (Gutter -> DocText) -> Gutter -> DocText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
          Header Maybe Text
source Line
l Column
c' ->
            Word -> DocText -> DocText
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Word
pad (Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Char -> DocText) -> Char -> DocText
forall a b. (a -> b) -> a -> b
$ Config -> Char
gutterHLineHead Config
config)
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
gutterCornerHead Config
config)
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Text
locationLeftBracket Config
config)
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText -> (Text -> DocText) -> Maybe Text -> DocText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DocText
forall a. Monoid a => a
mempty (\Text
s -> Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Text
s DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Text
locationSeparator Config
config)) Maybe Text
source
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Line -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Line
l
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Text
locationSeparator Config
config)
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Column -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Column
c'
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Text
locationRightBracket Config
config)
          Gutter
HeaderSpace ->
            Int -> DocText -> DocText
forall ann. Int -> Doc ann -> Doc ann
indent (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pad) (Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Char -> DocText) -> Char -> DocText
forall a b. (a -> b) -> a -> b
$ Config -> Char
gutterVLine Config
config)
          Numbered Line
li ->
            let s :: Text
s = Line -> Text
forall a. Display a => a -> Text
display Line
li
             in Int -> DocText -> DocText
forall ann. Int -> Doc ann -> Doc ann
indent (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Text
s DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
gutterVLine Config
config)
          Unnumbered Maybe Semantic
_ -> Int -> DocText -> DocText
forall ann. Int -> Doc ann -> Doc ann
indent (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pad) (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
gutterVLine Config
config)
          Gutter
Break -> Int -> DocText -> DocText
forall ann. Int -> Doc ann -> Doc ann
indent (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pad) (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
gutterVBreak Config
config)
          Gutter
Footer ->
            Word -> DocText -> DocText
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Word
pad (Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Char -> DocText) -> Char -> DocText
forall a b. (a -> b) -> a -> b
$ Config -> Char
gutterHLineFoot Config
config)
              DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
gutterCornerFoot Config
config)

    goMulti :: [MultiSpan] -> Word -> DocText
    goMulti :: [MultiSpan] -> Word -> DocText
goMulti [MultiSpan]
ms' Word
co' =
      let (Maybe Style
hl, [DocText]
docs) =
            (Maybe Style -> MultiSpan -> (Maybe Style, DocText))
-> Maybe Style -> [MultiSpan] -> (Maybe Style, [DocText])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
              ( \Maybe Style
hl' -> \case
                  MultiSpan
NoMulti -> (Maybe Style
hl', DocText -> (Style -> DocText) -> Maybe Style -> DocText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DocText
forall ann. Doc ann
space (\Style
st -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightHConnector Config
config)) Maybe Style
hl')
                  Vee Style
st -> (Maybe Style
hl', Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightConnector Config
config))
                  Tee Style
st TeeLocation
TeeTop -> (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
st, Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightCornerTop Config
config))
                  Tee Style
st TeeLocation
TeeMid -> (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
st, Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightHTee Config
config))
                  Tee Style
st TeeLocation
TeeBottom -> (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
st, Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightCornerBottom Config
config))
              )
              Maybe Style
forall a. Maybe a
Nothing
              [MultiSpan]
ms'
       in [DocText] -> DocText
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [DocText]
docs DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> Word -> DocText -> DocText
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Word
co' (DocText -> (Style -> DocText) -> Maybe Style -> DocText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DocText
forall ann. Doc ann
space (\Style
st -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ Char -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Config -> Char
highlightHConnector Config
config)) Maybe Style
hl)

    goContent :: [(Text, Style)] -> DocText
    goContent :: [(Text, Style)] -> DocText
goContent = ((Text, Style) -> DocText) -> [(Text, Style)] -> DocText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Text
t, Style
s) -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
s (Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Text
t))

buildDoc :: LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc :: LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc LayoutOptions
lo = [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [] [] (SimpleDocStream Style -> Seq [(Text, Style)])
-> (DocText -> SimpleDocStream Style)
-> DocText
-> Seq [(Text, Style)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> DocText -> SimpleDocStream Style
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
lo
  where
    go :: [Style] -> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
    go :: [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [Style]
st [(Text, Style)]
line = \case
      SimpleDocStream Style
SFail -> [[(Text, Style)] -> [(Text, Style)]
forall a. [a] -> [a]
reverse [(Text, Style)]
line]
      SimpleDocStream Style
SEmpty -> [[(Text, Style)] -> [(Text, Style)]
forall a. [a] -> [a]
reverse [(Text, Style)]
line]
      SChar Char
c SimpleDocStream Style
sds -> [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [Style]
st ((Char -> Text
T.singleton Char
c, [Style] -> Style
forall a. Monoid a => [a] -> a
headMempty [Style]
st) (Text, Style) -> [(Text, Style)] -> [(Text, Style)]
forall a. a -> [a] -> [a]
: [(Text, Style)]
line) SimpleDocStream Style
sds
      SText Int
_n Text
txt SimpleDocStream Style
sds -> [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [Style]
st ((Text
txt, [Style] -> Style
forall a. Monoid a => [a] -> a
headMempty [Style]
st) (Text, Style) -> [(Text, Style)] -> [(Text, Style)]
forall a. a -> [a] -> [a]
: [(Text, Style)]
line) SimpleDocStream Style
sds
      SLine Int
n SimpleDocStream Style
sds -> [(Text, Style)] -> [(Text, Style)]
forall a. [a] -> [a]
reverse [(Text, Style)]
line [(Text, Style)] -> Seq [(Text, Style)] -> Seq [(Text, Style)]
forall a. a -> Seq a -> Seq a
:<| [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [Style]
st [(Int -> Text -> Text
T.replicate Int
n Text
" ", [Style] -> Style
forall a. Monoid a => [a] -> a
headMempty [Style]
st)] SimpleDocStream Style
sds
      SAnnPush Style
st' SimpleDocStream Style
sds -> case [Style]
st of
        [] -> [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go [Item [Style]
Style
st'] [(Text, Style)]
line SimpleDocStream Style
sds
        (Style
s : [Style]
ss) -> [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go (Style
s Style -> Style -> Style
forall a. Semigroup a => a -> a -> a
<> Style
st' Style -> [Style] -> [Style]
forall a. a -> [a] -> [a]
: Style
s Style -> [Style] -> [Style]
forall a. a -> [a] -> [a]
: [Style]
ss) [(Text, Style)]
line SimpleDocStream Style
sds
      SAnnPop SimpleDocStream Style
sds -> [Style]
-> [(Text, Style)] -> SimpleDocStream Style -> Seq [(Text, Style)]
go (Int -> [Style] -> [Style]
forall a. Int -> [a] -> [a]
drop Int
1 [Style]
st) [(Text, Style)]
line SimpleDocStream Style
sds

buildGutter :: LayoutOptions -> Line -> Line -> Vector DocText -> (Word, Seq RenderLine)
buildGutter :: LayoutOptions
-> Line -> Line -> Vector DocText -> (Word, Seq RenderLine)
buildGutter LayoutOptions
lo Line
s Line
e Vector DocText
lines' = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pad, Seq RenderLine
body)
  where
    pad :: Int
pad = Text -> Int
T.length (Line -> Text
forall a. Display a => a -> Text
display Line
e)
    padded :: LayoutOptions
padded = PageWidth -> LayoutOptions
LayoutOptions (PageWidth -> LayoutOptions) -> PageWidth -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ case LayoutOptions -> PageWidth
layoutPageWidth LayoutOptions
lo of
      AvailablePerLine Int
n Double
x -> Int -> Double -> PageWidth
AvailablePerLine (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pad) Double
x
      PageWidth
Unbounded -> PageWidth
Unbounded

    body :: Seq RenderLine
body =
      Seq Line -> Seq DocText -> Seq (Line, DocText)
forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip [Item (Seq Line)
Line
s .. Item (Seq Line)
Line
e] ([DocText] -> Seq DocText
forall a. [a] -> Seq a
Seq.fromList ([DocText] -> Seq DocText) -> [DocText] -> Seq DocText
forall a b. (a -> b) -> a -> b
$ Vector DocText -> [DocText]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector DocText
lines') Seq (Line, DocText)
-> ((Line, DocText) -> Seq RenderLine) -> Seq RenderLine
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Line
i, DocText
line) ->
        ([(Text, Style)] -> RenderLine)
-> Seq [(Text, Style)] -> Seq RenderLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(Text, Style)]
r -> Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine (Line -> Gutter
Numbered Line
i) [] Word
0 [(Text, Style)]
r Maybe (Style, Connector)
forall a. Maybe a
Nothing) (LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc LayoutOptions
padded DocText
line)

buildGutter' :: Bool -> Style -> LayoutOptions -> Maybe Text -> Line -> Column -> Line -> Vector DocText -> Maybe DocText -> Maybe Text -> (Word, Seq RenderLine)
buildGutter' :: Bool
-> Style
-> LayoutOptions
-> Maybe Text
-> Line
-> Column
-> Line
-> Vector DocText
-> Maybe DocText
-> Maybe Text
-> (Word, Seq RenderLine)
buildGutter' Bool
isFinal Style
linkStyle LayoutOptions
lo Maybe Text
source Line
s Column
sc Line
e Vector DocText
lines' Maybe DocText
me Maybe Text
li =
  ( Word
pad,
    Gutter -> RenderLine
go (Maybe Text -> Line -> Column -> Gutter
Header Maybe Text
source Line
s Column
sc) RenderLine -> Seq RenderLine -> Seq RenderLine
forall a. a -> Seq a -> Seq a
:<| Gutter -> RenderLine
go Gutter
HeaderSpace
      RenderLine -> Seq RenderLine -> Seq RenderLine
forall a. a -> Seq a -> Seq a
:<| ( Seq RenderLine
bg
              Seq RenderLine -> Seq RenderLine -> Seq RenderLine
forall a. Semigroup a => a -> a -> a
<> if Bool -> Bool
not Bool
isFinal then Seq RenderLine
forall a. Monoid a => a
mempty else ((\[(Text, Style)]
l -> Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine (Maybe Semantic -> Gutter
Unnumbered (Semantic -> Maybe Semantic
forall a. a -> Maybe a
Just Semantic
FooterInfo)) [] Word
0 [(Text, Style)]
l Maybe (Style, Connector)
forall a. Maybe a
Nothing) ([(Text, Style)] -> RenderLine)
-> Seq [(Text, Style)] -> Seq RenderLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc LayoutOptions
lo (DocText -> Maybe DocText -> DocText
forall a. a -> Maybe a -> a
fromMaybe DocText
forall a. Monoid a => a
mempty Maybe DocText
me))
              Seq RenderLine -> Seq RenderLine -> Seq RenderLine
forall a. Semigroup a => a -> a -> a
<> if Bool -> Bool
not Bool
isFinal then Seq RenderLine
forall a. Monoid a => a
mempty else Seq RenderLine
-> (Text -> Seq RenderLine) -> Maybe Text -> Seq RenderLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq RenderLine
forall a. Monoid a => a
mempty (\Text
link -> [Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine (Maybe Semantic -> Gutter
Unnumbered (Semantic -> Maybe Semantic
forall a. a -> Maybe a
Just Semantic
FooterInfo)) [] Word
0 [(Text
link, Style
linkStyle)] Maybe (Style, Connector)
forall a. Maybe a
Nothing]) Maybe Text
li Seq RenderLine -> RenderLine -> Seq RenderLine
forall a. Seq a -> a -> Seq a
:|> Gutter -> RenderLine
go Gutter
Footer
          )
  )
  where
    go :: Gutter -> RenderLine
go Gutter
g = Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine Gutter
g [] Word
0 [] Maybe (Style, Connector)
forall a. Maybe a
Nothing
    (Word
pad, Seq RenderLine
bg) = LayoutOptions
-> Line -> Line -> Vector DocText -> (Word, Seq RenderLine)
buildGutter LayoutOptions
lo Line
s Line
e Vector DocText
lines'

highlightSpans :: [(Column, Column, Style)] -> [(Text, Style)] -> [(Text, Style)]
highlightSpans :: [(Column, Column, Style)] -> [(Text, Style)] -> [(Text, Style)]
highlightSpans [(Column, Column, Style)]
hls = Word -> [(Text, Style)] -> [(Text, Style)]
go Word
1
  where
    go :: Word -> [(Text, Style)] -> [(Text, Style)]
    go :: Word -> [(Text, Style)] -> [(Text, Style)]
go Word
_col [] = []
    go Word
col ((Text
t, Style
st) : [(Text, Style)]
rest) =
      let cs :: [(Char, Style)]
cs = (Word -> (Char, Style) -> (Char, Style))
-> [Word] -> [(Char, Style)] -> [(Char, Style)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word -> (Char, Style) -> (Char, Style)
go' [Word
Item [Word]
col ..] ((Char -> (Char, Style)) -> [Char] -> [(Char, Style)]
forall a b. (a -> b) -> [a] -> [b]
map (,Style
st) (Text -> [Char]
T.unpack Text
t))
       in [(Text, Style)] -> [(Text, Style)]
coalesce (((Char, Style) -> (Text, Style))
-> [(Char, Style)] -> [(Text, Style)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Text) -> (Char, Style) -> (Text, Style)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Char -> Text
T.singleton) [(Char, Style)]
cs) [(Text, Style)] -> [(Text, Style)] -> [(Text, Style)]
forall a. [a] -> [a] -> [a]
++ Word -> [(Text, Style)] -> [(Text, Style)]
go (Word
col Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t)) [(Text, Style)]
rest

    coalesce :: [(Text, Style)] -> [(Text, Style)]
    coalesce :: [(Text, Style)] -> [(Text, Style)]
coalesce ((Text
t, Style
st) : (Text
t', Style
st') : [(Text, Style)]
rest) | Style
st Style -> Style -> Bool
forall a. Eq a => a -> a -> Bool
== Style
st' = [(Text, Style)] -> [(Text, Style)]
coalesce ((Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t', Style
st') (Text, Style) -> [(Text, Style)] -> [(Text, Style)]
forall a. a -> [a] -> [a]
: [(Text, Style)]
rest)
    coalesce ((Text, Style)
a : [(Text, Style)]
as) = (Text, Style)
a (Text, Style) -> [(Text, Style)] -> [(Text, Style)]
forall a. a -> [a] -> [a]
: [(Text, Style)] -> [(Text, Style)]
coalesce [(Text, Style)]
as
    coalesce [] = []

    go' :: Word -> (Char, Style) -> (Char, Style)
    go' :: Word -> (Char, Style) -> (Char, Style)
go' Word
col (Char
c, Style
s) =
      ( Char
c,
        Style
s
          Style -> Style -> Style
forall a. Semigroup a => a -> a -> a
<> [Style] -> Style
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            ( ((Column, Column, Style) -> Maybe Style)
-> [(Column, Column, Style)] -> [Style]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                (\(Column
s', Column
e, Style
st) -> if Column
s' Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Column
Column Word
col Bool -> Bool -> Bool
&& Word -> Column
Column Word
col Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
e then Style -> Maybe Style
forall a. a -> Maybe a
Just Style
st else Maybe Style
forall a. Maybe a
Nothing)
                [(Column, Column, Style)]
hls
            )
      )

data MultiKind
  = Single (Maybe DocText)
  | Multi
  | MultiEnd (Maybe DocText)

data RenderHighlight = RenderHighlight
  { RenderHighlight -> Column
hiStart :: Column,
    RenderHighlight -> Column
hiEnd :: Column,
    RenderHighlight -> Style
hiStyle :: Style,
    RenderHighlight -> MultiKind
multiKind :: MultiKind,
    RenderHighlight -> Maybe Semantic
hiSem :: Maybe Semantic
  }

underlineHighlight :: Config -> [RenderHighlight] -> Seq RenderLine
underlineHighlight :: Config -> [RenderHighlight] -> Seq RenderLine
underlineHighlight Config
config [RenderHighlight]
highlights = [RenderLine] -> Seq RenderLine
forall a. [a] -> Seq a
Seq.fromList ([RenderLine] -> Seq RenderLine) -> [RenderLine] -> Seq RenderLine
forall a b. (a -> b) -> a -> b
$ [RenderHighlight]
highlights [RenderHighlight]
-> (RenderHighlight -> [RenderLine]) -> [RenderLine]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RenderHighlight -> [RenderLine]
go
  where
    go :: RenderHighlight -> [RenderLine]
go (RenderHighlight (Column Word
cs') (Column Word
ce') Style
st MultiKind
mk Maybe Semantic
sem) =
      let mid :: Word
mid = (Word
cs' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
ce') Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
2
          underline :: Text
underline =
            if
                | Word
ce' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
cs' -> Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Char
highlightUnderDown Config
config
                | Word
ce' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
cs' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 -> Char -> Text
T.singleton (Config -> Char
highlightTwospan Config
config) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton (Config -> Char
highlightUnderRight Config
config)
                | Bool
otherwise ->
                  Char -> Text
T.singleton (Config -> Char
highlightUnderLeft Config
config)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
mid Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
cs' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Char
highlightUnder Config
config)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton (Config -> Char
highlightUnderDown Config
config)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
ce' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
mid Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Char
highlightUnder Config
config)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton (Config -> Char
highlightUnderRight Config
config)
          connector :: Connector
connector
            | MultiKind
Multi <- MultiKind
mk = Connector
MultiConnector
            | MultiEnd Maybe DocText
_ <- MultiKind
mk = Connector
MultiEndConnector
            | PageWidth
Unbounded <- LayoutOptions -> PageWidth
layoutPageWidth (Config -> LayoutOptions
layoutOptions Config
config) = Connector
RightConnector
            | AvailablePerLine Int
n Double
_x <- LayoutOptions -> PageWidth
layoutPageWidth (LayoutOptions -> PageWidth) -> LayoutOptions -> PageWidth
forall a b. (a -> b) -> a -> b
$ Config -> LayoutOptions
layoutOptions Config
config,
              Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
mid =
              Connector
RightConnector
            | Bool
otherwise = Connector
LeftConnector
          t :: Maybe DocText
t = case MultiKind
mk of
            Single Maybe DocText
d -> Maybe DocText
d
            MultiKind
Multi -> Maybe DocText
forall a. Maybe a
Nothing
            MultiEnd Maybe DocText
d -> Maybe DocText
d
          z :: [(Maybe Connector, [(Text, Style)])]
z = [Maybe Connector]
-> [[(Text, Style)]] -> [(Maybe Connector, [(Text, Style)])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Connector -> Maybe Connector
forall a. a -> Maybe a
Just Connector
connector Maybe Connector -> [Maybe Connector] -> [Maybe Connector]
forall a. a -> [a] -> [a]
: Maybe Connector -> [Maybe Connector]
forall a. a -> [a]
repeat Maybe Connector
forall a. Maybe a
Nothing) (Seq [(Text, Style)] -> [[(Text, Style)]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc (Config -> LayoutOptions
layoutOptions Config
config) (Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
st (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ DocText -> Maybe DocText -> DocText
forall a. a -> Maybe a -> a
fromMaybe DocText
forall a. Monoid a => a
mempty Maybe DocText
t)))
       in Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine (Maybe Semantic -> Gutter
Unnumbered Maybe Semantic
forall a. Maybe a
Nothing) [] (Word
cs' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) [(Text
underline, Style
st)] Maybe (Style, Connector)
forall a. Maybe a
Nothing RenderLine -> [RenderLine] -> [RenderLine]
forall a. a -> [a] -> [a]
:
          ([(Maybe Connector, [(Text, Style)])]
z [(Maybe Connector, [(Text, Style)])]
-> ((Maybe Connector, [(Text, Style)]) -> RenderLine)
-> [RenderLine]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe Connector
conn, [(Text, Style)]
l) -> Gutter
-> [MultiSpan]
-> Word
-> [(Text, Style)]
-> Maybe (Style, Connector)
-> RenderLine
RenderLine (if Maybe Connector -> Bool
forall a. Maybe a -> Bool
isJust Maybe Connector
conn then Maybe Semantic -> Gutter
Unnumbered Maybe Semantic
sem else Maybe Semantic -> Gutter
Unnumbered Maybe Semantic
forall a. Maybe a
Nothing) [] Word
mid [(Text, Style)]
l ((Style
st,) (Connector -> (Style, Connector))
-> Maybe Connector -> Maybe (Style, Connector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Connector
conn))

-- | Renders a 'Diagnostic' using the provided 'Config' into a 'DocText'.
render :: Config -> Diagnostic -> DocText
render :: Config -> Diagnostic -> DocText
render Config
config (Diagnostic Maybe Text
co Severity
se Maybe DocText
me Maybe DocText
he Maybe Text
li Maybe (NonEmptyVector Snippet)
snip) =
  let sgr :: Style
sgr = case Severity
se of
        Severity
Info -> Config -> Style
infoStyle Config
config
        Severity
Warning -> Config -> Style
warningStyle Config
config
        Severity
Error -> Config -> Style
errorStyle Config
config

      code :: Maybe DocText
code =
        Maybe Text
co Maybe Text -> (Text -> DocText) -> Maybe DocText
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
co' ->
          Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
sgr (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$
            DocText -> DocText
forall ann. Doc ann -> Doc ann
brackets (Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Text
co') DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
": "
      label' :: DocText
label' = Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
sgr (DocText -> DocText) -> DocText -> DocText
forall a b. (a -> b) -> a -> b
$ [Char] -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty (Severity -> [Char]
forall a. Show a => a -> [Char]
show Severity
se) DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
": "
      mess :: DocText
mess = DocText -> Maybe DocText -> DocText
forall a. a -> Maybe a -> a
fromMaybe DocText
forall a. Monoid a => a
mempty Maybe DocText
me DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
forall ann. Doc ann
hardline
      snips :: Vector Snippet
      snips :: Vector Snippet
snips = Vector Snippet
-> (NonEmptyVector Snippet -> Vector Snippet)
-> Maybe (NonEmptyVector Snippet)
-> Vector Snippet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Snippet
forall a. Monoid a => a
mempty NonEmptyVector Snippet -> Vector Snippet
forall a. NonEmptyVector a -> Vector a
DVNE.toVector Maybe (NonEmptyVector Snippet)
snip
      body :: DocText
body = ((Int, Snippet) -> DocText) -> [(Int, Snippet)] -> DocText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Snippet) -> DocText
go ([Int] -> [Snippet] -> [(Int, Snippet)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [Int]
0..] (Vector Snippet -> [Snippet]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector Snippet
snips))
      inCaseNoSnippets :: DocText
inCaseNoSnippets = DocText
-> (NonEmptyVector Snippet -> DocText)
-> Maybe (NonEmptyVector Snippet)
-> DocText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DocText
showFooter (DocText -> NonEmptyVector Snippet -> DocText
forall a b. a -> b -> a
const DocText
forall a. Monoid a => a
mempty) Maybe (NonEmptyVector Snippet)
snip
   in DocText -> Maybe DocText -> DocText
forall a. a -> Maybe a -> a
fromMaybe DocText
forall a. Monoid a => a
mempty Maybe DocText
code DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
label' DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
mess DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
body DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
inCaseNoSnippets
  where
    showFooter :: DocText
showFooter = ([(Text, Style)] -> DocText) -> Seq [(Text, Style)] -> DocText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((Text, Style) -> DocText) -> [(Text, Style)] -> DocText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Text
t, Style
s) -> Style -> DocText -> DocText
forall ann. ann -> Doc ann -> Doc ann
annotate Style
s (Text -> DocText
forall a ann. Pretty a => a -> Doc ann
pretty Text
t) DocText -> DocText -> DocText
forall a. Semigroup a => a -> a -> a
<> DocText
forall ann. Doc ann
hardline)) (Seq [(Text, Style)] -> DocText) -> Seq [(Text, Style)] -> DocText
forall a b. (a -> b) -> a -> b
$
        LayoutOptions -> DocText -> Seq [(Text, Style)]
buildDoc (Config -> LayoutOptions
layoutOptions Config
config) (DocText -> Maybe DocText -> DocText
forall a. a -> Maybe a -> a
fromMaybe DocText
forall a. Monoid a => a
mempty Maybe DocText
he)
           Seq [(Text, Style)] -> Seq [(Text, Style)] -> Seq [(Text, Style)]
forall a. Semigroup a => a -> a -> a
<> Seq [(Text, Style)]
-> (Text -> Seq [(Text, Style)])
-> Maybe Text
-> Seq [(Text, Style)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq [(Text, Style)]
forall a. Monoid a => a
mempty (\Text
link -> [[(Text
link, Config -> Style
linkStyle Config
config)]]) Maybe Text
li

    go :: (Int, Snippet) -> DocText
go (Int
i, Snippet (Maybe Text
source, ln :: Line
ln@(Line Word
ln'), Column
col) Maybe (NonEmptyVector Highlight)
highlights' Vector DocText
lines') =
      (RenderLine -> DocText) -> Seq RenderLine -> DocText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (Config -> Word -> RenderLine -> DocText
renderLine Config
config Word
pad)
        ( Seq RenderLine -> Seq RenderLine
renderMulti (Seq RenderLine -> Seq RenderLine)
-> Seq RenderLine -> Seq RenderLine
forall a b. (a -> b) -> a -> b
$
            Seq RenderLine
fullGutter Seq RenderLine -> (RenderLine -> Seq RenderLine) -> Seq RenderLine
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RenderLine
rl ->
              case RenderLine -> Gutter
gutter RenderLine
rl of
                Numbered Line
li' -> RenderLine
rl RenderLine -> Seq RenderLine -> Seq RenderLine
forall a. a -> Seq a -> Seq a
:<| Seq RenderLine
-> ([RenderHighlight] -> Seq RenderLine)
-> Maybe [RenderHighlight]
-> Seq RenderLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq RenderLine
forall a. Monoid a => a
mempty (Config -> [RenderHighlight] -> Seq RenderLine
underlineHighlight Config
config) (Line -> Map Line [RenderHighlight] -> Maybe [RenderHighlight]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Line
li' Map Line [RenderHighlight]
highlights)
                Gutter
_ -> [Item (Seq RenderLine)
RenderLine
rl]
        )
      where
        hls :: [(Style, Highlight)]
hls =
          [Style] -> [Highlight] -> [(Style, Highlight)]
forall a b. [a] -> [b] -> [(a, b)]
zip
            (if Config -> Bool
colourizeHighlights Config
config then (Colour Double -> Style) -> [Colour Double] -> [Style]
forall a b. (a -> b) -> [a] -> [b]
map (StyleColor -> Style
styleFG (StyleColor -> Style)
-> (Colour Double -> StyleColor) -> Colour Double -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Float -> StyleColor
ColorRGB (Colour Float -> StyleColor)
-> (Colour Double -> Colour Float) -> Colour Double -> StyleColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Double -> Colour Float
forall b a. (Fractional b, Real a) => Colour a -> Colour b
colourConvert) (Double -> [Colour Double]
spacedColors Double
75.0) else Style -> [Style]
forall a. a -> [a]
repeat Style
forall a. Monoid a => a
mempty)
            ([Highlight]
-> (NonEmptyVector Highlight -> [Highlight])
-> Maybe (NonEmptyVector Highlight)
-> [Highlight]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Highlight]
forall a. Monoid a => a
mempty NonEmptyVector Highlight -> [Highlight]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (NonEmptyVector Highlight)
highlights')

        fromList' :: Ord k => [(k, v)] -> Map k [v]
        fromList' :: [(k, v)] -> Map k [v]
fromList' = ((k, v) -> Map k [v] -> Map k [v])
-> Map k [v] -> [(k, v)] -> Map k [v]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(k
k, v
v) Map k [v]
m -> ([v] -> [v] -> [v]) -> k -> [v] -> Map k [v] -> Map k [v]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [v] -> [v] -> [v]
forall a. Semigroup a => a -> a -> a
(<>) k
k [v
Item [v]
v] Map k [v]
m) Map k [v]
forall a. Monoid a => a
mempty

        highlights :: Map Line [RenderHighlight]
highlights =
          [(Line, RenderHighlight)] -> Map Line [RenderHighlight]
forall k v. Ord k => [(k, v)] -> Map k [v]
fromList' ([(Line, RenderHighlight)] -> Map Line [RenderHighlight])
-> [(Line, RenderHighlight)] -> Map Line [RenderHighlight]
forall a b. (a -> b) -> a -> b
$
            ((Int, (Style, Highlight)) -> [(Line, RenderHighlight)])
-> [(Int, (Style, Highlight))] -> [(Line, RenderHighlight)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
              ( \(Int
name, (Style
style, Highlight Maybe DocText
label' NonEmptyVector (Line, Column, Column)
spans)) ->
                  ( \(Integer
j :: Integer, (Line
l, Column
cs, Column
ce)) ->
                      ( Line
l,
                        Column
-> Column
-> Style
-> MultiKind
-> Maybe Semantic
-> RenderHighlight
RenderHighlight
                          Column
cs
                          Column
ce
                          Style
style
                          if
                              | NonEmptyVector (Line, Column, Column) -> Int
forall a. NonEmptyVector a -> Int
DVNE.length NonEmptyVector (Line, Column, Column)
spans Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2, Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NonEmptyVector (Line, Column, Column) -> Int
forall a. NonEmptyVector a -> Int
DVNE.length NonEmptyVector (Line, Column, Column)
spans Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -> Maybe DocText -> MultiKind
MultiEnd Maybe DocText
label'
                              | NonEmptyVector (Line, Column, Column) -> Int
forall a. NonEmptyVector a -> Int
DVNE.length NonEmptyVector (Line, Column, Column)
spans Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 -> MultiKind
Multi
                              | Bool
otherwise -> Maybe DocText -> MultiKind
Single Maybe DocText
label'
                          if
                              | Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Semantic -> Maybe Semantic
forall a. a -> Maybe a
Just (Semantic -> Maybe Semantic) -> Semantic -> Maybe Semantic
forall a b. (a -> b) -> a -> b
$ Int -> Semantic
FirstConnectorFor Int
name
                              | Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NonEmptyVector (Line, Column, Column) -> Int
forall a. NonEmptyVector a -> Int
DVNE.length NonEmptyVector (Line, Column, Column)
spans Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -> Semantic -> Maybe Semantic
forall a. a -> Maybe a
Just (Semantic -> Maybe Semantic) -> Semantic -> Maybe Semantic
forall a b. (a -> b) -> a -> b
$ Int -> Semantic
LastConnectorFor Int
name
                              | Bool
otherwise -> Semantic -> Maybe Semantic
forall a. a -> Maybe a
Just (Semantic -> Maybe Semantic) -> Semantic -> Maybe Semantic
forall a b. (a -> b) -> a -> b
$ Int -> Semantic
MidConnectorFor Int
name
                      )
                  )
                    ((Integer, (Line, Column, Column)) -> (Line, RenderHighlight))
-> [(Integer, (Line, Column, Column))] -> [(Line, RenderHighlight)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
-> [(Line, Column, Column)] -> [(Integer, (Line, Column, Column))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [Integer]
0 ..] (NonEmptyVector (Line, Column, Column) -> [(Line, Column, Column)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmptyVector (Line, Column, Column)
spans)
              )
              ([Int] -> [(Style, Highlight)] -> [(Int, (Style, Highlight))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [Int]
0 ..] [(Style, Highlight)]
hls)

        multilineHighlights :: [((Int, Style), [(Line, Column, Column)])]
        multilineHighlights :: [((Int, Style), [(Line, Column, Column)])]
multilineHighlights = ((Int, (Style, Highlight))
 -> Maybe ((Int, Style), [(Line, Column, Column)]))
-> [(Int, (Style, Highlight))]
-> [((Int, Style), [(Line, Column, Column)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
k, (Style
st, Highlight
hi)) -> if NonEmptyVector (Line, Column, Column) -> Int
forall a. NonEmptyVector a -> Int
DVNE.length (Highlight -> NonEmptyVector (Line, Column, Column)
spans Highlight
hi) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 then ((Int, Style), [(Line, Column, Column)])
-> Maybe ((Int, Style), [(Line, Column, Column)])
forall a. a -> Maybe a
Just ((Int
k, Style
st), NonEmptyVector (Line, Column, Column) -> [(Line, Column, Column)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Highlight -> NonEmptyVector (Line, Column, Column)
spans Highlight
hi)) else Maybe ((Int, Style), [(Line, Column, Column)])
forall a. Maybe a
Nothing) ([Int] -> [(Style, Highlight)] -> [(Int, (Style, Highlight))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [Int]
0 ..] [(Style, Highlight)]
hls)
        multilineHighlights' :: [Map Line [(Column, Column)]]
        multilineHighlights' :: [Map Line [(Column, Column)]]
multilineHighlights' = (((Int, Style), [(Line, Column, Column)])
 -> Map Line [(Column, Column)])
-> [((Int, Style), [(Line, Column, Column)])]
-> [Map Line [(Column, Column)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Line, (Column, Column))] -> Map Line [(Column, Column)]
forall k v. Ord k => [(k, v)] -> Map k [v]
fromList' ([(Line, (Column, Column))] -> Map Line [(Column, Column)])
-> (((Int, Style), [(Line, Column, Column)])
    -> [(Line, (Column, Column))])
-> ((Int, Style), [(Line, Column, Column)])
-> Map Line [(Column, Column)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Line, Column, Column) -> (Line, (Column, Column)))
-> [(Line, Column, Column)] -> [(Line, (Column, Column))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Line
l, Column
cs, Column
ce) -> (Line
l, (Column
cs, Column
ce))) ([(Line, Column, Column)] -> [(Line, (Column, Column))])
-> (((Int, Style), [(Line, Column, Column)])
    -> [(Line, Column, Column)])
-> ((Int, Style), [(Line, Column, Column)])
-> [(Line, (Column, Column))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Style), [(Line, Column, Column)])
-> [(Line, Column, Column)]
forall a b. (a, b) -> b
snd) [((Int, Style), [(Line, Column, Column)])]
multilineHighlights
        multilineHighlights'' :: [Set Line]
        multilineHighlights'' :: [Set Line]
multilineHighlights'' =
          (Map Line [(Column, Column)] -> Set Line)
-> [Map Line [(Column, Column)]] -> [Set Line]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \Map Line [(Column, Column)]
m -> case (Map Line [(Column, Column)] -> Maybe (Line, [(Column, Column)])
forall k a. Map k a -> Maybe (k, a)
Map.lookupMin Map Line [(Column, Column)]
m, Map Line [(Column, Column)] -> Maybe (Line, [(Column, Column)])
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Line [(Column, Column)]
m) of
                (Just (Line
mini, [(Column, Column)]
_), Just (Line
maxi, [(Column, Column)]
_)) -> [Line] -> Set Line
forall a. Ord a => [a] -> Set a
Set.fromList [Item [Line]
Line
mini .. Item [Line]
Line
maxi]
                (Maybe (Line, [(Column, Column)]),
 Maybe (Line, [(Column, Column)]))
_ -> Set Line
forall a. Monoid a => a
mempty
            )
            [Map Line [(Column, Column)]]
multilineHighlights'
        multilineHighlights''' :: [((Int, Style), Set Line)]
        multilineHighlights''' :: [((Int, Style), Set Line)]
multilineHighlights''' = [(Int, Style)] -> [Set Line] -> [((Int, Style), Set Line)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((((Int, Style), [(Line, Column, Column)]) -> (Int, Style))
-> [((Int, Style), [(Line, Column, Column)])] -> [(Int, Style)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Style), [(Line, Column, Column)]) -> (Int, Style)
forall a b. (a, b) -> a
fst [((Int, Style), [(Line, Column, Column)])]
multilineHighlights) [Set Line]
multilineHighlights''

        (Word
pad, Seq RenderLine
gutter') = Bool
-> Style
-> LayoutOptions
-> Maybe Text
-> Line
-> Column
-> Line
-> Vector DocText
-> Maybe DocText
-> Maybe Text
-> (Word, Seq RenderLine)
buildGutter' (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
-> (NonEmptyVector Snippet -> Int)
-> Maybe (NonEmptyVector Snippet)
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmptyVector Snippet -> Int
forall a. NonEmptyVector a -> Int
DVNE.length Maybe (NonEmptyVector Snippet)
snip Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Config -> Style
linkStyle Config
config) (Config -> LayoutOptions
layoutOptions Config
config) Maybe Text
source Line
ln Column
col (Word -> Line
Line (Word -> Line) -> Word -> Line
forall a b. (a -> b) -> a -> b
$ Word
ln' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector DocText -> Int
forall a. Vector a -> Int
V.length Vector DocText
lines')) Vector DocText
lines' Maybe DocText
he Maybe Text
li

        forget :: [RenderHighlight] -> [(Column, Column, Style)]
forget = (RenderHighlight -> (Column, Column, Style))
-> [RenderHighlight] -> [(Column, Column, Style)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(RenderHighlight Column
cs Column
ce Style
st MultiKind
_ Maybe Semantic
_) -> (Column
cs, Column
ce, Style
st))
        hlGutter :: Seq RenderLine
hlGutter =
          Seq RenderLine
gutter' Seq RenderLine -> (RenderLine -> RenderLine) -> Seq RenderLine
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RenderLine
rl -> case RenderLine -> Gutter
gutter RenderLine
rl of
            Numbered Line
li' -> RenderLine
rl {$sel:renderedContent:RenderLine :: [(Text, Style)]
renderedContent = ([(Text, Style)] -> [(Text, Style)])
-> ([(Column, Column, Style)]
    -> [(Text, Style)] -> [(Text, Style)])
-> Maybe [(Column, Column, Style)]
-> [(Text, Style)]
-> [(Text, Style)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Style)] -> [(Text, Style)]
forall a. a -> a
id [(Column, Column, Style)] -> [(Text, Style)] -> [(Text, Style)]
highlightSpans ([RenderHighlight] -> [(Column, Column, Style)]
forget ([RenderHighlight] -> [(Column, Column, Style)])
-> Maybe [RenderHighlight] -> Maybe [(Column, Column, Style)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> Map Line [RenderHighlight] -> Maybe [RenderHighlight]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Line
li' Map Line [RenderHighlight]
highlights) ([(Text, Style)] -> [(Text, Style)])
-> [(Text, Style)] -> [(Text, Style)]
forall a b. (a -> b) -> a -> b
$ RenderLine -> [(Text, Style)]
renderedContent RenderLine
rl}
            Gutter
_ -> RenderLine
rl
        fullGutter :: Seq RenderLine
fullGutter = if Config -> Bool
colourizeHighlights Config
config then Seq RenderLine
hlGutter else Seq RenderLine
gutter'

        renderMulti :: Seq RenderLine -> Seq RenderLine
        renderMulti :: Seq RenderLine -> Seq RenderLine
renderMulti Seq RenderLine
s =
          (((Int, Style), Set Line) -> Seq RenderLine -> Seq RenderLine)
-> Seq RenderLine -> [((Int, Style), Set Line)] -> Seq RenderLine
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            ( \((Int
i', Style
st), Set Line
_ls) Seq RenderLine
ls' ->
                (Bool, Seq RenderLine) -> Seq RenderLine
forall a b. (a, b) -> b
snd ((Bool, Seq RenderLine) -> Seq RenderLine)
-> (Bool, Seq RenderLine) -> Seq RenderLine
forall a b. (a -> b) -> a -> b
$
                  (Bool -> RenderLine -> (Bool, RenderLine))
-> Bool -> Seq RenderLine -> (Bool, Seq RenderLine)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
                    ( \Bool
isStyled RenderLine
rl ->
                        let (Bool
isStyled', MultiSpan
c) = case RenderLine -> Gutter
gutter RenderLine
rl of
                              Unnumbered (Just (FirstConnectorFor Int
j)) | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> (Bool
True, Style -> TeeLocation -> MultiSpan
Tee Style
st TeeLocation
TeeTop)
                              Unnumbered (Just (MidConnectorFor Int
j)) | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> (Bool
True, Style -> TeeLocation -> MultiSpan
Tee Style
st TeeLocation
TeeMid)
                              Unnumbered (Just (LastConnectorFor Int
j)) | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> (Bool
False, Style -> TeeLocation -> MultiSpan
Tee Style
st TeeLocation
TeeBottom)
                              Unnumbered (Just Semantic
FooterInfo) -> (Bool
False, MultiSpan
NoMulti)
                              Gutter
Footer -> (Bool
False, MultiSpan
NoMulti)
                              Gutter
_ -> (Bool
isStyled, if Bool
isStyled then Style -> MultiSpan
Vee Style
st else MultiSpan
NoMulti)
                         in (Bool
isStyled', RenderLine
rl {$sel:multispans:RenderLine :: [MultiSpan]
multispans = MultiSpan
c MultiSpan -> [MultiSpan] -> [MultiSpan]
forall a. a -> [a] -> [a]
: RenderLine -> [MultiSpan]
multispans RenderLine
rl})
                    )
                    Bool
False
                    Seq RenderLine
ls'
            )
            Seq RenderLine
s
            [((Int, Style), Set Line)]
multilineHighlights'''

-- ──────────────────────────────── Testing ──────────────────────────────── --
-- colourTest :: IO ()
-- colourTest = go (zip (spacedColors 75.0) (words "This is a colour test! Fugiat excepturi illo nihil porro voluptatem. Repellendus velit quibusdam aut dolorem. Quis non ipsa qui molestiae explicabo quos. Sed dolorum laborum expedita exercitationem sit quaerat veniam culpa. Voluptas quas molestiae earum delectus veniam officia ut ut. Cupiditate tenetur libero quibusdam maiores ea. Est consequuntur perferendis est optio officia aliquid ratione. Velit hic eaque qui voluptatibus ipsam. Rem facilis temporibus corporis quia perferendis. Commodi vero laborum esse voluptas est numquam. Laudantium fuga aliquam repudiandae explicabo ut dolores beatae. Pariatur et provident consequatur optio neque asperiores voluptatem necessitatibus. Iusto nam sint et. Non qui cupiditate porro corporis qui. Dignissimos voluptates iusto dolor. Itaque minus et sed qui non quidem. Perspiciatis omnis id eaque. Quis rerum architecto magni qui iure nisi voluptatum. Omnis esse pariatur pariatur non. Fugiat provident voluptate maxime cupiditate unde consequatur at id. Praesentium molestiae consectetur sequi dolor qui nulla vel fuga. Enim aut assumenda recusandae. Et quisquam architecto quasi aut nihil unde et dolores. Delectus qui esse sapiente ut. Eum ut quis expedita reprehenderit et nihil odio sint. Molestias quidem iusto delectus est consequatur voluptas possimus. Neque reiciendis maiores cumque a non nihil."))
--   where
--     go :: [(Colour Double, String)] -> IO ()
--     go [] = putStrLn "" >> setSGR []
--     go ((c, s) : rest) = do
--       setSGR [SetRGBColor Foreground (colourConvert c)]
--       putStr s
--       putStr " "
--       go rest

-- displayDiag :: Diagnostic -> IO ()
-- displayDiag = render asciiColorConfig >>> layoutPretty defaultLayoutOptions >>> putDocText

-- testDiag :: Diagnostic
-- testDiag =
--   Diagnostic
--     (Just "E0001")
--     Error
--     (Just "Found a bug!")
--     (Just "Note: your code is broken!")
--     (Just "https://sofia.sofia")
--     ( DVNE.fromVector
--         [ Snippet
--             (Just "sofia.ð", Line 99, Column 1)
--             ( DVNE.fromVector
--                 [ Highlight (Just "unrecognized type 'imt'") (DVNE.singleton (Line 99, Column 13, Column 15)),
--                   Highlight
--                     (Just "note: maybe you mean 'int' to match with y?")
--                     ( DVNE.singleton (Line 100, Column 9, Column 13) <> DVNE.singleton (Line 101, Column 9, Column 9)
--                     )
--                 ]
--             )
--             [ "def blah(x: imt): int",
--               "        y = x",
--               "        y"
--             ]
--         ]
--     )

-- testDiag2 :: Diagnostic
-- testDiag2 =
--   Diagnostic
--     (Just "E0002")
--     Info
--     (Just $ "Edge case " <> annotate (styleItalicized True) "testing!")
--     (Just ("Note: we can have " <> annotate (styleFG (Color16 Vivid Cyan)) "colors!"))
--     (Just "https://sofia.sofia")
--     ( DVNE.fromVector
--         [ Snippet
--             (Just "sofia.ð", Line 99999, Column 1)
--             ( DVNE.fromVector
--                 [ Highlight (Just "small label") (DVNE.singleton (Line 99999, Column 1, Column 2)),
--                   Highlight
--                     (Just "overlap")
--                     ( DVNE.singleton (Line 100000, Column 1, Column 4) <> DVNE.singleton (Line 100000, Column 3, Column 7)
--                     )
--                 ]
--             )
--             [ "tiny",
--               "overlap"
--             ]
--         ]
--     )

-- testDiag3 :: Diagnostic
-- testDiag3 =
--   Diagnostic
--     (Just "E0003")
--     Info
--     Nothing
--     Nothing
--     Nothing
--     ( DVNE.fromVector
--         [ Snippet
--             (Nothing, Line 9, Column 1)
--             ( DVNE.fromVector
--                 [ Highlight (Just "overlapping 1") (DVNE.singleton (Line 9, Column 1, Column 4) <> DVNE.singleton (Line 10, Column 1, Column 4)),
--                   Highlight (Just "overlapping 2") (DVNE.singleton (Line 10, Column 1, Column 4) <> DVNE.singleton (Line 11, Column 1, Column 4)),
--                   Highlight (Just "overlapping 3") (DVNE.singleton (Line 9, Column 1, Column 4) <> DVNE.singleton (Line 12, Column 1, Column 4) <> DVNE.singleton (Line 13, Column 1, Column 4))
--                 ]
--             )
--             [ "blah",
--               "blaz",
--               "sofi",
--               "bing",
--               "cute"
--             ]
--         ]
--     )