{-# language CPP                   #-}
{-# language DeriveDataTypeable    #-}
{-# language DeriveGeneric         #-}
{-# language FlexibleInstances     #-}
{-# language MultiParamTypeClasses #-}
{-# language TemplateHaskell       #-}
{-# language TypeSynonymInstances  #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2019 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- The type for Lines will very likely change over time, to enable drawing
-- lit up multi-character versions of control characters for @^Z@, @^[@,
-- @<0xff>@, etc. This will make for much nicer diagnostics when
-- working with protocols.
--
----------------------------------------------------------------------------
module Text.Trifecta.Rendering
  ( Rendering(Rendering)
  , HasRendering(..)
  , nullRendering
  , emptyRendering
  , prettyRendering
  , Source(..)
  , rendered
  , Renderable(..)
  , Rendered(..)
  , gutterEffects
  -- * Carets
  , Caret(..)
  , HasCaret(..)
  , Careted(..)
  , drawCaret
  , addCaret
  , caretEffects
  , renderingCaret
  -- * Spans
  , Span(..)
  , HasSpan(..)
  , Spanned(..)
  , spanEffects
  , drawSpan
  , addSpan
  -- * Fixits
  , Fixit(..)
  , HasFixit(..)
  , drawFixit
  , addFixit
  -- * Drawing primitives
  , Lines
  , draw
  , ifNear
  , (.#)
  ) where

import           Control.Applicative
import           Control.Comonad
import           Control.Lens
import           Data.Array
import           Data.ByteString                              as B hiding (any, empty, groupBy)
import qualified Data.ByteString.UTF8                         as UTF8
import           Data.Data
import           Data.Foldable
import           Data.Function                                (on)
import           Data.Hashable
import           Data.Int                                     (Int64)
import qualified Data.List.NonEmpty                           as NE
import           Data.Maybe
import           Data.Semigroup
import           Data.Semigroup.Reducer
import           GHC.Generics
import           Prelude                                      as P hiding (span)
import           Prettyprinter                                hiding (column, line')
import           Prettyprinter.Render.Terminal                (color, bgColor, colorDull, bgColorDull)
import qualified Prettyprinter.Render.Terminal                as Pretty
import           System.Console.ANSI

import Text.Trifecta.Delta
import Text.Trifecta.Util.Combinators
import Text.Trifecta.Util.Pretty

-- $setup
--
-- >>> :set -XOverloadedStrings
-- >>> import Data.ByteString (ByteString)
-- >>> import Data.Monoid (mempty)
-- >>> import Prettyprinter (unAnnotate)
-- >>> import Text.Trifecta.Delta
-- >>> let exampleRendering = rendered mempty ("int main(int argc, char ** argv) { int; }" :: ByteString)

outOfRangeEffects :: [SGR] -> [SGR]
outOfRangeEffects :: [SGR] -> [SGR]
outOfRangeEffects [SGR]
xs = ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity SGR -> [SGR] -> [SGR]
forall a. a -> [a] -> [a]
: [SGR]
xs

sgr :: [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
sgr :: [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
sgr [SGR]
xs0 = [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go ([SGR] -> [SGR]
forall a. [a] -> [a]
P.reverse [SGR]
xs0) where
  go :: [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go []                                         = Doc AnsiStyle -> Doc AnsiStyle
forall a. a -> a
id
  go (SetConsoleIntensity ConsoleIntensity
NormalIntensity : [SGR]
xs) = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
debold (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetConsoleIntensity ConsoleIntensity
BoldIntensity   : [SGR]
xs) = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetUnderlining Underlining
NoUnderline          : [SGR]
xs) = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
deunderline (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetUnderlining Underlining
SingleUnderline      : [SGR]
xs) = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
underlined (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetColor ConsoleLayer
f ColorIntensity
i Color
c                      : [SGR]
xs) = case ConsoleLayer
f of
#if MIN_VERSION_ansi_terminal(1,1,0)
    ConsoleLayer
Underlining -> [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
#endif
    ConsoleLayer
Foreground -> case ColorIntensity
i of
      ColorIntensity
Dull -> case Color
c of
        Color
Black   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Black) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Red) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Green) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Yellow) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Blue) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Magenta) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Cyan) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.White) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
      ColorIntensity
Vivid -> case Color
c of
        Color
Black   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Black) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Red) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Green) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Yellow) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Blue) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Magenta) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Cyan) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.White) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
    ConsoleLayer
Background -> case ColorIntensity
i of
      ColorIntensity
Dull -> case Color
c of
        Color
Black   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Black) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Red) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Green) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Yellow) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Blue) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Magenta) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Cyan) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.White) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
      ColorIntensity
Vivid -> case Color
c of
        Color
Black   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Black) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Red) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Green) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Yellow) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Blue) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Magenta) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Cyan) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.White) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Doc AnsiStyle -> Doc AnsiStyle)
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SGR
_                                   : [SGR]
xs) = [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs

-- | A raw canvas to paint ANSI-styled characters on.
type Lines = Array (Int,Int64) ([SGR], Char)

-- | Remove a number of @(index, element)@ values from an @'Array'@.
(///) :: Ix i => Array i e -> [(i, e)] -> Array i e
Array i e
a /// :: forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
/// [(i, e)]
xs = Array i e
a Array i e -> [(i, e)] -> Array i e
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// ((i, e) -> Bool) -> [(i, e)] -> [(i, e)]
forall a. (a -> Bool) -> [a] -> [a]
P.filter ((i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array i e -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i e
a) (i -> Bool) -> ((i, e) -> i) -> (i, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, e) -> i
forall a b. (a, b) -> a
fst) [(i, e)]
xs

grow :: Int -> Lines -> Lines
grow :: Int -> Lines -> Lines
grow Int
y Lines
a
  | (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
t,Int
b) Int
y = Lines
a
  | Bool
otherwise = ((Int, Int64), (Int, Int64))
-> [((Int, Int64), ([SGR], Char))] -> Lines
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int64), (Int, Int64))
new [ ((Int, Int64)
i, if ((Int, Int64), (Int, Int64)) -> (Int, Int64) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int, Int64), (Int, Int64))
old (Int, Int64)
i then Lines
a Lines -> (Int, Int64) -> ([SGR], Char)
forall i e. Ix i => Array i e -> i -> e
! (Int, Int64)
i else ([],Char
' ')) | (Int, Int64)
i <- ((Int, Int64), (Int, Int64)) -> [(Int, Int64)]
forall a. Ix a => (a, a) -> [a]
range ((Int, Int64), (Int, Int64))
new ]
  where old :: ((Int, Int64), (Int, Int64))
old@((Int
t,Int64
lo),(Int
b,Int64
hi)) = Lines -> ((Int, Int64), (Int, Int64))
forall i e. Array i e -> (i, i)
bounds Lines
a
        new :: ((Int, Int64), (Int, Int64))
new = ((Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
t Int
y,Int64
lo),(Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b Int
y,Int64
hi))

draw
    :: [SGR]  -- ^ ANSI style to use
    -> Int    -- ^ Line; 0 is at the top
    -> Int64  -- ^ Column; 0 is on the left
    -> String -- ^ Data to be written
    -> Lines  -- ^ Canvas to draw on
    -> Lines
draw :: [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [SGR]
_ Int
_ Int64
_ String
"" Lines
a0 = Lines
a0
draw [SGR]
e Int
y Int64
n String
xs Lines
a0 = Lines -> Lines
gt (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Lines -> Lines
lt (Lines
a Lines -> [((Int, Int64), ([SGR], Char))] -> Lines
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
/// [((Int, Int64), ([SGR], Char))]
out)
  where
    a :: Lines
a = Int -> Lines -> Lines
grow Int
y Lines
a0
    ((Int
_,Int64
lo),(Int
_,Int64
hi)) = Lines -> ((Int, Int64), (Int, Int64))
forall i e. Array i e -> (i, i)
bounds Lines
a
    out :: [((Int, Int64), ([SGR], Char))]
out = (Int64 -> Char -> ((Int, Int64), ([SGR], Char)))
-> [Int64] -> String -> [((Int, Int64), ([SGR], Char))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
P.zipWith (\Int64
i Char
c -> ((Int
y,Int64
i),([SGR]
e,Char
c))) [Int64
n..] String
xs
    lt :: Lines -> Lines
lt | (((Int, Int64), ([SGR], Char)) -> Bool)
-> [((Int, Int64), ([SGR], Char))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any (\((Int, Int64), ([SGR], Char))
el -> (Int, Int64) -> Int64
forall a b. (a, b) -> b
snd (((Int, Int64), ([SGR], Char)) -> (Int, Int64)
forall a b. (a, b) -> a
fst ((Int, Int64), ([SGR], Char))
el) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
lo) [((Int, Int64), ([SGR], Char))]
out = (Lines -> [((Int, Int64), ([SGR], Char))] -> Lines
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int
y,Int64
lo),([SGR] -> [SGR]
outOfRangeEffects [SGR]
e,Char
'<'))])
       | Bool
otherwise = Lines -> Lines
forall a. a -> a
id
    gt :: Lines -> Lines
gt | (((Int, Int64), ([SGR], Char)) -> Bool)
-> [((Int, Int64), ([SGR], Char))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any (\((Int, Int64), ([SGR], Char))
el -> (Int, Int64) -> Int64
forall a b. (a, b) -> b
snd (((Int, Int64), ([SGR], Char)) -> (Int, Int64)
forall a b. (a, b) -> a
fst ((Int, Int64), ([SGR], Char))
el) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
hi) [((Int, Int64), ([SGR], Char))]
out = (Lines -> [((Int, Int64), ([SGR], Char))] -> Lines
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int
y,Int64
hi),([SGR] -> [SGR]
outOfRangeEffects [SGR]
e,Char
'>'))])
       | Bool
otherwise = Lines -> Lines
forall a. a -> a
id

-- | A 'Rendering' is a canvas of text that output can be written to.
data Rendering = Rendering
  { Rendering -> Delta
_renderingDelta :: !Delta
    -- ^ focus, the render will keep this visible

  , Rendering -> Int64
_renderingLineLen :: {-# UNPACK #-} !Int64
    -- ^ actual line length

  , Rendering -> Int64
_renderingLineBytes :: {-# UNPACK #-} !Int64
    -- ^ line length in bytes

  , Rendering -> Lines -> Lines
_renderingLine :: Lines -> Lines

  , Rendering -> Delta -> Lines -> Lines
_renderingOverlays :: Delta -> Lines -> Lines
  }

makeClassy ''Rendering

instance Show Rendering where
  showsPrec :: Int -> Rendering -> ShowS
showsPrec Int
d (Rendering Delta
p Int64
ll Int64
lb Lines -> Lines
_ Delta -> Lines -> Lines
_) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Rendering " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Delta -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Delta
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int64
ll ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int64
lb ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ... ..."

-- | Is the 'Rendering' empty?
--
-- >>> nullRendering emptyRendering
-- True
--
-- >>> nullRendering exampleRendering
-- False
nullRendering :: Rendering -> Bool
nullRendering :: Rendering -> Bool
nullRendering (Rendering (Columns Int64
0 Int64
0) Int64
0 Int64
0 Lines -> Lines
_ Delta -> Lines -> Lines
_) = Bool
True
nullRendering Rendering
_ = Bool
False

-- | The empty 'Rendering', which contains nothing at all.
--
-- >>> show (prettyRendering emptyRendering)
-- ""
emptyRendering :: Rendering
emptyRendering :: Rendering
emptyRendering = Delta
-> Int64
-> Int64
-> (Lines -> Lines)
-> (Delta -> Lines -> Lines)
-> Rendering
Rendering (Int64 -> Int64 -> Delta
Columns Int64
0 Int64
0) Int64
0 Int64
0 Lines -> Lines
forall a. a -> a
id ((Lines -> Lines) -> Delta -> Lines -> Lines
forall a b. a -> b -> a
const Lines -> Lines
forall a. a -> a
id)

instance Semigroup Rendering where
  -- an unprincipled hack
  Rendering (Columns Int64
0 Int64
0) Int64
0 Int64
0 Lines -> Lines
_ Delta -> Lines -> Lines
f <> :: Rendering -> Rendering -> Rendering
<> Rendering Delta
del Int64
len Int64
lb Lines -> Lines
dc Delta -> Lines -> Lines
g = Delta
-> Int64
-> Int64
-> (Lines -> Lines)
-> (Delta -> Lines -> Lines)
-> Rendering
Rendering Delta
del Int64
len Int64
lb Lines -> Lines
dc ((Delta -> Lines -> Lines) -> Rendering)
-> (Delta -> Lines -> Lines) -> Rendering
forall a b. (a -> b) -> a -> b
$ \Delta
d Lines
l -> Delta -> Lines -> Lines
f Delta
d (Delta -> Lines -> Lines
g Delta
d Lines
l)
  Rendering Delta
del Int64
len Int64
lb Lines -> Lines
dc Delta -> Lines -> Lines
f <> Rendering Delta
_ Int64
_ Int64
_ Lines -> Lines
_ Delta -> Lines -> Lines
g = Delta
-> Int64
-> Int64
-> (Lines -> Lines)
-> (Delta -> Lines -> Lines)
-> Rendering
Rendering Delta
del Int64
len Int64
lb Lines -> Lines
dc ((Delta -> Lines -> Lines) -> Rendering)
-> (Delta -> Lines -> Lines) -> Rendering
forall a b. (a -> b) -> a -> b
$ \Delta
d Lines
l -> Delta -> Lines -> Lines
f Delta
d (Delta -> Lines -> Lines
g Delta
d Lines
l)

instance Monoid Rendering where
  mappend :: Rendering -> Rendering -> Rendering
mappend = Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Rendering
mempty = Rendering
emptyRendering

ifNear
    :: Delta            -- ^ Position 1
    -> (Lines -> Lines) -- ^ Modify the fallback result if the positions are 'near' each other
    -> Delta            -- ^ Position 2
    -> Lines            -- ^ Fallback result if the positions are not 'near' each other
    -> Lines
ifNear :: Delta -> (Lines -> Lines) -> Delta -> Lines -> Lines
ifNear Delta
d Lines -> Lines
f Delta
d' Lines
l | Delta -> Delta -> Bool
forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
d Delta
d' = Lines -> Lines
f Lines
l
                | Bool
otherwise = Lines
l

instance HasDelta Rendering where
  delta :: Rendering -> Delta
delta = Rendering -> Delta
_renderingDelta

class Renderable t where
  render :: t -> Rendering

instance Renderable Rendering where
  render :: Rendering -> Rendering
render = Rendering -> Rendering
forall a. a -> a
id

class Source t where
  source :: t -> (Int64, Int64, Lines -> Lines)
  -- ^ @
  -- ( Number of (padded) columns
  -- , number of bytes
  -- , line )
  -- @

instance Source String where
  source :: String -> (Int64, Int64, Lines -> Lines)
source String
s
    | Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
P.elem Char
'\n' String
s = (Int64
ls, Int64
bs, [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [] Int
0 Int64
0 String
s')
    | Bool
otherwise           = ( Int64
ls Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
end), Int64
bs, [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Blue, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity] Int
0 Int64
ls String
end (Lines -> Lines) -> (Lines -> Lines) -> Lines -> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [] Int
0 Int64
0 String
s')
    where
      end :: String
end = String
"<EOF>"
      s' :: String
s' = Int -> ShowS
go Int
0 String
s
      bs :: Int64
bs = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
s
      ls :: Int64
ls = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
s'
      go :: Int -> ShowS
go Int
n (Char
'\t':String
xs) = let t :: Int
t = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
8 in Int -> Char -> String
forall a. Int -> a -> [a]
P.replicate Int
t Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t) String
xs
      go Int
_ (Char
'\n':String
_)  = []
      go Int
n (Char
x:String
xs)    = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
xs
      go Int
_ []        = []

instance Source ByteString where
  source :: ByteString -> (Int64, Int64, Lines -> Lines)
source = String -> (Int64, Int64, Lines -> Lines)
forall t. Source t => t -> (Int64, Int64, Lines -> Lines)
source (String -> (Int64, Int64, Lines -> Lines))
-> (ByteString -> String)
-> ByteString
-> (Int64, Int64, Lines -> Lines)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

-- | create a drawing surface
rendered :: Source s => Delta -> s -> Rendering
rendered :: forall s. Source s => Delta -> s -> Rendering
rendered Delta
del s
s = case s -> (Int64, Int64, Lines -> Lines)
forall t. Source t => t -> (Int64, Int64, Lines -> Lines)
source s
s of
  (Int64
len, Int64
lb, Lines -> Lines
dc) -> Delta
-> Int64
-> Int64
-> (Lines -> Lines)
-> (Delta -> Lines -> Lines)
-> Rendering
Rendering Delta
del Int64
len Int64
lb Lines -> Lines
dc (\Delta
_ Lines
l -> Lines
l)

(.#) :: (Delta -> Lines -> Lines) -> Rendering -> Rendering
Delta -> Lines -> Lines
f .# :: (Delta -> Lines -> Lines) -> Rendering -> Rendering
.# Rendering Delta
d Int64
ll Int64
lb Lines -> Lines
s Delta -> Lines -> Lines
g = Delta
-> Int64
-> Int64
-> (Lines -> Lines)
-> (Delta -> Lines -> Lines)
-> Rendering
Rendering Delta
d Int64
ll Int64
lb Lines -> Lines
s ((Delta -> Lines -> Lines) -> Rendering)
-> (Delta -> Lines -> Lines) -> Rendering
forall a b. (a -> b) -> a -> b
$ \Delta
e Lines
l -> Delta -> Lines -> Lines
f Delta
e (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Delta -> Lines -> Lines
g Delta
e Lines
l

prettyRendering :: Rendering -> Doc AnsiStyle
prettyRendering :: Rendering -> Doc AnsiStyle
prettyRendering (Rendering Delta
d Int64
ll Int64
_ Lines -> Lines
l Delta -> Lines -> Lines
f) = (Int -> Doc AnsiStyle) -> Doc AnsiStyle
forall ann. (Int -> Doc ann) -> Doc ann
nesting ((Int -> Doc AnsiStyle) -> Doc AnsiStyle)
-> (Int -> Doc AnsiStyle) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ \Int
k -> (Maybe Int -> Doc AnsiStyle) -> Doc AnsiStyle
columns ((Maybe Int -> Doc AnsiStyle) -> Doc AnsiStyle)
-> (Maybe Int -> Doc AnsiStyle) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ \Maybe Int
mn -> Int64 -> Doc AnsiStyle
go (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
80 Maybe Int
mn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)) where
  go :: Int64 -> Doc AnsiStyle
go Int64
cols = Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
align ([Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ((Int -> Doc AnsiStyle) -> [Int] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
P.map Int -> Doc AnsiStyle
ln [Int
t..Int
b])) where
    (Int64
lo, Int64
hi) = Int64 -> Int64 -> Int64 -> (Int64, Int64)
window (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
d) Int64
ll (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Int64
cols Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gutterWidth) Int64
30) Int64
200)
    a :: Lines
a = Delta -> Lines -> Lines
f Delta
d (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Lines -> Lines
l (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ ((Int, Int64), (Int, Int64))
-> [((Int, Int64), ([SGR], Char))] -> Lines
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int
0,Int64
lo),(-Int
1,Int64
hi)) []
    ((Int
t,Int64
_),(Int
b,Int64
_)) = Lines -> ((Int, Int64), (Int, Int64))
forall i e. Array i e -> (i, i)
bounds Lines
a
    n :: String
n = Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ case Delta
d of
      Lines      Int64
n' Int64
_ Int64
_ Int64
_ -> Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n'
      Directed ByteString
_ Int64
n' Int64
_ Int64
_ Int64
_ -> Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n'
      Delta
_                   -> Int64
1
    separator :: Doc a
separator = Char -> Doc a
forall a. Char -> Doc a
char Char
'|'
    gutterWidth :: Int
gutterWidth = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
n
    gutter :: Doc ann
gutter = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall {a}. Doc a
separator
    margin :: Doc ann
margin = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fill Int
gutterWidth Doc ann
forall {a}. Doc a
space Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall {a}. Doc a
separator
    ln :: Int -> Doc AnsiStyle
ln Int
y = ([SGR] -> Doc AnsiStyle -> Doc AnsiStyle
sgr [SGR]
gutterEffects (if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Doc AnsiStyle
forall {a}. Doc a
gutter else Doc AnsiStyle
forall {a}. Doc a
margin) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>)
         (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat
         ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ (NonEmpty ([SGR], Char) -> Doc AnsiStyle)
-> [NonEmpty ([SGR], Char)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
P.map (\NonEmpty ([SGR], Char)
g -> [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
sgr (([SGR], Char) -> [SGR]
forall a b. (a, b) -> a
fst (NonEmpty ([SGR], Char) -> ([SGR], Char)
forall a. NonEmpty a -> a
NE.head NonEmpty ([SGR], Char)
g)) (NonEmpty Char -> Doc AnsiStyle
forall ann. NonEmpty Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((([SGR], Char) -> Char) -> NonEmpty ([SGR], Char) -> NonEmpty Char
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SGR], Char) -> Char
forall a b. (a, b) -> b
snd NonEmpty ([SGR], Char)
g)))
         ([NonEmpty ([SGR], Char)] -> [Doc AnsiStyle])
-> [NonEmpty ([SGR], Char)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> a -> b
$ (([SGR], Char) -> ([SGR], Char) -> Bool)
-> [([SGR], Char)] -> [NonEmpty ([SGR], Char)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy ([SGR] -> [SGR] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([SGR] -> [SGR] -> Bool)
-> (([SGR], Char) -> [SGR])
-> ([SGR], Char)
-> ([SGR], Char)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([SGR], Char) -> [SGR]
forall a b. (a, b) -> a
fst)
         [ Lines
a Lines -> (Int, Int64) -> ([SGR], Char)
forall i e. Ix i => Array i e -> i -> e
! (Int
y,Int64
i) | Int64
i <- [Int64
lo..Int64
hi] ]

window :: Int64 -> Int64 -> Int64 -> (Int64, Int64)
window :: Int64 -> Int64 -> Int64 -> (Int64, Int64)
window Int64
c Int64
l Int64
w
  | Int64
c Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
w2     = (Int64
0, Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
w Int64
l)
  | Int64
c Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
w2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
l = if Int64
l Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
w then (Int64
lInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
w, Int64
l)
                           else (Int64
0  , Int64
w)
  | Bool
otherwise   = (Int64
cInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
w2, Int64
cInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
w2)
  where w2 :: Int64
w2 = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
w Int64
2

-- | ANSI terminal style for rendering the gutter.
gutterEffects :: [SGR]
gutterEffects :: [SGR]
gutterEffects = [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Blue]

data Rendered a = a :@ Rendering
  deriving Int -> Rendered a -> ShowS
[Rendered a] -> ShowS
Rendered a -> String
(Int -> Rendered a -> ShowS)
-> (Rendered a -> String)
-> ([Rendered a] -> ShowS)
-> Show (Rendered a)
forall a. Show a => Int -> Rendered a -> ShowS
forall a. Show a => [Rendered a] -> ShowS
forall a. Show a => Rendered a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Rendered a -> ShowS
showsPrec :: Int -> Rendered a -> ShowS
$cshow :: forall a. Show a => Rendered a -> String
show :: Rendered a -> String
$cshowList :: forall a. Show a => [Rendered a] -> ShowS
showList :: [Rendered a] -> ShowS
Show

instance Functor Rendered where
  fmap :: forall a b. (a -> b) -> Rendered a -> Rendered b
fmap a -> b
f (a
a :@ Rendering
s) = a -> b
f a
a b -> Rendering -> Rendered b
forall a. a -> Rendering -> Rendered a
:@ Rendering
s

instance HasDelta (Rendered a) where
  delta :: Rendered a -> Delta
delta = Rendering -> Delta
forall t. HasDelta t => t -> Delta
delta (Rendering -> Delta)
-> (Rendered a -> Rendering) -> Rendered a -> Delta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rendered a -> Rendering
forall t. Renderable t => t -> Rendering
render

instance HasBytes (Rendered a) where
  bytes :: Rendered a -> Int64
bytes = Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes (Delta -> Int64) -> (Rendered a -> Delta) -> Rendered a -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rendered a -> Delta
forall t. HasDelta t => t -> Delta
delta

instance Comonad Rendered where
  extend :: forall a b. (Rendered a -> b) -> Rendered a -> Rendered b
extend Rendered a -> b
f as :: Rendered a
as@(a
_ :@ Rendering
s) = Rendered a -> b
f Rendered a
as b -> Rendering -> Rendered b
forall a. a -> Rendering -> Rendered a
:@ Rendering
s
  extract :: forall a. Rendered a -> a
extract (a
a :@ Rendering
_) = a
a

instance ComonadApply Rendered where
  (a -> b
f :@ Rendering
s) <@> :: forall a b. Rendered (a -> b) -> Rendered a -> Rendered b
<@> (a
a :@ Rendering
t) = a -> b
f a
a b -> Rendering -> Rendered b
forall a. a -> Rendering -> Rendered a
:@ (Rendering
s Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
t)

instance Foldable Rendered where
  foldMap :: forall m a. Monoid m => (a -> m) -> Rendered a -> m
foldMap a -> m
f (a
a :@ Rendering
_) = a -> m
f a
a

instance Traversable Rendered where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rendered a -> f (Rendered b)
traverse a -> f b
f (a
a :@ Rendering
s) = (b -> Rendering -> Rendered b
forall a. a -> Rendering -> Rendered a
:@ Rendering
s) (b -> Rendered b) -> f b -> f (Rendered b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Renderable (Rendered a) where
  render :: Rendered a -> Rendering
render (a
_ :@ Rendering
s) = Rendering
s

-- | A 'Caret' marks a point in the input with a simple @^@ character.
--
-- >>> unAnnotate (prettyRendering (addCaret (Columns 35 35) exampleRendering))
-- 1 | int main(int argc, char ** argv) { int; }<EOF>
--   |                                    ^
data Caret = Caret !Delta {-# UNPACK #-} !ByteString deriving (Caret -> Caret -> Bool
(Caret -> Caret -> Bool) -> (Caret -> Caret -> Bool) -> Eq Caret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Caret -> Caret -> Bool
== :: Caret -> Caret -> Bool
$c/= :: Caret -> Caret -> Bool
/= :: Caret -> Caret -> Bool
Eq,Eq Caret
Eq Caret =>
(Caret -> Caret -> Ordering)
-> (Caret -> Caret -> Bool)
-> (Caret -> Caret -> Bool)
-> (Caret -> Caret -> Bool)
-> (Caret -> Caret -> Bool)
-> (Caret -> Caret -> Caret)
-> (Caret -> Caret -> Caret)
-> Ord Caret
Caret -> Caret -> Bool
Caret -> Caret -> Ordering
Caret -> Caret -> Caret
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Caret -> Caret -> Ordering
compare :: Caret -> Caret -> Ordering
$c< :: Caret -> Caret -> Bool
< :: Caret -> Caret -> Bool
$c<= :: Caret -> Caret -> Bool
<= :: Caret -> Caret -> Bool
$c> :: Caret -> Caret -> Bool
> :: Caret -> Caret -> Bool
$c>= :: Caret -> Caret -> Bool
>= :: Caret -> Caret -> Bool
$cmax :: Caret -> Caret -> Caret
max :: Caret -> Caret -> Caret
$cmin :: Caret -> Caret -> Caret
min :: Caret -> Caret -> Caret
Ord,Int -> Caret -> ShowS
[Caret] -> ShowS
Caret -> String
(Int -> Caret -> ShowS)
-> (Caret -> String) -> ([Caret] -> ShowS) -> Show Caret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Caret -> ShowS
showsPrec :: Int -> Caret -> ShowS
$cshow :: Caret -> String
show :: Caret -> String
$cshowList :: [Caret] -> ShowS
showList :: [Caret] -> ShowS
Show,Typeable Caret
Typeable Caret =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Caret -> c Caret)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Caret)
-> (Caret -> Constr)
-> (Caret -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Caret))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret))
-> ((forall b. Data b => b -> b) -> Caret -> Caret)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r)
-> (forall u. (forall d. Data d => d -> u) -> Caret -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Caret -> m Caret)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Caret -> m Caret)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Caret -> m Caret)
-> Data Caret
Caret -> Constr
Caret -> DataType
(forall b. Data b => b -> b) -> Caret -> Caret
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u
forall u. (forall d. Data d => d -> u) -> Caret -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caret
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caret -> c Caret
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caret)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caret -> c Caret
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caret -> c Caret
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caret
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caret
$ctoConstr :: Caret -> Constr
toConstr :: Caret -> Constr
$cdataTypeOf :: Caret -> DataType
dataTypeOf :: Caret -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caret)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caret)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret)
$cgmapT :: (forall b. Data b => b -> b) -> Caret -> Caret
gmapT :: (forall b. Data b => b -> b) -> Caret -> Caret
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Caret -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Caret -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
Data,(forall x. Caret -> Rep Caret x)
-> (forall x. Rep Caret x -> Caret) -> Generic Caret
forall x. Rep Caret x -> Caret
forall x. Caret -> Rep Caret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Caret -> Rep Caret x
from :: forall x. Caret -> Rep Caret x
$cto :: forall x. Rep Caret x -> Caret
to :: forall x. Rep Caret x -> Caret
Generic)

class HasCaret t where
  caret :: Lens' t Caret

instance HasCaret Caret where
  caret :: Lens' Caret Caret
caret = (Caret -> f Caret) -> Caret -> f Caret
forall a. a -> a
id

instance Hashable Caret

-- | ANSI terminal style for rendering the caret.
caretEffects :: [SGR]
caretEffects :: [SGR]
caretEffects = [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Green]

drawCaret :: Delta -> Delta -> Lines -> Lines
drawCaret :: Delta -> Delta -> Lines -> Lines
drawCaret Delta
p = Delta -> (Lines -> Lines) -> Delta -> Lines -> Lines
ifNear Delta
p ((Lines -> Lines) -> Delta -> Lines -> Lines)
-> (Lines -> Lines) -> Delta -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [SGR]
caretEffects Int
1 (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
p)) String
"^"

-- | Render a caret at a certain position in a 'Rendering'.
addCaret :: Delta -> Rendering -> Rendering
addCaret :: Delta -> Rendering -> Rendering
addCaret Delta
p Rendering
r = Delta -> Delta -> Lines -> Lines
drawCaret Delta
p (Delta -> Lines -> Lines) -> Rendering -> Rendering
.# Rendering
r

instance HasBytes Caret where
  bytes :: Caret -> Int64
bytes = Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes (Delta -> Int64) -> (Caret -> Delta) -> Caret -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Caret -> Delta
forall t. HasDelta t => t -> Delta
delta

instance HasDelta Caret where
  delta :: Caret -> Delta
delta (Caret Delta
d ByteString
_) = Delta
d

instance Renderable Caret where
  render :: Caret -> Rendering
render (Caret Delta
d ByteString
bs) = Delta -> Rendering -> Rendering
addCaret Delta
d (Rendering -> Rendering) -> Rendering -> Rendering
forall a b. (a -> b) -> a -> b
$ Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered Delta
d ByteString
bs

instance Reducer Caret Rendering where
  unit :: Caret -> Rendering
unit = Caret -> Rendering
forall t. Renderable t => t -> Rendering
render

instance Semigroup Caret where
  Caret
a <> :: Caret -> Caret -> Caret
<> Caret
_ = Caret
a

renderingCaret :: Delta -> ByteString -> Rendering
renderingCaret :: Delta -> ByteString -> Rendering
renderingCaret Delta
d ByteString
bs = Delta -> Rendering -> Rendering
addCaret Delta
d (Rendering -> Rendering) -> Rendering -> Rendering
forall a b. (a -> b) -> a -> b
$ Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered Delta
d ByteString
bs

data Careted a = a :^ Caret deriving (Careted a -> Careted a -> Bool
(Careted a -> Careted a -> Bool)
-> (Careted a -> Careted a -> Bool) -> Eq (Careted a)
forall a. Eq a => Careted a -> Careted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Careted a -> Careted a -> Bool
== :: Careted a -> Careted a -> Bool
$c/= :: forall a. Eq a => Careted a -> Careted a -> Bool
/= :: Careted a -> Careted a -> Bool
Eq,Eq (Careted a)
Eq (Careted a) =>
(Careted a -> Careted a -> Ordering)
-> (Careted a -> Careted a -> Bool)
-> (Careted a -> Careted a -> Bool)
-> (Careted a -> Careted a -> Bool)
-> (Careted a -> Careted a -> Bool)
-> (Careted a -> Careted a -> Careted a)
-> (Careted a -> Careted a -> Careted a)
-> Ord (Careted a)
Careted a -> Careted a -> Bool
Careted a -> Careted a -> Ordering
Careted a -> Careted a -> Careted a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Careted a)
forall a. Ord a => Careted a -> Careted a -> Bool
forall a. Ord a => Careted a -> Careted a -> Ordering
forall a. Ord a => Careted a -> Careted a -> Careted a
$ccompare :: forall a. Ord a => Careted a -> Careted a -> Ordering
compare :: Careted a -> Careted a -> Ordering
$c< :: forall a. Ord a => Careted a -> Careted a -> Bool
< :: Careted a -> Careted a -> Bool
$c<= :: forall a. Ord a => Careted a -> Careted a -> Bool
<= :: Careted a -> Careted a -> Bool
$c> :: forall a. Ord a => Careted a -> Careted a -> Bool
> :: Careted a -> Careted a -> Bool
$c>= :: forall a. Ord a => Careted a -> Careted a -> Bool
>= :: Careted a -> Careted a -> Bool
$cmax :: forall a. Ord a => Careted a -> Careted a -> Careted a
max :: Careted a -> Careted a -> Careted a
$cmin :: forall a. Ord a => Careted a -> Careted a -> Careted a
min :: Careted a -> Careted a -> Careted a
Ord,Int -> Careted a -> ShowS
[Careted a] -> ShowS
Careted a -> String
(Int -> Careted a -> ShowS)
-> (Careted a -> String)
-> ([Careted a] -> ShowS)
-> Show (Careted a)
forall a. Show a => Int -> Careted a -> ShowS
forall a. Show a => [Careted a] -> ShowS
forall a. Show a => Careted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Careted a -> ShowS
showsPrec :: Int -> Careted a -> ShowS
$cshow :: forall a. Show a => Careted a -> String
show :: Careted a -> String
$cshowList :: forall a. Show a => [Careted a] -> ShowS
showList :: [Careted a] -> ShowS
Show,Typeable (Careted a)
Typeable (Careted a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Careted a -> c (Careted a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Careted a))
-> (Careted a -> Constr)
-> (Careted a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Careted a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Careted a)))
-> ((forall b. Data b => b -> b) -> Careted a -> Careted a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Careted a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Careted a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Careted a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Careted a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Careted a -> m (Careted a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Careted a -> m (Careted a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Careted a -> m (Careted a))
-> Data (Careted a)
Careted a -> Constr
Careted a -> DataType
(forall b. Data b => b -> b) -> Careted a -> Careted a
forall a. Data a => Typeable (Careted a)
forall a. Data a => Careted a -> Constr
forall a. Data a => Careted a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Careted a -> Careted a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Careted a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Careted a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Careted a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Careted a -> c (Careted a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Careted a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Careted a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Careted a -> u
forall u. (forall d. Data d => d -> u) -> Careted a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Careted a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Careted a -> c (Careted a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Careted a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Careted a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Careted a -> c (Careted a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Careted a -> c (Careted a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Careted a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Careted a)
$ctoConstr :: forall a. Data a => Careted a -> Constr
toConstr :: Careted a -> Constr
$cdataTypeOf :: forall a. Data a => Careted a -> DataType
dataTypeOf :: Careted a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Careted a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Careted a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Careted a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Careted a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Careted a -> Careted a
gmapT :: (forall b. Data b => b -> b) -> Careted a -> Careted a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Careted a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Careted a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Careted a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Careted a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Careted a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Careted a -> m (Careted a)
Data,(forall x. Careted a -> Rep (Careted a) x)
-> (forall x. Rep (Careted a) x -> Careted a)
-> Generic (Careted a)
forall x. Rep (Careted a) x -> Careted a
forall x. Careted a -> Rep (Careted a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Careted a) x -> Careted a
forall a x. Careted a -> Rep (Careted a) x
$cfrom :: forall a x. Careted a -> Rep (Careted a) x
from :: forall x. Careted a -> Rep (Careted a) x
$cto :: forall a x. Rep (Careted a) x -> Careted a
to :: forall x. Rep (Careted a) x -> Careted a
Generic)

instance HasCaret (Careted a) where
  caret :: Lens' (Careted a) Caret
caret Caret -> f Caret
f (a
a :^ Caret
c) = (a
a a -> Caret -> Careted a
forall a. a -> Caret -> Careted a
:^) (Caret -> Careted a) -> f Caret -> f (Careted a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Caret -> f Caret
f Caret
c

instance Functor Careted where
  fmap :: forall a b. (a -> b) -> Careted a -> Careted b
fmap a -> b
f (a
a :^ Caret
s) = a -> b
f a
a b -> Caret -> Careted b
forall a. a -> Caret -> Careted a
:^ Caret
s

instance HasDelta (Careted a) where
  delta :: Careted a -> Delta
delta (a
_ :^ Caret
c) = Caret -> Delta
forall t. HasDelta t => t -> Delta
delta Caret
c

instance HasBytes (Careted a) where
  bytes :: Careted a -> Int64
bytes (a
_ :^ Caret
c) = Caret -> Int64
forall t. HasBytes t => t -> Int64
bytes Caret
c

instance Comonad Careted where
  extend :: forall a b. (Careted a -> b) -> Careted a -> Careted b
extend Careted a -> b
f as :: Careted a
as@(a
_ :^ Caret
s) = Careted a -> b
f Careted a
as b -> Caret -> Careted b
forall a. a -> Caret -> Careted a
:^ Caret
s
  extract :: forall a. Careted a -> a
extract (a
a :^ Caret
_) = a
a

instance ComonadApply Careted where
  (a -> b
a :^ Caret
c) <@> :: forall a b. Careted (a -> b) -> Careted a -> Careted b
<@> (a
b :^ Caret
d) = a -> b
a a
b b -> Caret -> Careted b
forall a. a -> Caret -> Careted a
:^ (Caret
c Caret -> Caret -> Caret
forall a. Semigroup a => a -> a -> a
<> Caret
d)

instance Foldable Careted where
  foldMap :: forall m a. Monoid m => (a -> m) -> Careted a -> m
foldMap a -> m
f (a
a :^ Caret
_) = a -> m
f a
a

instance Traversable Careted where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Careted a -> f (Careted b)
traverse a -> f b
f (a
a :^ Caret
s) = (b -> Caret -> Careted b
forall a. a -> Caret -> Careted a
:^ Caret
s) (b -> Careted b) -> f b -> f (Careted b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Renderable (Careted a) where
  render :: Careted a -> Rendering
render (a
_ :^ Caret
a) = Caret -> Rendering
forall t. Renderable t => t -> Rendering
render Caret
a

instance Reducer (Careted a) Rendering where
  unit :: Careted a -> Rendering
unit = Careted a -> Rendering
forall t. Renderable t => t -> Rendering
render

instance Hashable a => Hashable (Careted a)

-- | ANSI terminal style to render spans with.
spanEffects :: [SGR]
spanEffects :: [SGR]
spanEffects  = [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green]

drawSpan
    :: Delta -- ^ Start of the region of interest
    -> Delta -- ^ End of the region of interest
    -> Delta -- ^ Currrent location
    -> Lines -- ^ 'Lines' to add the rendering to
    -> Lines
drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines
drawSpan Delta
start Delta
end Delta
d Lines
a
  | Bool
nearLo Bool -> Bool -> Bool
&& Bool
nearHi = Int64 -> String -> Lines -> Lines
go (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
lo) (Int64 -> Char -> String
forall {a}. Int64 -> a -> [a]
rep (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
hi Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
lo) Int64
0) Char
'~') Lines
a
  | Bool
nearLo           = Int64 -> String -> Lines -> Lines
go (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
lo) (Int64 -> Char -> String
forall {a}. Int64 -> a -> [a]
rep (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max ((Int, Int64) -> Int64
forall a b. (a, b) -> b
snd (((Int, Int64), (Int, Int64)) -> (Int, Int64)
forall a b. (a, b) -> b
snd (Lines -> ((Int, Int64), (Int, Int64))
forall i e. Array i e -> (i, i)
bounds Lines
a)) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
lo Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64
0) Char
'~') Lines
a
  |           Bool
nearHi = Int64 -> String -> Lines -> Lines
go (-Int64
1)        (Int64 -> Char -> String
forall {a}. Int64 -> a -> [a]
rep (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
hi Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64
0) Char
'~') Lines
a
  | Bool
otherwise        = Lines
a
  where
    go :: Int64 -> String -> Lines -> Lines
go = [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [SGR]
spanEffects Int
1 (Int64 -> String -> Lines -> Lines)
-> (Int64 -> Int64) -> Int64 -> String -> Lines -> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    lo :: Delta
lo = (Delta -> Int64) -> Delta -> Delta -> Delta
forall b a. Ord b => (a -> b) -> a -> a -> a
argmin Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
start Delta
end
    hi :: Delta
hi = (Delta -> Int64) -> Delta -> Delta -> Delta
forall b a. Ord b => (a -> b) -> a -> a -> a
argmax Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
start Delta
end
    nearLo :: Bool
nearLo = Delta -> Delta -> Bool
forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
lo Delta
d
    nearHi :: Bool
nearHi = Delta -> Delta -> Bool
forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
hi Delta
d
    rep :: Int64 -> a -> [a]
rep = Int -> a -> [a]
forall a. Int -> a -> [a]
P.replicate (Int -> a -> [a]) -> (Int64 -> Int) -> Int64 -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

addSpan :: Delta -> Delta -> Rendering -> Rendering
addSpan :: Delta -> Delta -> Rendering -> Rendering
addSpan Delta
s Delta
e Rendering
r = Delta -> Delta -> Delta -> Lines -> Lines
drawSpan Delta
s Delta
e (Delta -> Lines -> Lines) -> Rendering -> Rendering
.# Rendering
r

-- | A 'Span' marks a range of input characters. If 'Caret' is a point, then
-- 'Span' is a line.
--
-- >>> unAnnotate (prettyRendering (addSpan (Columns 35 35) (Columns 38 38) exampleRendering))
-- 1 | int main(int argc, char ** argv) { int; }<EOF>
--   |                                    ~~~
data Span = Span !Delta !Delta {-# UNPACK #-} !ByteString deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq,Eq Span
Eq Span =>
(Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Span -> Span -> Ordering
compare :: Span -> Span -> Ordering
$c< :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
>= :: Span -> Span -> Bool
$cmax :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
min :: Span -> Span -> Span
Ord,Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Span -> ShowS
showsPrec :: Int -> Span -> ShowS
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> ShowS
showList :: [Span] -> ShowS
Show,Typeable Span
Typeable Span =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Span -> c Span)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Span)
-> (Span -> Constr)
-> (Span -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Span))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span))
-> ((forall b. Data b => b -> b) -> Span -> Span)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r)
-> (forall u. (forall d. Data d => d -> u) -> Span -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Span -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Span -> m Span)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Span -> m Span)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Span -> m Span)
-> Data Span
Span -> Constr
Span -> DataType
(forall b. Data b => b -> b) -> Span -> Span
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
forall u. (forall d. Data d => d -> u) -> Span -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
$ctoConstr :: Span -> Constr
toConstr :: Span -> Constr
$cdataTypeOf :: Span -> DataType
dataTypeOf :: Span -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
$cgmapT :: (forall b. Data b => b -> b) -> Span -> Span
gmapT :: (forall b. Data b => b -> b) -> Span -> Span
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Span -> m Span
Data,(forall x. Span -> Rep Span x)
-> (forall x. Rep Span x -> Span) -> Generic Span
forall x. Rep Span x -> Span
forall x. Span -> Rep Span x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Span -> Rep Span x
from :: forall x. Span -> Rep Span x
$cto :: forall x. Rep Span x -> Span
to :: forall x. Rep Span x -> Span
Generic)

class HasSpan t where
  span :: Lens' t Span

instance HasSpan Span where
  span :: Lens' Span Span
span = (Span -> f Span) -> Span -> f Span
forall a. a -> a
id

instance Renderable Span where
  render :: Span -> Rendering
render (Span Delta
s Delta
e ByteString
bs) = Delta -> Delta -> Rendering -> Rendering
addSpan Delta
s Delta
e (Rendering -> Rendering) -> Rendering -> Rendering
forall a b. (a -> b) -> a -> b
$ Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered Delta
s ByteString
bs

instance Semigroup Span where
  Span Delta
s Delta
_ ByteString
b <> :: Span -> Span -> Span
<> Span Delta
_ Delta
e ByteString
_ = Delta -> Delta -> ByteString -> Span
Span Delta
s Delta
e ByteString
b

instance Reducer Span Rendering where
  unit :: Span -> Rendering
unit = Span -> Rendering
forall t. Renderable t => t -> Rendering
render

instance Hashable Span

-- | Annotate an arbitrary piece of data with a 'Span', typically its
-- corresponding input location.
data Spanned a = a :~ Span deriving (Spanned a -> Spanned a -> Bool
(Spanned a -> Spanned a -> Bool)
-> (Spanned a -> Spanned a -> Bool) -> Eq (Spanned a)
forall a. Eq a => Spanned a -> Spanned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Spanned a -> Spanned a -> Bool
== :: Spanned a -> Spanned a -> Bool
$c/= :: forall a. Eq a => Spanned a -> Spanned a -> Bool
/= :: Spanned a -> Spanned a -> Bool
Eq,Eq (Spanned a)
Eq (Spanned a) =>
(Spanned a -> Spanned a -> Ordering)
-> (Spanned a -> Spanned a -> Bool)
-> (Spanned a -> Spanned a -> Bool)
-> (Spanned a -> Spanned a -> Bool)
-> (Spanned a -> Spanned a -> Bool)
-> (Spanned a -> Spanned a -> Spanned a)
-> (Spanned a -> Spanned a -> Spanned a)
-> Ord (Spanned a)
Spanned a -> Spanned a -> Bool
Spanned a -> Spanned a -> Ordering
Spanned a -> Spanned a -> Spanned a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Spanned a)
forall a. Ord a => Spanned a -> Spanned a -> Bool
forall a. Ord a => Spanned a -> Spanned a -> Ordering
forall a. Ord a => Spanned a -> Spanned a -> Spanned a
$ccompare :: forall a. Ord a => Spanned a -> Spanned a -> Ordering
compare :: Spanned a -> Spanned a -> Ordering
$c< :: forall a. Ord a => Spanned a -> Spanned a -> Bool
< :: Spanned a -> Spanned a -> Bool
$c<= :: forall a. Ord a => Spanned a -> Spanned a -> Bool
<= :: Spanned a -> Spanned a -> Bool
$c> :: forall a. Ord a => Spanned a -> Spanned a -> Bool
> :: Spanned a -> Spanned a -> Bool
$c>= :: forall a. Ord a => Spanned a -> Spanned a -> Bool
>= :: Spanned a -> Spanned a -> Bool
$cmax :: forall a. Ord a => Spanned a -> Spanned a -> Spanned a
max :: Spanned a -> Spanned a -> Spanned a
$cmin :: forall a. Ord a => Spanned a -> Spanned a -> Spanned a
min :: Spanned a -> Spanned a -> Spanned a
Ord,Int -> Spanned a -> ShowS
[Spanned a] -> ShowS
Spanned a -> String
(Int -> Spanned a -> ShowS)
-> (Spanned a -> String)
-> ([Spanned a] -> ShowS)
-> Show (Spanned a)
forall a. Show a => Int -> Spanned a -> ShowS
forall a. Show a => [Spanned a] -> ShowS
forall a. Show a => Spanned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Spanned a -> ShowS
showsPrec :: Int -> Spanned a -> ShowS
$cshow :: forall a. Show a => Spanned a -> String
show :: Spanned a -> String
$cshowList :: forall a. Show a => [Spanned a] -> ShowS
showList :: [Spanned a] -> ShowS
Show,Typeable (Spanned a)
Typeable (Spanned a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Spanned a -> c (Spanned a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Spanned a))
-> (Spanned a -> Constr)
-> (Spanned a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Spanned a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Spanned a)))
-> ((forall b. Data b => b -> b) -> Spanned a -> Spanned a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Spanned a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Spanned a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Spanned a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Spanned a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a))
-> Data (Spanned a)
Spanned a -> Constr
Spanned a -> DataType
(forall b. Data b => b -> b) -> Spanned a -> Spanned a
forall a. Data a => Typeable (Spanned a)
forall a. Data a => Spanned a -> Constr
forall a. Data a => Spanned a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Spanned a -> Spanned a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Spanned a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Spanned a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Spanned a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Spanned a -> c (Spanned a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Spanned a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Spanned a -> u
forall u. (forall d. Data d => d -> u) -> Spanned a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Spanned a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Spanned a -> c (Spanned a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Spanned a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Spanned a -> c (Spanned a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Spanned a -> c (Spanned a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Spanned a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Spanned a)
$ctoConstr :: forall a. Data a => Spanned a -> Constr
toConstr :: Spanned a -> Constr
$cdataTypeOf :: forall a. Data a => Spanned a -> DataType
dataTypeOf :: Spanned a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Spanned a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Spanned a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Spanned a -> Spanned a
gmapT :: (forall b. Data b => b -> b) -> Spanned a -> Spanned a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Spanned a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Spanned a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Spanned a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Spanned a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
Data,(forall x. Spanned a -> Rep (Spanned a) x)
-> (forall x. Rep (Spanned a) x -> Spanned a)
-> Generic (Spanned a)
forall x. Rep (Spanned a) x -> Spanned a
forall x. Spanned a -> Rep (Spanned a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Spanned a) x -> Spanned a
forall a x. Spanned a -> Rep (Spanned a) x
$cfrom :: forall a x. Spanned a -> Rep (Spanned a) x
from :: forall x. Spanned a -> Rep (Spanned a) x
$cto :: forall a x. Rep (Spanned a) x -> Spanned a
to :: forall x. Rep (Spanned a) x -> Spanned a
Generic)

instance HasSpan (Spanned a) where
  span :: Lens' (Spanned a) Span
span Span -> f Span
f (a
a :~ Span
c) = (a
a a -> Span -> Spanned a
forall a. a -> Span -> Spanned a
:~) (Span -> Spanned a) -> f Span -> f (Spanned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> f Span
f Span
c

instance Functor Spanned where
  fmap :: forall a b. (a -> b) -> Spanned a -> Spanned b
fmap a -> b
f (a
a :~ Span
s) = a -> b
f a
a b -> Span -> Spanned b
forall a. a -> Span -> Spanned a
:~ Span
s

instance Comonad Spanned where
  extend :: forall a b. (Spanned a -> b) -> Spanned a -> Spanned b
extend Spanned a -> b
f as :: Spanned a
as@(a
_ :~ Span
s) = Spanned a -> b
f Spanned a
as b -> Span -> Spanned b
forall a. a -> Span -> Spanned a
:~ Span
s
  extract :: forall a. Spanned a -> a
extract (a
a :~ Span
_) = a
a

instance ComonadApply Spanned where
  (a -> b
a :~ Span
c) <@> :: forall a b. Spanned (a -> b) -> Spanned a -> Spanned b
<@> (a
b :~ Span
d) = a -> b
a a
b b -> Span -> Spanned b
forall a. a -> Span -> Spanned a
:~ (Span
c Span -> Span -> Span
forall a. Semigroup a => a -> a -> a
<> Span
d)

instance Foldable Spanned where
  foldMap :: forall m a. Monoid m => (a -> m) -> Spanned a -> m
foldMap a -> m
f (a
a :~ Span
_) = a -> m
f a
a

instance Traversable Spanned where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spanned a -> f (Spanned b)
traverse a -> f b
f (a
a :~ Span
s) = (b -> Span -> Spanned b
forall a. a -> Span -> Spanned a
:~ Span
s) (b -> Spanned b) -> f b -> f (Spanned b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Reducer (Spanned a) Rendering where
  unit :: Spanned a -> Rendering
unit = Spanned a -> Rendering
forall t. Renderable t => t -> Rendering
render

instance Renderable (Spanned a) where
  render :: Spanned a -> Rendering
render (a
_ :~ Span
s) = Span -> Rendering
forall t. Renderable t => t -> Rendering
render Span
s

instance Hashable a => Hashable (Spanned a)

drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines
drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines
drawFixit Delta
s Delta
e String
rpl Delta
d Lines
a = Delta -> (Lines -> Lines) -> Delta -> Lines -> Lines
ifNear Delta
l ([SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Blue] Int
2 (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Delta -> Int64
forall t. HasDelta t => t -> Int64
column Delta
l)) String
rpl) Delta
d
                      (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Delta -> Delta -> Delta -> Lines -> Lines
drawSpan Delta
s Delta
e Delta
d Lines
a
  where l :: Delta
l = (Delta -> Int64) -> Delta -> Delta -> Delta
forall b a. Ord b => (a -> b) -> a -> a -> a
argmin Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
s Delta
e

addFixit :: Delta -> Delta -> String -> Rendering -> Rendering
addFixit :: Delta -> Delta -> String -> Rendering -> Rendering
addFixit Delta
s Delta
e String
rpl Rendering
r = Delta -> Delta -> String -> Delta -> Lines -> Lines
drawFixit Delta
s Delta
e String
rpl (Delta -> Lines -> Lines) -> Rendering -> Rendering
.# Rendering
r

-- | A 'Fixit' is a 'Span' with a suggestion.
--
-- >>> unAnnotate (prettyRendering (addFixit (Columns 35 35) (Columns 38 38) "Fix this!" exampleRendering))
-- 1 | int main(int argc, char ** argv) { int; }<EOF>
--   |                                    ~~~
--   |                                    Fix this!
data Fixit = Fixit
  { Fixit -> Span
_fixitSpan :: {-# UNPACK #-} !Span
    -- ^ 'Span' where the error occurred
  , Fixit -> ByteString
_fixitReplacement :: !ByteString
    -- ^ Replacement suggestion
  } deriving (Fixit -> Fixit -> Bool
(Fixit -> Fixit -> Bool) -> (Fixit -> Fixit -> Bool) -> Eq Fixit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fixit -> Fixit -> Bool
== :: Fixit -> Fixit -> Bool
$c/= :: Fixit -> Fixit -> Bool
/= :: Fixit -> Fixit -> Bool
Eq,Eq Fixit
Eq Fixit =>
(Fixit -> Fixit -> Ordering)
-> (Fixit -> Fixit -> Bool)
-> (Fixit -> Fixit -> Bool)
-> (Fixit -> Fixit -> Bool)
-> (Fixit -> Fixit -> Bool)
-> (Fixit -> Fixit -> Fixit)
-> (Fixit -> Fixit -> Fixit)
-> Ord Fixit
Fixit -> Fixit -> Bool
Fixit -> Fixit -> Ordering
Fixit -> Fixit -> Fixit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Fixit -> Fixit -> Ordering
compare :: Fixit -> Fixit -> Ordering
$c< :: Fixit -> Fixit -> Bool
< :: Fixit -> Fixit -> Bool
$c<= :: Fixit -> Fixit -> Bool
<= :: Fixit -> Fixit -> Bool
$c> :: Fixit -> Fixit -> Bool
> :: Fixit -> Fixit -> Bool
$c>= :: Fixit -> Fixit -> Bool
>= :: Fixit -> Fixit -> Bool
$cmax :: Fixit -> Fixit -> Fixit
max :: Fixit -> Fixit -> Fixit
$cmin :: Fixit -> Fixit -> Fixit
min :: Fixit -> Fixit -> Fixit
Ord,Int -> Fixit -> ShowS
[Fixit] -> ShowS
Fixit -> String
(Int -> Fixit -> ShowS)
-> (Fixit -> String) -> ([Fixit] -> ShowS) -> Show Fixit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fixit -> ShowS
showsPrec :: Int -> Fixit -> ShowS
$cshow :: Fixit -> String
show :: Fixit -> String
$cshowList :: [Fixit] -> ShowS
showList :: [Fixit] -> ShowS
Show,Typeable Fixit
Typeable Fixit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Fixit -> c Fixit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Fixit)
-> (Fixit -> Constr)
-> (Fixit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Fixit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit))
-> ((forall b. Data b => b -> b) -> Fixit -> Fixit)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r)
-> (forall u. (forall d. Data d => d -> u) -> Fixit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Fixit -> m Fixit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Fixit -> m Fixit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Fixit -> m Fixit)
-> Data Fixit
Fixit -> Constr
Fixit -> DataType
(forall b. Data b => b -> b) -> Fixit -> Fixit
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u
forall u. (forall d. Data d => d -> u) -> Fixit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixit -> c Fixit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixit -> c Fixit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixit -> c Fixit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixit
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixit
$ctoConstr :: Fixit -> Constr
toConstr :: Fixit -> Constr
$cdataTypeOf :: Fixit -> DataType
dataTypeOf :: Fixit -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit)
$cgmapT :: (forall b. Data b => b -> b) -> Fixit -> Fixit
gmapT :: (forall b. Data b => b -> b) -> Fixit -> Fixit
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Fixit -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Fixit -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
Data,(forall x. Fixit -> Rep Fixit x)
-> (forall x. Rep Fixit x -> Fixit) -> Generic Fixit
forall x. Rep Fixit x -> Fixit
forall x. Fixit -> Rep Fixit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Fixit -> Rep Fixit x
from :: forall x. Fixit -> Rep Fixit x
$cto :: forall x. Rep Fixit x -> Fixit
to :: forall x. Rep Fixit x -> Fixit
Generic)

makeClassy ''Fixit

instance HasSpan Fixit where
  span :: Lens' Fixit Span
span = (Span -> f Span) -> Fixit -> f Fixit
forall c. HasFixit c => Lens' c Span
Lens' Fixit Span
fixitSpan

instance Hashable Fixit

instance Reducer Fixit Rendering where
  unit :: Fixit -> Rendering
unit = Fixit -> Rendering
forall t. Renderable t => t -> Rendering
render

instance Renderable Fixit where
  render :: Fixit -> Rendering
render (Fixit (Span Delta
s Delta
e ByteString
bs) ByteString
r) = Delta -> Delta -> String -> Rendering -> Rendering
addFixit Delta
s Delta
e (ByteString -> String
UTF8.toString ByteString
r) (Rendering -> Rendering) -> Rendering -> Rendering
forall a b. (a -> b) -> a -> b
$ Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered Delta
s ByteString
bs