module Prettyprinter.Convert.AnsiWlPprint (
fromAnsiWlPprint,
toAnsiWlPprint,
) where
import qualified Data.Text as T
import qualified Data.Text.Prettyprint.Doc.Internal as New
import qualified Data.Text.Prettyprint.Doc.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
doc -> case Doc
doc of
Old.Fail -> Doc AnsiStyle
forall ann. Doc ann
New.Fail
Old.Empty -> Doc AnsiStyle
forall ann. Doc ann
New.Empty
Old.Char c :: Char
c -> Char -> Doc AnsiStyle
forall ann. Char -> Doc ann
New.Char Char
c
Old.Text l :: Int
l t :: String
t -> Int -> Text -> Doc AnsiStyle
forall ann. Int -> Text -> Doc ann
New.Text Int
l (String -> Text
T.pack String
t)
Old.Line -> Doc AnsiStyle
forall ann. Doc ann
New.Line
Old.FlatAlt x :: Doc
x y :: 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 x :: Doc
x y :: 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 i :: Int
i x :: 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 x :: Doc
x y :: 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 f :: 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 f :: 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 width :: Int
width _ribbon :: Double
_ribbon) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width
convert New.Unbounded = Maybe Int
forall a. Maybe a
Nothing
Old.Nesting f :: 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 layer :: ConsoleLayer
layer intensity :: ColorIntensity
intensity color :: Color
color x :: Doc
x ->
let convertLayerIntensity :: Ansi.ConsoleLayer -> Ansi.ColorIntensity -> NewTerm.Color -> NewTerm.AnsiStyle
convertLayerIntensity :: ConsoleLayer -> ColorIntensity -> Color -> AnsiStyle
convertLayerIntensity Ansi.Foreground Ansi.Dull = Color -> AnsiStyle
NewTerm.colorDull
convertLayerIntensity Ansi.Background Ansi.Dull = Color -> AnsiStyle
NewTerm.bgColorDull
convertLayerIntensity Ansi.Foreground Ansi.Vivid = Color -> AnsiStyle
NewTerm.color
convertLayerIntensity Ansi.Background Ansi.Vivid = Color -> AnsiStyle
NewTerm.bgColor
convertColor :: Ansi.Color -> NewTerm.AnsiStyle
convertColor :: Color -> AnsiStyle
convertColor c :: Color
c = ConsoleLayer -> ColorIntensity -> Color -> AnsiStyle
convertLayerIntensity ConsoleLayer
layer ColorIntensity
intensity (case Color
c of
Ansi.Black -> Color
NewTerm.Black
Ansi.Red -> Color
NewTerm.Red
Ansi.Green -> Color
NewTerm.Green
Ansi.Yellow -> Color
NewTerm.Yellow
Ansi.Blue -> Color
NewTerm.Blue
Ansi.Magenta -> Color
NewTerm.Magenta
Ansi.Cyan -> Color
NewTerm.Cyan
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 intensity :: ConsoleIntensity
intensity x :: Doc
x -> case ConsoleIntensity
intensity of
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)
Ansi.FaintIntensity -> Doc -> Doc AnsiStyle
go Doc
x
Ansi.NormalIntensity -> Doc -> Doc AnsiStyle
go Doc
x
Old.Italicize i :: Bool
i x :: Doc
x -> case Bool
i of
False -> Doc -> Doc AnsiStyle
go Doc
x
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 _ x :: 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 "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 :: Doc AnsiStyle
doc -> case Doc AnsiStyle
doc of
New.Fail -> Doc
Old.Fail
New.Empty -> Doc
Old.Empty
New.Char c :: Char
c -> Char -> Doc
Old.Char Char
c
New.Text l :: Int
l t :: Text
t -> Int -> String -> Doc
Old.Text Int
l (Text -> String
T.unpack Text
t)
New.Line -> Doc
Old.Line
New.FlatAlt x :: Doc AnsiStyle
x y :: Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.FlatAlt (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Cat x :: Doc AnsiStyle
x y :: Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.Cat (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Nest i :: Int
i x :: Doc AnsiStyle
x -> Int -> Doc -> Doc
Old.Nest Int
i (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x)
New.Union x :: Doc AnsiStyle
x y :: Doc AnsiStyle
y -> Doc -> Doc -> Doc
Old.Union (Doc AnsiStyle -> Doc
go Doc AnsiStyle
x) (Doc AnsiStyle -> Doc
go Doc AnsiStyle
y)
New.Column f :: 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 f :: 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 Nothing = PageWidth
New.Unbounded
convert (Just width :: Int
width) = Int -> Double -> PageWidth
New.AvailablePerLine Int
width 1.0
New.Nesting f :: 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 style :: AnsiStyle
style x :: 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
Nothing -> Doc -> Doc
forall a. a -> a
id
Just (intensity :: Intensity
intensity, color :: 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
Nothing -> Doc -> Doc
forall a. a -> a
id
Just (intensity :: Intensity
intensity, color :: 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
Nothing -> Doc -> Doc
forall a. a -> a
id
Just NewTerm.Bold -> Doc -> Doc
Old.bold
convertUnderlining :: Doc -> Doc
convertUnderlining = case AnsiStyle -> Maybe Underlined
NewTerm.ansiUnderlining AnsiStyle
style of
Nothing -> Doc -> Doc
forall a. a -> a
id
Just NewTerm.Underlined -> Doc -> Doc
Old.underline
convertColor
:: Bool
-> NewTerm.Intensity
-> NewTerm.Color
-> Old.Doc
-> Old.Doc
convertColor :: Bool -> Intensity -> Color -> Doc -> Doc
convertColor True NewTerm.Vivid NewTerm.Black = Doc -> Doc
Old.black
convertColor True NewTerm.Vivid NewTerm.Red = Doc -> Doc
Old.red
convertColor True NewTerm.Vivid NewTerm.Green = Doc -> Doc
Old.green
convertColor True NewTerm.Vivid NewTerm.Yellow = Doc -> Doc
Old.yellow
convertColor True NewTerm.Vivid NewTerm.Blue = Doc -> Doc
Old.blue
convertColor True NewTerm.Vivid NewTerm.Magenta = Doc -> Doc
Old.magenta
convertColor True NewTerm.Vivid NewTerm.Cyan = Doc -> Doc
Old.cyan
convertColor True NewTerm.Vivid NewTerm.White = Doc -> Doc
Old.white
convertColor True NewTerm.Dull NewTerm.Black = Doc -> Doc
Old.dullblack
convertColor True NewTerm.Dull NewTerm.Red = Doc -> Doc
Old.dullred
convertColor True NewTerm.Dull NewTerm.Green = Doc -> Doc
Old.dullgreen
convertColor True NewTerm.Dull NewTerm.Yellow = Doc -> Doc
Old.dullyellow
convertColor True NewTerm.Dull NewTerm.Blue = Doc -> Doc
Old.dullblue
convertColor True NewTerm.Dull NewTerm.Magenta = Doc -> Doc
Old.dullmagenta
convertColor True NewTerm.Dull NewTerm.Cyan = Doc -> Doc
Old.dullcyan
convertColor True NewTerm.Dull NewTerm.White = Doc -> Doc
Old.dullwhite
convertColor False NewTerm.Vivid NewTerm.Black = Doc -> Doc
Old.onblack
convertColor False NewTerm.Vivid NewTerm.Red = Doc -> Doc
Old.onred
convertColor False NewTerm.Vivid NewTerm.Green = Doc -> Doc
Old.ongreen
convertColor False NewTerm.Vivid NewTerm.Yellow = Doc -> Doc
Old.onyellow
convertColor False NewTerm.Vivid NewTerm.Blue = Doc -> Doc
Old.onblue
convertColor False NewTerm.Vivid NewTerm.Magenta = Doc -> Doc
Old.onmagenta
convertColor False NewTerm.Vivid NewTerm.Cyan = Doc -> Doc
Old.oncyan
convertColor False NewTerm.Vivid NewTerm.White = Doc -> Doc
Old.onwhite
convertColor False NewTerm.Dull NewTerm.Black = Doc -> Doc
Old.ondullblack
convertColor False NewTerm.Dull NewTerm.Red = Doc -> Doc
Old.ondullred
convertColor False NewTerm.Dull NewTerm.Green = Doc -> Doc
Old.ondullgreen
convertColor False NewTerm.Dull NewTerm.Yellow = Doc -> Doc
Old.ondullyellow
convertColor False NewTerm.Dull NewTerm.Blue = Doc -> Doc
Old.ondullblue
convertColor False NewTerm.Dull NewTerm.Magenta = Doc -> Doc
Old.ondullmagenta
convertColor False NewTerm.Dull NewTerm.Cyan = Doc -> Doc
Old.ondullcyan
convertColor False NewTerm.Dull NewTerm.White = Doc -> Doc
Old.ondullwhite
where
go :: Doc AnsiStyle -> Doc
go = Doc AnsiStyle -> Doc
toAnsiWlPprint