-- | Convert back and forth between the 'Old.Doc' type of the @ansi-wl-pprint@
-- and the 'New.Doc' of the prettyprinter package. Useful in order to use the
-- @prettyprinter@ library together with another library that produces
-- @ansi-wl-pprint@ output, and vice versa.
--
-- @
-- ╭────────────────────╮    'fromAnsiWlPprint'    ╭────────────────────╮
-- │        'Old.Doc'         ├───────────────────────▷│  'New.Doc' 'NewTerm.AnsiStyle'     │
-- │  (ansi-wl-pprint)  │◁───────────────────────┤  (prettyprinter)   │
-- ╰────────────────────╯     'toAnsiWlPprint'     ╰────────────────────╯
-- @
--
-- These conversion functions work well, but strictly speaking they are __not__
-- inverses of each other. @ansi-wl-pprint@ supports slightly less features than
-- @prettyprinter@ – the latter has italics, and allows reacting on the
-- configured ribbon width via 'New.withPageWidth'.
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



-- | @ansi-wl-pprint ───▷ prettyprinter@
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

-- | @prettyprinter ───▷ ansi-wl-pprint@
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)
                               -- Italics are unsupported by ansi-wl-pprint so we skip them
      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 -- True = foreground, False = background
            -> 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