-- | Utilities to pretty print 'Expr' and 'EditExpr'
module Data.TreeDiff.Pretty (
    -- * Explicit dictionary
    Pretty (..),
    ppExpr,
    ppEditExpr,
    ppEditExprCompact,
    -- * pretty
    prettyPretty,
    prettyExpr,
    prettyEditExpr,
    prettyEditExprCompact,
    -- * ansi-wl-pprint
    ansiWlPretty,
    ansiWlExpr,
    ansiWlEditExpr,
    ansiWlEditExprCompact,
    -- ** background
    ansiWlBgPretty,
    ansiWlBgExpr,
    ansiWlBgEditExpr,
    ansiWlBgEditExprCompact,
    -- * Utilities
    escapeName,
) where

import Data.Char          (isAlphaNum, isPunctuation, isSymbol, ord)
import Data.Either        (partitionEithers)
import Data.TreeDiff.Expr
import Numeric            (showHex)
import Text.Read.Compat   (readMaybe)

import qualified Data.TreeDiff.OMap           as OMap
import qualified Text.PrettyPrint             as HJ
import qualified Text.PrettyPrint.ANSI.Leijen as WL

-- $setup
-- >>> import qualified Data.TreeDiff.OMap as OMap
-- >>> import Data.TreeDiff.Expr

-- | Because we don't want to commit to single pretty printing library,
-- we use explicit dictionary.
data Pretty doc = Pretty
    { forall doc. Pretty doc -> ConstructorName -> doc
ppCon    :: ConstructorName -> doc            -- ^ Display 'ConstructorName'
    , forall doc. Pretty doc -> doc -> [doc] -> doc
ppApp    :: doc -> [doc] -> doc               -- ^ Display 'App'
    , forall doc. Pretty doc -> doc -> [(ConstructorName, doc)] -> doc
ppRec    :: doc -> [(FieldName, doc)] -> doc  -- ^ Display 'Rec'
    , forall doc. Pretty doc -> [doc] -> doc
ppLst    :: [doc] -> doc                      -- ^ Display 'Lst'
    , forall doc. Pretty doc -> doc -> doc
ppCpy    :: doc -> doc                        -- ^ Display unchanged parts
    , forall doc. Pretty doc -> doc -> doc
ppIns    :: doc -> doc                        -- ^ Display added parts
    , forall doc. Pretty doc -> doc -> doc
ppDel    :: doc -> doc                        -- ^ Display removed parts
    , forall doc. Pretty doc -> [doc] -> doc
ppEdits  :: [doc] -> doc                      -- ^ Combined edits (usually some @sep@ combinator)
    , forall doc. Pretty doc -> doc
ppEllip  :: doc                               -- ^ Ellipsis
    , forall doc. Pretty doc -> doc -> doc
ppParens :: doc -> doc                        -- ^ Parens an expression
    }

-- | Escape field or constructor name
--
-- >>> putStrLn $ escapeName "Foo"
-- Foo
--
-- >>> putStrLn $ escapeName "_×_"
-- _×_
--
-- >>> putStrLn $ escapeName "-3"
-- `-3`
--
-- >>> putStrLn $ escapeName "kebab-case"
-- kebab-case
--
-- >>> putStrLn $ escapeName "inner space"
-- `inner space`
--
-- >>> putStrLn $ escapeName $ show "looks like a string"
-- "looks like a string"
--
-- >>> putStrLn $ escapeName $ show "tricky" ++ "   "
-- `"tricky"   `
--
-- >>> putStrLn $ escapeName "[]"
-- `[]`
--
-- >>> putStrLn $ escapeName "_,_"
-- `_,_`
--
escapeName :: String -> String
escapeName :: ConstructorName -> ConstructorName
escapeName ConstructorName
n
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ConstructorName
n                      = ConstructorName
"``"
    | ConstructorName -> Bool
isValidString ConstructorName
n             = ConstructorName
n
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
valid' ConstructorName
n Bool -> Bool -> Bool
&& ConstructorName -> Bool
headNotMP ConstructorName
n = ConstructorName
n
    | Bool
otherwise                   = ConstructorName
"`" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> ConstructorName
e ConstructorName
n forall a. [a] -> [a] -> [a]
++ ConstructorName
"`"
  where
    e :: Char -> ConstructorName
e Char
'`'               = ConstructorName
"\\`"
    e Char
'\\'              = ConstructorName
"\\\\"
    e Char
' '               = ConstructorName
" "
    e Char
c | Bool -> Bool
not (Char -> Bool
valid Char
c) = ConstructorName
"\\x" forall a. [a] -> [a] -> [a]
++ forall a.
(Integral a, Show a) =>
a -> ConstructorName -> ConstructorName
showHex (Char -> Int
ord Char
c) ConstructorName
";"
    e Char
c                 = [Char
c]

    valid :: Char -> Bool
valid Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c
    valid' :: Char -> Bool
valid' Char
c = Char -> Bool
valid Char
c Bool -> Bool -> Bool
&& Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ConstructorName
"[](){}`\","

    headNotMP :: ConstructorName -> Bool
headNotMP (Char
'-' : ConstructorName
_) = Bool
False
    headNotMP (Char
'+' : ConstructorName
_) = Bool
False
    headNotMP ConstructorName
_         = Bool
True

    isValidString :: ConstructorName -> Bool
isValidString ConstructorName
s
        | forall (t :: * -> *) a. Foldable t => t a -> Int
length ConstructorName
s forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& forall a. [a] -> a
head ConstructorName
s forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& forall a. [a] -> a
last ConstructorName
s forall a. Eq a => a -> a -> Bool
== Char
'"' =
            case forall a. Read a => ConstructorName -> Maybe a
readMaybe ConstructorName
s :: Maybe String of
                Just ConstructorName
_ -> Bool
True
                Maybe ConstructorName
Nothing -> Bool
False
    isValidString ConstructorName
_         = Bool
False

-- | Pretty print an 'Expr' using explicit pretty-printing dictionary.
ppExpr :: Pretty doc -> Expr -> doc
ppExpr :: forall doc. Pretty doc -> Expr -> doc
ppExpr Pretty doc
p = forall doc. Pretty doc -> Bool -> Expr -> doc
ppExpr' Pretty doc
p Bool
False

ppExpr' :: Pretty doc -> Bool -> Expr -> doc
ppExpr' :: forall doc. Pretty doc -> Bool -> Expr -> doc
ppExpr' Pretty doc
p = Bool -> Expr -> doc
impl where
    impl :: Bool -> Expr -> doc
impl Bool
_ (App ConstructorName
x []) = forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)
    impl Bool
b (App ConstructorName
x [Expr]
xs) = Bool -> doc -> doc
ppParens' Bool
b forall a b. (a -> b) -> a -> b
$ forall doc. Pretty doc -> doc -> [doc] -> doc
ppApp Pretty doc
p (forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)) (forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> doc
impl Bool
True) [Expr]
xs)
    impl Bool
_ (Rec ConstructorName
x OMap ConstructorName Expr
xs) = forall doc. Pretty doc -> doc -> [(ConstructorName, doc)] -> doc
ppRec Pretty doc
p (forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)) forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (ConstructorName, Expr) -> (ConstructorName, doc)
ppField' forall a b. (a -> b) -> a -> b
$ forall k v. OMap k v -> [(k, v)]
OMap.toList OMap ConstructorName Expr
xs
    impl Bool
_ (Lst [Expr]
xs)   = forall doc. Pretty doc -> [doc] -> doc
ppLst Pretty doc
p (forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> doc
impl Bool
False) [Expr]
xs)

    ppField' :: (ConstructorName, Expr) -> (ConstructorName, doc)
ppField' (ConstructorName
n, Expr
e) = (ConstructorName -> ConstructorName
escapeName ConstructorName
n, Bool -> Expr -> doc
impl Bool
False Expr
e)

    ppParens' :: Bool -> doc -> doc
ppParens' Bool
True  = forall doc. Pretty doc -> doc -> doc
ppParens Pretty doc
p
    ppParens' Bool
False = forall a. a -> a
id

-- | Pretty print an @'Edit' 'EditExpr'@ using explicit pretty-printing dictionary.
ppEditExpr :: Pretty doc -> Edit EditExpr -> doc
ppEditExpr :: forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExpr = forall doc. Bool -> Pretty doc -> Edit EditExpr -> doc
ppEditExpr' Bool
False

-- | Like 'ppEditExpr' but print unchanged parts only shallowly
ppEditExprCompact :: Pretty doc -> Edit EditExpr -> doc
ppEditExprCompact :: forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExprCompact = forall doc. Bool -> Pretty doc -> Edit EditExpr -> doc
ppEditExpr' Bool
True

ppEditExpr' :: Bool -> Pretty doc -> Edit EditExpr -> doc
ppEditExpr' :: forall doc. Bool -> Pretty doc -> Edit EditExpr -> doc
ppEditExpr' Bool
compact Pretty doc
p = Edit EditExpr -> doc
go
  where
    go :: Edit EditExpr -> doc
go = forall doc. Pretty doc -> [doc] -> doc
ppEdits Pretty doc
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Edit EditExpr -> [doc]
ppEdit Bool
False

    ppEdit :: Bool -> Edit EditExpr -> [doc]
ppEdit Bool
b (Cpy (EditExp Expr
expr)) = [ forall doc. Pretty doc -> doc -> doc
ppCpy Pretty doc
p forall a b. (a -> b) -> a -> b
$ forall doc. Pretty doc -> Bool -> Expr -> doc
ppExpr' Pretty doc
p Bool
b Expr
expr ]
    ppEdit Bool
b (Cpy EditExpr
expr) = [ Bool -> EditExpr -> doc
ppEExpr Bool
b EditExpr
expr ]
    ppEdit Bool
b (Ins EditExpr
expr) = [ forall doc. Pretty doc -> doc -> doc
ppIns Pretty doc
p (Bool -> EditExpr -> doc
ppEExpr Bool
b EditExpr
expr) ]
    ppEdit Bool
b (Del EditExpr
expr) = [ forall doc. Pretty doc -> doc -> doc
ppDel Pretty doc
p (Bool -> EditExpr -> doc
ppEExpr Bool
b EditExpr
expr) ]
    ppEdit Bool
b (Swp EditExpr
x EditExpr
y) =
        [ forall doc. Pretty doc -> doc -> doc
ppDel Pretty doc
p (Bool -> EditExpr -> doc
ppEExpr Bool
b EditExpr
x)
        , forall doc. Pretty doc -> doc -> doc
ppIns Pretty doc
p (Bool -> EditExpr -> doc
ppEExpr Bool
b EditExpr
y)
        ]

    ppEExpr :: Bool -> EditExpr -> doc
ppEExpr Bool
_ (EditApp ConstructorName
x []) = forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)
    ppEExpr Bool
b (EditApp ConstructorName
x [Edit EditExpr]
xs) = Bool -> doc -> doc
ppParens' Bool
b forall a b. (a -> b) -> a -> b
$ forall doc. Pretty doc -> doc -> [doc] -> doc
ppApp Pretty doc
p (forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Edit EditExpr -> [doc]
ppEdit Bool
True) [Edit EditExpr]
xs)
    ppEExpr Bool
_ (EditRec ConstructorName
x OMap ConstructorName (Edit EditExpr)
xs) = forall doc. Pretty doc -> doc -> [(ConstructorName, doc)] -> doc
ppRec Pretty doc
p (forall doc. Pretty doc -> ConstructorName -> doc
ppCon Pretty doc
p (ConstructorName -> ConstructorName
escapeName ConstructorName
x)) forall a b. (a -> b) -> a -> b
$
        [(ConstructorName, doc)]
justs forall a. [a] -> [a] -> [a]
++ [ (ConstructorName
n, forall doc. Pretty doc -> doc
ppEllip Pretty doc
p) | ConstructorName
n <- forall a. Int -> [a] -> [a]
take Int
1 [ConstructorName]
nothings ]
      where
        xs' :: [Either ConstructorName (ConstructorName, doc)]
xs' = forall a b. (a -> b) -> [a] -> [b]
map (ConstructorName, Edit EditExpr)
-> Either ConstructorName (ConstructorName, doc)
ppField' forall a b. (a -> b) -> a -> b
$ forall k v. OMap k v -> [(k, v)]
OMap.toList OMap ConstructorName (Edit EditExpr)
xs
        ([ConstructorName]
nothings, [(ConstructorName, doc)]
justs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ConstructorName (ConstructorName, doc)]
xs'

    ppEExpr Bool
_ (EditLst [Edit EditExpr]
xs)   = forall doc. Pretty doc -> [doc] -> doc
ppLst Pretty doc
p (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Edit EditExpr -> [doc]
ppEdit Bool
False) [Edit EditExpr]
xs)
    ppEExpr Bool
b (EditExp Expr
x)    = forall doc. Pretty doc -> Bool -> Expr -> doc
ppExpr' Pretty doc
p Bool
b Expr
x

    ppField' :: (ConstructorName, Edit EditExpr)
-> Either ConstructorName (ConstructorName, doc)
ppField' (ConstructorName
n, Cpy (EditExp Expr
e)) | Bool
compact, Bool -> Bool
not (Expr -> Bool
isScalar Expr
e) = forall a b. a -> Either a b
Left ConstructorName
n
    ppField' (ConstructorName
n, Edit EditExpr
e) = forall a b. b -> Either a b
Right (ConstructorName -> ConstructorName
escapeName ConstructorName
n, Edit EditExpr -> doc
go Edit EditExpr
e)

    ppParens' :: Bool -> doc -> doc
ppParens' Bool
True  = forall doc. Pretty doc -> doc -> doc
ppParens Pretty doc
p
    ppParens' Bool
False = forall a. a -> a
id

    isScalar :: Expr -> Bool
isScalar (App ConstructorName
_ []) = Bool
True
    isScalar Expr
_          = Bool
False

-------------------------------------------------------------------------------
-- pretty
-------------------------------------------------------------------------------

-- | 'Pretty' via @pretty@ library.
prettyPretty :: Pretty HJ.Doc
prettyPretty :: Pretty Doc
prettyPretty = Pretty
    { ppCon :: ConstructorName -> Doc
ppCon    = ConstructorName -> Doc
HJ.text
    , ppRec :: Doc -> [(ConstructorName, Doc)] -> Doc
ppRec    = \Doc
c [(ConstructorName, Doc)]
xs -> Doc -> Doc -> [Doc] -> Doc
prettyGroup (Doc
c Doc -> Doc -> Doc
HJ.<+> Char -> Doc
HJ.char Char
'{') (Char -> Doc
HJ.char Char
'}')
               forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ConstructorName
fn, Doc
d) -> [Doc] -> Doc
HJ.sep [ConstructorName -> Doc
HJ.text ConstructorName
fn Doc -> Doc -> Doc
HJ.<+> Doc
HJ.equals, Doc
d]) [(ConstructorName, Doc)]
xs
    , ppLst :: [Doc] -> Doc
ppLst    = Doc -> Doc -> [Doc] -> Doc
prettyGroup (Char -> Doc
HJ.char Char
'[') (Char -> Doc
HJ.char Char
']')
    , ppCpy :: Doc -> Doc
ppCpy    = forall a. a -> a
id
    , ppIns :: Doc -> Doc
ppIns    = \Doc
d -> Char -> Doc
HJ.char Char
'+' Doc -> Doc -> Doc
HJ.<> Doc
d
    , ppDel :: Doc -> Doc
ppDel    = \Doc
d -> Char -> Doc
HJ.char Char
'-' Doc -> Doc -> Doc
HJ.<> Doc
d
    , ppEdits :: [Doc] -> Doc
ppEdits  = [Doc] -> Doc
HJ.sep
    , ppEllip :: Doc
ppEllip  = ConstructorName -> Doc
HJ.text ConstructorName
"..."
    , ppApp :: Doc -> [Doc] -> Doc
ppApp    = \Doc
f [Doc]
xs -> [Doc] -> Doc
HJ.sep [ Doc
f, Int -> Doc -> Doc
HJ.nest Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
HJ.sep [Doc]
xs ]
    , ppParens :: Doc -> Doc
ppParens = Doc -> Doc
HJ.parens
    }

prettyGroup :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> HJ.Doc
prettyGroup :: Doc -> Doc -> [Doc] -> Doc
prettyGroup Doc
l Doc
r [Doc]
xs = [Doc] -> Doc
HJ.cat [Doc
l, [Doc] -> Doc
HJ.sep (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
HJ.nest Int
2) (Doc -> Doc -> [Doc] -> [Doc]
prettyPunct (Char -> Doc
HJ.char Char
',') Doc
r [Doc]
xs))]

prettyPunct :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> [HJ.Doc]
prettyPunct :: Doc -> Doc -> [Doc] -> [Doc]
prettyPunct Doc
_   Doc
end []     = [Doc
end]
prettyPunct Doc
_   Doc
end [Doc
x]    = [Doc
x Doc -> Doc -> Doc
HJ.<> Doc
end]
prettyPunct Doc
sep Doc
end (Doc
x:[Doc]
xs) = (Doc
x Doc -> Doc -> Doc
HJ.<> Doc
sep) forall a. a -> [a] -> [a]
: Doc -> Doc -> [Doc] -> [Doc]
prettyPunct Doc
sep Doc
end [Doc]
xs

-- | Pretty print 'Expr' using @pretty@.
--
-- >>> prettyExpr $ Rec "ex" (OMap.fromList [("[]", App "bar" [])])
-- ex {`[]` = bar}
prettyExpr :: Expr -> HJ.Doc
prettyExpr :: Expr -> Doc
prettyExpr = forall doc. Pretty doc -> Expr -> doc
ppExpr Pretty Doc
prettyPretty

-- | Pretty print @'Edit' 'EditExpr'@ using @pretty@.
prettyEditExpr :: Edit EditExpr -> HJ.Doc
prettyEditExpr :: Edit EditExpr -> Doc
prettyEditExpr = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExpr Pretty Doc
prettyPretty

-- | Compact 'prettyEditExpr'.
prettyEditExprCompact :: Edit EditExpr -> HJ.Doc
prettyEditExprCompact :: Edit EditExpr -> Doc
prettyEditExprCompact = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExprCompact Pretty Doc
prettyPretty

-------------------------------------------------------------------------------
-- ansi-wl-pprint
-------------------------------------------------------------------------------

-- | 'Pretty' via @ansi-wl-pprint@ library (with colors).
ansiWlPretty :: Pretty WL.Doc
ansiWlPretty :: Pretty Doc
ansiWlPretty = Pretty
    { ppCon :: ConstructorName -> Doc
ppCon    = ConstructorName -> Doc
WL.text
    , ppRec :: Doc -> [(ConstructorName, Doc)] -> Doc
ppRec    = \Doc
c [(ConstructorName, Doc)]
xs -> Doc -> Doc -> [Doc] -> Doc
ansiGroup (Doc
c Doc -> Doc -> Doc
WL.<+> Doc
WL.lbrace) Doc
WL.rbrace
               forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ConstructorName
fn, Doc
d) -> ConstructorName -> Doc
WL.text ConstructorName
fn Doc -> Doc -> Doc
WL.<+> Doc
WL.equals Doc -> Doc -> Doc
WL.</> Doc
d) [(ConstructorName, Doc)]
xs
    , ppLst :: [Doc] -> Doc
ppLst    = Doc -> Doc -> [Doc] -> Doc
ansiGroup Doc
WL.lbracket Doc
WL.rbracket
    , ppCpy :: Doc -> Doc
ppCpy    = Doc -> Doc
WL.dullwhite
    , ppIns :: Doc -> Doc
ppIns    = \Doc
d -> Doc -> Doc
WL.green forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.plain forall a b. (a -> b) -> a -> b
$ Char -> Doc
WL.char Char
'+' forall a. Semigroup a => a -> a -> a
WL.<> Doc
d
    , ppDel :: Doc -> Doc
ppDel    = \Doc
d -> Doc -> Doc
WL.red   forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.plain forall a b. (a -> b) -> a -> b
$ Char -> Doc
WL.char Char
'-' forall a. Semigroup a => a -> a -> a
WL.<> Doc
d
    , ppApp :: Doc -> [Doc] -> Doc
ppApp    = \Doc
f [Doc]
xs -> Doc -> Doc
WL.group forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
WL.nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
f Doc -> Doc -> Doc
WL.<$> [Doc] -> Doc
WL.vsep [Doc]
xs
    , ppEdits :: [Doc] -> Doc
ppEdits  = [Doc] -> Doc
WL.sep
    , ppEllip :: Doc
ppEllip  = ConstructorName -> Doc
WL.text ConstructorName
"..."
    , ppParens :: Doc -> Doc
ppParens = Doc -> Doc
WL.parens
    }

ansiGroup :: WL.Doc -> WL.Doc -> [WL.Doc] -> WL.Doc
ansiGroup :: Doc -> Doc -> [Doc] -> Doc
ansiGroup Doc
l Doc
r [Doc]
xs = Doc -> Doc
WL.group forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
WL.nest Int
2 (Doc
l Doc -> Doc -> Doc
WL.<$$> [Doc] -> Doc
WL.vsep (Doc -> [Doc] -> [Doc]
WL.punctuate Doc
WL.comma [Doc]
xs) forall a. Semigroup a => a -> a -> a
WL.<> Doc
r)

-- | Pretty print 'Expr' using @ansi-wl-pprint@.
ansiWlExpr :: Expr -> WL.Doc
ansiWlExpr :: Expr -> Doc
ansiWlExpr = forall doc. Pretty doc -> Expr -> doc
ppExpr Pretty Doc
ansiWlPretty

-- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
ansiWlEditExpr :: Edit EditExpr -> WL.Doc
ansiWlEditExpr :: Edit EditExpr -> Doc
ansiWlEditExpr = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExpr Pretty Doc
ansiWlPretty

-- | Compact 'ansiWlEditExpr'
ansiWlEditExprCompact :: Edit EditExpr -> WL.Doc
ansiWlEditExprCompact :: Edit EditExpr -> Doc
ansiWlEditExprCompact = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExprCompact Pretty Doc
ansiWlPretty

-------------------------------------------------------------------------------
-- Background
-------------------------------------------------------------------------------

-- | Like 'ansiWlPretty' but color the background.
ansiWlBgPretty :: Pretty WL.Doc
ansiWlBgPretty :: Pretty Doc
ansiWlBgPretty = Pretty Doc
ansiWlPretty
    { ppIns :: Doc -> Doc
ppIns    = \Doc
d -> Doc -> Doc
WL.ondullgreen forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.white forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.plain forall a b. (a -> b) -> a -> b
$ Char -> Doc
WL.char Char
'+' forall a. Semigroup a => a -> a -> a
WL.<> Doc
d
    , ppDel :: Doc -> Doc
ppDel    = \Doc
d -> Doc -> Doc
WL.ondullred   forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.white forall a b. (a -> b) -> a -> b
$ Doc -> Doc
WL.plain forall a b. (a -> b) -> a -> b
$ Char -> Doc
WL.char Char
'-' forall a. Semigroup a => a -> a -> a
WL.<> Doc
d
    }

-- | Pretty print 'Expr' using @ansi-wl-pprint@.
ansiWlBgExpr :: Expr -> WL.Doc
ansiWlBgExpr :: Expr -> Doc
ansiWlBgExpr = forall doc. Pretty doc -> Expr -> doc
ppExpr Pretty Doc
ansiWlBgPretty

-- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
ansiWlBgEditExpr :: Edit EditExpr -> WL.Doc
ansiWlBgEditExpr :: Edit EditExpr -> Doc
ansiWlBgEditExpr = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExpr Pretty Doc
ansiWlBgPretty

-- | Compact 'ansiWlBgEditExpr'.
ansiWlBgEditExprCompact :: Edit EditExpr -> WL.Doc
ansiWlBgEditExprCompact :: Edit EditExpr -> Doc
ansiWlBgEditExprCompact = forall doc. Pretty doc -> Edit EditExpr -> doc
ppEditExprCompact Pretty Doc
ansiWlBgPretty