{-# 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 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 (forall a. [a] -> [a]
P.reverse [SGR]
xs0) where
  go :: [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go []                                         = forall a. a -> a
id
  go (SetConsoleIntensity ConsoleIntensity
NormalIntensity : [SGR]
xs) = forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
debold forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetConsoleIntensity ConsoleIntensity
BoldIntensity   : [SGR]
xs) = forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetUnderlining Underlining
NoUnderline          : [SGR]
xs) = forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
deunderline forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
  go (SetUnderlining Underlining
SingleUnderline      : [SGR]
xs) = forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
underlined 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
    ConsoleLayer
Foreground -> case ColorIntensity
i of
      ColorIntensity
Dull -> case Color
c of
        Color
Black   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Black) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Red) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Green) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Yellow) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Blue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Magenta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.Cyan) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Pretty.White) 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   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Black) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Red) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Green) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Yellow) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Blue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Magenta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.Cyan) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
colorDull Color
Pretty.White) 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   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Black) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Red) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Green) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Yellow) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Blue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Magenta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.Cyan) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColorDull Color
Pretty.White) 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   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Black) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Red     -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Red) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Green   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Green) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Yellow  -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Yellow) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Blue    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Blue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Magenta -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Magenta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
Cyan    -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.Cyan) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
go [SGR]
xs
        Color
White   -> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
bgColor Color
Pretty.White) 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 forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// forall a. (a -> Bool) -> [a] -> [a]
P.filter (forall a. Ix a => (a, a) -> a -> Bool
inRange (forall i e. Array i e -> (i, i)
bounds Array i e
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(i, e)]
xs

grow :: Int -> Lines -> Lines
grow :: Int -> Lines -> Lines
grow Int
y Lines
a
  | forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
t,Int
b) Int
y = Lines
a
  | Bool
otherwise = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int64), (Int, Int64))
new [ ((Int, Int64)
i, if forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int, Int64), (Int, Int64))
old (Int, Int64)
i then Lines
a forall i e. Ix i => Array i e -> i -> e
! (Int, Int64)
i else ([],Char
' ')) | (Int, Int64)
i <- 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)) = forall i e. Array i e -> (i, i)
bounds Lines
a
        new :: ((Int, Int64), (Int, Int64))
new = ((forall a. Ord a => a -> a -> a
min Int
t Int
y,Int64
lo),(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 forall a b. (a -> b) -> a -> b
$ Lines -> Lines
lt (Lines
a 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)) = forall i e. Array i e -> (i, i)
bounds Lines
a
    out :: [((Int, Int64), ([SGR], Char))]
out = 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 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any (\((Int, Int64), ([SGR], Char))
el -> forall a b. (a, b) -> b
snd (forall a b. (a, b) -> a
fst ((Int, Int64), ([SGR], Char))
el) forall a. Ord a => a -> a -> Bool
< Int64
lo) [((Int, Int64), ([SGR], Char))]
out = (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 = forall a. a -> a
id
    gt :: Lines -> Lines
gt | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any (\((Int, Int64), ([SGR], Char))
el -> forall a b. (a, b) -> b
snd (forall a b. (a, b) -> a
fst ((Int, Int64), ([SGR], Char))
el) forall a. Ord a => a -> a -> Bool
> Int64
hi) [((Int, Int64), ([SGR], Char))]
out = (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 = 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Rendering " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Delta
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int64
ll forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int64
lb 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 forall a. a -> a
id (forall a b. a -> b -> a
const 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 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 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 = 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 | 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 = 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
    | 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
s
      ls :: Int64
ls = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
mod Int
n Int
8 in forall a. Int -> a -> [a]
P.replicate Int
t Char
' ' forall a. [a] -> [a] -> [a]
++ Int -> ShowS
go (Int
n 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 forall a. a -> [a] -> [a]
: Int -> ShowS
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) String
xs
      go Int
_ []        = []

instance Source ByteString where
  source :: ByteString -> (Int64, Int64, Lines -> Lines)
source = forall t. Source t => t -> (Int64, Int64, Lines -> Lines)
source 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 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 forall a b. (a -> b) -> a -> b
$ \Delta
e Lines
l -> Delta -> Lines -> Lines
f Delta
e 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) = forall ann. (Int -> Doc ann) -> Doc ann
nesting forall a b. (a -> b) -> a -> b
$ \Int
k -> (Maybe Int -> Doc AnsiStyle) -> Doc AnsiStyle
columns forall a b. (a -> b) -> a -> b
$ \Maybe Int
mn -> Int64 -> Doc AnsiStyle
go (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe Int
80 Maybe Int
mn forall a. Num a => a -> a -> a
- Int
k)) where
  go :: Int64 -> Doc AnsiStyle
go Int64
cols = forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
vsep (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 (forall t. HasDelta t => t -> Int64
column Delta
d) Int64
ll (forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max (Int64
cols forall a. Num a => a -> a -> a
- Int64
5 forall a. Num a => a -> a -> a
- 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 forall a b. (a -> b) -> a -> b
$ Lines -> Lines
l forall a b. (a -> b) -> a -> b
$ 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
_)) = forall i e. Array i e -> (i, i)
bounds Lines
a
    n :: String
n = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ case Delta
d of
      Lines      Int64
n' Int64
_ Int64
_ Int64
_ -> Int64
1 forall a. Num a => a -> a -> a
+ Int64
n'
      Directed ByteString
_ Int64
n' Int64
_ Int64
_ Int64
_ -> Int64
1 forall a. Num a => a -> a -> a
+ Int64
n'
      Delta
_                   -> Int64
1
    separator :: Doc a
separator = forall a. Char -> Doc a
char Char
'|'
    gutterWidth :: Int
gutterWidth = forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
n
    gutter :: Doc ann
gutter = forall a ann. Pretty a => a -> Doc ann
pretty String
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {a}. Doc a
separator
    margin :: Doc ann
margin = forall ann. Int -> Doc ann -> Doc ann
fill Int
gutterWidth forall {a}. Doc a
space forall 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 forall a. Eq a => a -> a -> Bool
== Int
0 then forall {a}. Doc a
gutter else forall {a}. Doc a
margin) forall ann. Doc ann -> Doc ann -> Doc ann
<+>)
         forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
hcat
         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
P.map (\NonEmpty ([SGR], Char)
g -> [SGR] -> Doc AnsiStyle -> Doc AnsiStyle
sgr (forall a b. (a, b) -> a
fst (forall a. NonEmpty a -> a
NE.head NonEmpty ([SGR], Char)
g)) (forall a ann. Pretty a => a -> Doc ann
pretty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd NonEmpty ([SGR], Char)
g)))
         forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
         [ Lines
a 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 forall a. Ord a => a -> a -> Bool
<= Int64
w2     = (Int64
0, forall a. Ord a => a -> a -> a
min Int64
w Int64
l)
  | Int64
c forall a. Num a => a -> a -> a
+ Int64
w2 forall a. Ord a => a -> a -> Bool
>= Int64
l = if Int64
l forall a. Ord a => a -> a -> Bool
> Int64
w then (Int64
lforall a. Num a => a -> a -> a
-Int64
w, Int64
l)
                           else (Int64
0  , Int64
w)
  | Bool
otherwise   = (Int64
cforall a. Num a => a -> a -> a
-Int64
w2, Int64
cforall a. Num a => a -> a -> a
+Int64
w2)
  where w2 :: Int64
w2 = 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
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
showList :: [Rendered a] -> ShowS
$cshowList :: forall a. Show a => [Rendered a] -> ShowS
show :: Rendered a -> String
$cshow :: forall a. Show a => Rendered a -> String
showsPrec :: Int -> Rendered a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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 forall a. a -> Rendering -> Rendered a
:@ Rendering
s

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

instance HasBytes (Rendered a) where
  bytes :: Rendered a -> Int64
bytes = forall t. HasBytes t => t -> Int64
bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall a. a -> Rendering -> Rendered a
:@ (Rendering
s 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) = (forall a. a -> Rendering -> Rendered a
:@ Rendering
s) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Caret -> Caret -> Bool
$c/= :: Caret -> Caret -> Bool
== :: Caret -> Caret -> Bool
$c== :: Caret -> Caret -> Bool
Eq,Eq 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
min :: Caret -> Caret -> Caret
$cmin :: Caret -> Caret -> Caret
max :: Caret -> Caret -> Caret
$cmax :: Caret -> Caret -> Caret
>= :: Caret -> Caret -> Bool
$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
compare :: Caret -> Caret -> Ordering
$ccompare :: Caret -> Caret -> Ordering
Ord,Int -> Caret -> ShowS
[Caret] -> ShowS
Caret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Caret] -> ShowS
$cshowList :: [Caret] -> ShowS
show :: Caret -> String
$cshow :: Caret -> String
showsPrec :: Int -> Caret -> ShowS
$cshowsPrec :: Int -> Caret -> ShowS
Show,Typeable Caret
Caret -> DataType
Caret -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Caret -> m Caret
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Caret -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Caret -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Caret -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Caret -> r
gmapT :: (forall b. Data b => b -> b) -> Caret -> Caret
$cgmapT :: (forall b. Data b => b -> b) -> Caret -> Caret
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Caret)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caret)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Caret)
dataTypeOf :: Caret -> DataType
$cdataTypeOf :: Caret -> DataType
toConstr :: Caret -> Constr
$ctoConstr :: Caret -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caret
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Caret
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caret -> c Caret
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Caret -> c Caret
Data,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
$cto :: forall x. Rep Caret x -> Caret
$cfrom :: forall x. Caret -> Rep Caret x
Generic)

class HasCaret t where
  caret :: Lens' t Caret

instance HasCaret Caret where
  caret :: Lens' Caret Caret
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 forall a b. (a -> b) -> a -> b
$ [SGR] -> Int -> Int64 -> String -> Lines -> Lines
draw [SGR]
caretEffects Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 = forall t. HasBytes t => t -> Int64
bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ forall s. Source s => Delta -> s -> Rendering
rendered Delta
d ByteString
bs

instance Reducer Caret Rendering where
  unit :: Caret -> Rendering
unit = 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 forall a b. (a -> b) -> a -> b
$ forall s. Source s => Delta -> s -> Rendering
rendered Delta
d ByteString
bs

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

instance HasCaret (Careted a) where
  caret :: Lens' (Careted a) Caret
caret Caret -> f Caret
f (a
a :^ Caret
c) = (a
a forall a. a -> Caret -> 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 forall a. a -> Caret -> Careted a
:^ Caret
s

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

instance HasBytes (Careted a) where
  bytes :: Careted a -> Int64
bytes (a
_ :^ Caret
c) = 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 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 forall a. a -> Caret -> Careted a
:^ (Caret
c 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) = (forall a. a -> Caret -> Careted a
:^ Caret
s) 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) = forall t. Renderable t => t -> Rendering
render Caret
a

instance Reducer (Careted a) Rendering where
  unit :: Careted a -> Rendering
unit = 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 (forall t. HasDelta t => t -> Int64
column Delta
lo) (forall {a}. Int64 -> a -> [a]
rep (forall a. Ord a => a -> a -> a
max (forall t. HasDelta t => t -> Int64
column Delta
hi forall a. Num a => a -> a -> a
- forall t. HasDelta t => t -> Int64
column Delta
lo) Int64
0) Char
'~') Lines
a
  | Bool
nearLo           = Int64 -> String -> Lines -> Lines
go (forall t. HasDelta t => t -> Int64
column Delta
lo) (forall {a}. Int64 -> a -> [a]
rep (forall a. Ord a => a -> a -> a
max (forall a b. (a, b) -> b
snd (forall a b. (a, b) -> b
snd (forall i e. Array i e -> (i, i)
bounds Lines
a)) forall a. Num a => a -> a -> a
- forall t. HasDelta t => t -> Int64
column Delta
lo forall a. Num a => a -> a -> a
+ Int64
1) Int64
0) Char
'~') Lines
a
  |           Bool
nearHi = Int64 -> String -> Lines -> Lines
go (-Int64
1)        (forall {a}. Int64 -> a -> [a]
rep (forall a. Ord a => a -> a -> a
max (forall t. HasDelta t => t -> Int64
column Delta
hi 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
    lo :: Delta
lo = forall b a. Ord b => (a -> b) -> a -> a -> a
argmin forall t. HasBytes t => t -> Int64
bytes Delta
start Delta
end
    hi :: Delta
hi = forall b a. Ord b => (a -> b) -> a -> a -> a
argmax forall t. HasBytes t => t -> Int64
bytes Delta
start Delta
end
    nearLo :: Bool
nearLo = forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
lo Delta
d
    nearHi :: Bool
nearHi = forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
hi Delta
d
    rep :: Int64 -> a -> [a]
rep = forall a. Int -> a -> [a]
P.replicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq,Eq 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
min :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmax :: Span -> Span -> Span
>= :: Span -> Span -> Bool
$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
compare :: Span -> Span -> Ordering
$ccompare :: Span -> Span -> Ordering
Ord,Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show,Typeable Span
Span -> DataType
Span -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Span -> m Span
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Span -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Span -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r
gmapT :: (forall b. Data b => b -> b) -> Span -> Span
$cgmapT :: (forall b. Data b => b -> b) -> Span -> Span
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Span)
dataTypeOf :: Span -> DataType
$cdataTypeOf :: Span -> DataType
toConstr :: Span -> Constr
$ctoConstr :: Span -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Span
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Span -> c Span
Data,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
$cto :: forall x. Rep Span x -> Span
$cfrom :: forall x. Span -> Rep Span x
Generic)

class HasSpan t where
  span :: Lens' t Span

instance HasSpan Span where
  span :: Lens' Span Span
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 forall a b. (a -> b) -> a -> b
$ 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 = 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
forall a. Eq a => Spanned a -> Spanned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spanned a -> Spanned a -> Bool
$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
Eq,Spanned a -> Spanned a -> Bool
Spanned a -> Spanned a -> Ordering
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
min :: Spanned a -> Spanned a -> Spanned a
$cmin :: forall a. Ord a => Spanned a -> Spanned a -> Spanned a
max :: Spanned a -> Spanned a -> Spanned a
$cmax :: forall a. Ord a => Spanned a -> Spanned a -> Spanned a
>= :: 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
$c< :: forall a. Ord a => Spanned a -> Spanned a -> Bool
compare :: Spanned a -> Spanned a -> Ordering
$ccompare :: forall a. Ord a => Spanned a -> Spanned a -> Ordering
Ord,Int -> Spanned a -> ShowS
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
showList :: [Spanned a] -> ShowS
$cshowList :: forall a. Show a => [Spanned a] -> ShowS
show :: Spanned a -> String
$cshow :: forall a. Show a => Spanned a -> String
showsPrec :: Int -> Spanned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Spanned a -> ShowS
Show,Spanned a -> DataType
Spanned a -> Constr
forall {a}. Data a => Typeable (Spanned a)
forall a. Data a => Spanned a -> DataType
forall a. Data a => Spanned a -> Constr
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 (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))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Spanned a -> m (Spanned a)
gmapQi :: forall u. Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> Spanned a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Spanned a -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Spanned a -> r
gmapT :: (forall b. Data b => b -> b) -> Spanned a -> Spanned a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Spanned a -> Spanned a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Spanned a))
dataTypeOf :: Spanned a -> DataType
$cdataTypeOf :: forall a. Data a => Spanned a -> DataType
toConstr :: Spanned a -> Constr
$ctoConstr :: forall a. Data a => Spanned a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Spanned a -> 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)
Data,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
$cto :: forall a x. Rep (Spanned a) x -> Spanned a
$cfrom :: forall a x. Spanned a -> Rep (Spanned a) x
Generic)

instance HasSpan (Spanned a) where
  span :: Lens' (Spanned a) Span
span Span -> f Span
f (a
a :~ Span
c) = (a
a forall a. a -> Span -> 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 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 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 forall a. a -> Span -> Spanned a
:~ (Span
c 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) = (forall a. a -> Span -> Spanned a
:~ Span
s) 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 = forall t. Renderable t => t -> Rendering
render

instance Renderable (Spanned a) where
  render :: Spanned a -> Rendering
render (a
_ :~ Span
s) = 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. HasDelta t => t -> Int64
column Delta
l)) String
rpl) Delta
d
                      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 = forall b a. Ord b => (a -> b) -> a -> a -> a
argmin 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixit -> Fixit -> Bool
$c/= :: Fixit -> Fixit -> Bool
== :: Fixit -> Fixit -> Bool
$c== :: Fixit -> Fixit -> Bool
Eq,Eq 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
min :: Fixit -> Fixit -> Fixit
$cmin :: Fixit -> Fixit -> Fixit
max :: Fixit -> Fixit -> Fixit
$cmax :: Fixit -> Fixit -> Fixit
>= :: Fixit -> Fixit -> Bool
$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
compare :: Fixit -> Fixit -> Ordering
$ccompare :: Fixit -> Fixit -> Ordering
Ord,Int -> Fixit -> ShowS
[Fixit] -> ShowS
Fixit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixit] -> ShowS
$cshowList :: [Fixit] -> ShowS
show :: Fixit -> String
$cshow :: Fixit -> String
showsPrec :: Int -> Fixit -> ShowS
$cshowsPrec :: Int -> Fixit -> ShowS
Show,Typeable Fixit
Fixit -> DataType
Fixit -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixit -> m Fixit
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixit -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Fixit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Fixit -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixit -> r
gmapT :: (forall b. Data b => b -> b) -> Fixit -> Fixit
$cgmapT :: (forall b. Data b => b -> b) -> Fixit -> Fixit
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixit)
dataTypeOf :: Fixit -> DataType
$cdataTypeOf :: Fixit -> DataType
toConstr :: Fixit -> Constr
$ctoConstr :: Fixit -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixit -> c Fixit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixit -> c Fixit
Data,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
$cto :: forall x. Rep Fixit x -> Fixit
$cfrom :: forall x. Fixit -> Rep Fixit x
Generic)

makeClassy ''Fixit

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

instance Hashable Fixit

instance Reducer Fixit Rendering where
  unit :: Fixit -> Rendering
unit = 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) forall a b. (a -> b) -> a -> b
$ forall s. Source s => Delta -> s -> Rendering
rendered Delta
s ByteString
bs