-- | 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 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 -- | @ansi-wl-pprint ───▷ prettyprinter@ fromAnsiWlPprint :: Old.Doc -> New.Doc NewTerm.AnsiStyle fromAnsiWlPprint = \doc -> case doc of Old.Fail -> New.Fail Old.Empty -> New.Empty Old.Char c -> New.Char c Old.Text l t -> New.Text l (T.pack t) Old.Line -> New.Line Old.FlatAlt x y -> New.FlatAlt (go x) (go y) Old.Cat x y -> New.Cat (go x) (go y) Old.Nest i x -> New.Nest i (go x) Old.Union x y -> New.Union (go x) (go y) Old.Column f -> New.Column (go . f) Old.Columns f -> New.WithPageWidth (go . f . convert) where convert :: New.PageWidth -> Maybe Int convert (New.AvailablePerLine width _ribbon) = Just width convert New.Unbounded = Nothing Old.Nesting f -> New.Nesting (go . f) Old.Color layer intensity color x -> let convertLayerIntensity :: Ansi.ConsoleLayer -> Ansi.ColorIntensity -> NewTerm.Color -> NewTerm.AnsiStyle convertLayerIntensity Ansi.Foreground Ansi.Dull = NewTerm.colorDull convertLayerIntensity Ansi.Background Ansi.Dull = NewTerm.bgColorDull convertLayerIntensity Ansi.Foreground Ansi.Vivid = NewTerm.color convertLayerIntensity Ansi.Background Ansi.Vivid = NewTerm.bgColor convertColor :: Ansi.Color -> NewTerm.AnsiStyle convertColor c = convertLayerIntensity layer intensity (case c of Ansi.Black -> NewTerm.Black Ansi.Red -> NewTerm.Red Ansi.Green -> NewTerm.Green Ansi.Yellow -> NewTerm.Yellow Ansi.Blue -> NewTerm.Blue Ansi.Magenta -> NewTerm.Magenta Ansi.Cyan -> NewTerm.Cyan Ansi.White -> NewTerm.White ) in New.annotate (convertColor color) (go x) Old.Intensify intensity x -> case intensity of Ansi.BoldIntensity -> New.annotate NewTerm.bold (go x) Ansi.FaintIntensity -> go x Ansi.NormalIntensity -> go x Old.Italicize i x -> case i of False -> go x True -> New.annotate NewTerm.italicized (go x) Old.Underline _ x -> New.annotate NewTerm.underlined (go x) Old.RestoreFormat{} -> error "Malformed input: RestoreFormat mayb only be used during rendering. Please report this as a bug." where go = fromAnsiWlPprint -- | @prettyprinter ───▷ ansi-wl-pprint@ toAnsiWlPprint :: New.Doc NewTerm.AnsiStyle -> Old.Doc toAnsiWlPprint = \doc -> case doc of New.Fail -> Old.Fail New.Empty -> Old.Empty New.Char c -> Old.Char c New.Text l t -> Old.Text l (T.unpack t) New.Line -> Old.Line New.FlatAlt x y -> Old.FlatAlt (go x) (go y) New.Cat x y -> Old.Cat (go x) (go y) New.Nest i x -> Old.Nest i (go x) New.Union x y -> Old.Union (go x) (go y) New.Column f -> Old.Column (go . f) New.WithPageWidth f -> Old.Columns (go . f . convert) where convert :: Maybe Int -> New.PageWidth convert Nothing = New.Unbounded convert (Just width) = New.AvailablePerLine width 1.0 New.Nesting f -> Old.Nesting (go . f) New.Annotated style x -> (convertFg . convertBg . convertBold . convertUnderlining) (go x) -- Italics are unsupported by ansi-wl-pprint so we skip them where convertFg, convertBg, convertBold, convertUnderlining :: Old.Doc -> Old.Doc convertFg = case NewTerm.ansiForeground style of Nothing -> id Just (intensity, color) -> convertColor True intensity color convertBg = case NewTerm.ansiBackground style of Nothing -> id Just (intensity, color) -> convertColor False intensity color convertBold = case NewTerm.ansiBold style of Nothing -> id Just NewTerm.Bold -> Old.bold convertUnderlining = case NewTerm.ansiUnderlining style of Nothing -> id Just NewTerm.Underlined -> Old.underline convertColor :: Bool -- True = foreground, False = background -> NewTerm.Intensity -> NewTerm.Color -> Old.Doc -> Old.Doc convertColor True NewTerm.Vivid NewTerm.Black = Old.black convertColor True NewTerm.Vivid NewTerm.Red = Old.red convertColor True NewTerm.Vivid NewTerm.Green = Old.green convertColor True NewTerm.Vivid NewTerm.Yellow = Old.yellow convertColor True NewTerm.Vivid NewTerm.Blue = Old.blue convertColor True NewTerm.Vivid NewTerm.Magenta = Old.magenta convertColor True NewTerm.Vivid NewTerm.Cyan = Old.cyan convertColor True NewTerm.Vivid NewTerm.White = Old.white convertColor True NewTerm.Dull NewTerm.Black = Old.dullblack convertColor True NewTerm.Dull NewTerm.Red = Old.dullred convertColor True NewTerm.Dull NewTerm.Green = Old.dullgreen convertColor True NewTerm.Dull NewTerm.Yellow = Old.dullyellow convertColor True NewTerm.Dull NewTerm.Blue = Old.dullblue convertColor True NewTerm.Dull NewTerm.Magenta = Old.dullmagenta convertColor True NewTerm.Dull NewTerm.Cyan = Old.dullcyan convertColor True NewTerm.Dull NewTerm.White = Old.dullwhite convertColor False NewTerm.Vivid NewTerm.Black = Old.onblack convertColor False NewTerm.Vivid NewTerm.Red = Old.onred convertColor False NewTerm.Vivid NewTerm.Green = Old.ongreen convertColor False NewTerm.Vivid NewTerm.Yellow = Old.onyellow convertColor False NewTerm.Vivid NewTerm.Blue = Old.onblue convertColor False NewTerm.Vivid NewTerm.Magenta = Old.onmagenta convertColor False NewTerm.Vivid NewTerm.Cyan = Old.oncyan convertColor False NewTerm.Vivid NewTerm.White = Old.onwhite convertColor False NewTerm.Dull NewTerm.Black = Old.ondullblack convertColor False NewTerm.Dull NewTerm.Red = Old.ondullred convertColor False NewTerm.Dull NewTerm.Green = Old.ondullgreen convertColor False NewTerm.Dull NewTerm.Yellow = Old.ondullyellow convertColor False NewTerm.Dull NewTerm.Blue = Old.ondullblue convertColor False NewTerm.Dull NewTerm.Magenta = Old.ondullmagenta convertColor False NewTerm.Dull NewTerm.Cyan = Old.ondullcyan convertColor False NewTerm.Dull NewTerm.White = Old.ondullwhite where go = toAnsiWlPprint