module Prettyprinter.Convert.AnsiWlPprint (
fromAnsiWlPprint,
toAnsiWlPprint,
) where
import qualified Data.Text as T
import qualified Prettyprinter.Internal as New
import qualified Prettyprinter.Render.Terminal.Internal as NewTerm
import qualified System.Console.ANSI as Ansi
import qualified Text.PrettyPrint.ANSI.Leijen.Internal as Old
fromAnsiWlPprint :: Old.Doc -> New.Doc NewTerm.AnsiStyle
fromAnsiWlPprint :: Doc -> Doc AnsiStyle
fromAnsiWlPprint = \Doc
doc -> case Doc
doc of
Doc
Old.Fail -> Doc AnsiStyle
forall ann. Doc ann
New.Fail
Doc
Old.Empty -> Doc AnsiStyle
forall ann. Doc ann
New.Empty
Old.Char Char
c -> Char -> Doc AnsiStyle
forall ann. Char -> Doc ann
New.Char Char
c
Old.Text Int
l String
t -> Int -> Text -> Doc AnsiStyle
forall ann. Int -> Text -> Doc ann
New.Text Int
l (String -> Text
T.pack String
t)
Doc
Old.Line -> Doc AnsiStyle
forall ann. Doc ann
New.Line
Old.FlatAlt Doc
x Doc
y -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
New.FlatAlt (Doc -> Doc AnsiStyle
go Doc
x) (Doc -> Doc AnsiStyle
go Doc
y)
Old.Cat Doc
x Doc
y -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
New.Cat (Doc -> Doc AnsiStyle
go Doc
x) (Doc -> Doc AnsiStyle
go Doc
y)
Old.Nest Int
i Doc
x -> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
New.Nest Int
i (Doc -> Doc AnsiStyle
go Doc
x)
Old.Union Doc
x Doc
y -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
New.Union (Doc -> Doc AnsiStyle
go Doc
x) (Doc -> Doc AnsiStyle
go Doc
y)
Old.Column Int -> Doc
f -> (Int -> Doc AnsiStyle) -> Doc AnsiStyle
forall ann. (Int -> Doc ann) -> Doc ann
New.Column (Doc -> Doc AnsiStyle
go (Doc -> Doc AnsiStyle) -> (Int -> Doc) -> Int -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)
Old.Columns Maybe Int -> Doc
f -> (PageWidth -> Doc AnsiStyle) -> Doc AnsiStyle
forall ann. (PageWidth -> Doc ann) -> Doc ann
New.WithPageWidth (Doc -> Doc AnsiStyle
go (Doc -> Doc AnsiStyle)
-> (PageWidth -> Doc) -> PageWidth -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc
f (Maybe Int -> Doc) -> (PageWidth -> Maybe Int) -> PageWidth -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Maybe Int
convert)
where
convert :: New.PageWidth -> Maybe Int
convert :: PageWidth -> Maybe Int
convert (New.AvailablePerLine Int
width Double
_ribbon) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width
convert PageWidth
New.Unbounded = Maybe Int
forall a. Maybe a
Nothing
Old.Nesting Int -> Doc
f -> (Int -> Doc AnsiStyle) -> Doc AnsiStyle
forall ann. (Int -> Doc ann) -> Doc ann
New.Nesting (Doc -> Doc AnsiStyle
go (Doc -> Doc AnsiStyle) -> (Int -> Doc) -> Int -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)
Old.Color ConsoleLayer
layer ColorIntensity
intensity Color
color Doc
x ->
let convertLayerIntensity :: Ansi.ConsoleLayer -> Ansi.ColorIntensity -> NewTerm.Color -> NewTerm.AnsiStyle
convertLayerIntensity :: ConsoleLayer -> ColorIntensity -> Color -> AnsiStyle
convertLayerIntensity ConsoleLayer
Ansi.Foreground ColorIntensity
Ansi.Dull = Color -> AnsiStyle
NewTerm.colorDull
convertLayerIntensity ConsoleLayer
Ansi.Background ColorIntensity
Ansi.Dull = Color -> AnsiStyle
NewTerm.bgColorDull
convertLayerIntensity ConsoleLayer
Ansi.Foreground ColorIntensity
Ansi.Vivid = Color -> AnsiStyle
NewTerm.color
convertLayerIntensity ConsoleLayer
Ansi.Background ColorIntensity
Ansi.Vivid = Color -> AnsiStyle
NewTerm.bgColor
convertColor :: Ansi.Color -> NewTerm.AnsiStyle
convertColor :: Color -> AnsiStyle
convertColor Color
c = ConsoleLayer -> ColorIntensity -> Color -> AnsiStyle
convertLayerIntensity ConsoleLayer
layer ColorIntensity
intensity (case Color
c of
Color
Ansi.Black -> Color
NewTerm.Black
Color
Ansi.Red -> Color
NewTerm.Red
Color
Ansi.Green -> Color
NewTerm.Green
Color
Ansi.Yellow -> Color
NewTerm.Yellow
Color
Ansi.Blue -> Color
NewTerm.Blue
Color
Ansi.Magenta -> Color
NewTerm.Magenta
Color
Ansi.Cyan -> Color
NewTerm.Cyan
Color
Ansi.White -> Color
NewTerm.White )
in AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
New.annotate (Color -> AnsiStyle
convertColor Color
color) (Doc -> Doc AnsiStyle
go Doc
x)
Old.Intensify ConsoleIntensity
intensity Doc
x -> case ConsoleIntensity
intensity of
ConsoleIntensity
Ansi.BoldIntensity -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
New.annotate AnsiStyle
NewTerm.bold (Doc -> Doc AnsiStyle
go Doc
x)
ConsoleIntensity
Ansi.FaintIntensity -> Doc -> Doc AnsiStyle
go Doc
x
ConsoleIntensity
Ansi.NormalIntensity -> Doc -> Doc AnsiStyle
go Doc
x
Old.Italicize Bool
i Doc
x -> case Bool
i of
Bool
False -> Doc -> Doc AnsiStyle
go Doc
x
Bool
True -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
New.annotate AnsiStyle
NewTerm.italicized (Doc -> Doc AnsiStyle
go Doc
x)
Old.Underline Underlining
_ Doc
x -> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
New.annotate AnsiStyle
NewTerm.underlined (Doc -> Doc AnsiStyle
go Doc
x)
Old.RestoreFormat{} -> String -> Doc AnsiStyle
forall a. HasCallStack => String -> a
error String
"Malformed input: RestoreFormat mayb only be used during rendering. Please report this as a bug."
where
go :: Doc -> Doc AnsiStyle
go = Doc -> Doc AnsiStyle
fromAnsiWlPprint
toAnsiWlPprint :: New.Doc NewTerm.AnsiStyle -> Old.Doc
toAnsiWlPprint :: Doc AnsiStyle -> Doc
toAnsiWlPprint = \Doc AnsiStyle
doc -> case Doc AnsiStyle
doc of
Doc AnsiStyle
New.Fail -> Doc
Old.Fail
Doc AnsiStyle
New.Empty -> Doc
Old.Empty
New.Char Char
c -> Char -> Doc
Old.Char Char
c
New.Text Int
l Text
t -> Int -> String -> Doc
Old.Text Int
l (Text -> String
T.unpack Text
t)
Doc AnsiStyle
New.Line -> Doc
Old.Line
New.FlatAlt Doc AnsiStyle
x Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.FlatAlt (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Cat Doc AnsiStyle
x Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.Cat (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Nest Int
i Doc AnsiStyle
x -> Int -> Doc -> Doc
Old.Nest Int
i (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x)
New.Union Doc AnsiStyle
x Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.Union (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Column Int -> Doc AnsiStyle
f -> (Int -> Doc) -> Doc
Old.Column (Doc AnsiStyle -> Doc
go (Doc AnsiStyle -> Doc) -> (Int -> Doc AnsiStyle) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc AnsiStyle
f)
New.WithPageWidth PageWidth -> Doc AnsiStyle
f -> (Maybe Int -> Doc) -> Doc
Old.Columns (Doc AnsiStyle -> Doc
go (Doc AnsiStyle -> Doc)
-> (Maybe Int -> Doc AnsiStyle) -> Maybe Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc AnsiStyle
f (PageWidth -> Doc AnsiStyle)
-> (Maybe Int -> PageWidth) -> Maybe Int -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> PageWidth
convert)
where
convert :: Maybe Int -> New.PageWidth
convert :: Maybe Int -> PageWidth
convert Maybe Int
Nothing = PageWidth
New.Unbounded
convert (Just Int
width) = Int -> Double -> PageWidth
New.AvailablePerLine Int
width Double
1.0
New.Nesting Int -> Doc AnsiStyle
f -> (Int -> Doc) -> Doc
Old.Nesting (Doc AnsiStyle -> Doc
go (Doc AnsiStyle -> Doc) -> (Int -> Doc AnsiStyle) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc AnsiStyle
f)
New.Annotated AnsiStyle
style Doc AnsiStyle
x -> (Doc -> Doc
convertFg (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
convertBg (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
convertBold (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
convertUnderlining) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x)
where
convertFg, convertBg, convertBold, convertUnderlining :: Old.Doc -> Old.Doc
convertFg :: Doc -> Doc
convertFg = case AnsiStyle -> Maybe (Intensity, Color)
NewTerm.ansiForeground AnsiStyle
style of
Maybe (Intensity, Color)
Nothing -> Doc -> Doc
forall a. a -> a
id
Just (Intensity
intensity, Color
color) -> Bool -> Intensity -> Color -> Doc -> Doc
convertColor Bool
True Intensity
intensity Color
color
convertBg :: Doc -> Doc
convertBg = case AnsiStyle -> Maybe (Intensity, Color)
NewTerm.ansiBackground AnsiStyle
style of
Maybe (Intensity, Color)
Nothing -> Doc -> Doc
forall a. a -> a
id
Just (Intensity
intensity, Color
color) -> Bool -> Intensity -> Color -> Doc -> Doc
convertColor Bool
False Intensity
intensity Color
color
convertBold :: Doc -> Doc
convertBold = case AnsiStyle -> Maybe Bold
NewTerm.ansiBold AnsiStyle
style of
Maybe Bold
Nothing -> Doc -> Doc
forall a. a -> a
id
Just Bold
NewTerm.Bold -> Doc -> Doc
Old.bold
convertUnderlining :: Doc -> Doc
convertUnderlining = case AnsiStyle -> Maybe Underlined
NewTerm.ansiUnderlining AnsiStyle
style of
Maybe Underlined
Nothing -> Doc -> Doc
forall a. a -> a
id
Just Underlined
NewTerm.Underlined -> Doc -> Doc
Old.underline
convertColor
:: Bool
-> NewTerm.Intensity
-> NewTerm.Color
-> Old.Doc
-> Old.Doc
convertColor :: Bool -> Intensity -> Color -> Doc -> Doc
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Black = Doc -> Doc
Old.black
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Red = Doc -> Doc
Old.red
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Green = Doc -> Doc
Old.green
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Yellow = Doc -> Doc
Old.yellow
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Blue = Doc -> Doc
Old.blue
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Magenta = Doc -> Doc
Old.magenta
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.Cyan = Doc -> Doc
Old.cyan
convertColor Bool
True Intensity
NewTerm.Vivid Color
NewTerm.White = Doc -> Doc
Old.white
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Black = Doc -> Doc
Old.dullblack
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Red = Doc -> Doc
Old.dullred
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Green = Doc -> Doc
Old.dullgreen
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Yellow = Doc -> Doc
Old.dullyellow
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Blue = Doc -> Doc
Old.dullblue
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Magenta = Doc -> Doc
Old.dullmagenta
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.Cyan = Doc -> Doc
Old.dullcyan
convertColor Bool
True Intensity
NewTerm.Dull Color
NewTerm.White = Doc -> Doc
Old.dullwhite
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Black = Doc -> Doc
Old.onblack
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Red = Doc -> Doc
Old.onred
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Green = Doc -> Doc
Old.ongreen
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Yellow = Doc -> Doc
Old.onyellow
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Blue = Doc -> Doc
Old.onblue
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Magenta = Doc -> Doc
Old.onmagenta
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.Cyan = Doc -> Doc
Old.oncyan
convertColor Bool
False Intensity
NewTerm.Vivid Color
NewTerm.White = Doc -> Doc
Old.onwhite
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Black = Doc -> Doc
Old.ondullblack
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Red = Doc -> Doc
Old.ondullred
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Green = Doc -> Doc
Old.ondullgreen
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Yellow = Doc -> Doc
Old.ondullyellow
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Blue = Doc -> Doc
Old.ondullblue
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Magenta = Doc -> Doc
Old.ondullmagenta
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.Cyan = Doc -> Doc
Old.ondullcyan
convertColor Bool
False Intensity
NewTerm.Dull Color
NewTerm.White = Doc -> Doc
Old.ondullwhite
where
go :: Doc AnsiStyle -> Doc
go = Doc AnsiStyle -> Doc
toAnsiWlPprint