{-# LANGUAGE LambdaCase #-}

-- | 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 Data.Text.Prettyprint.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 = \case
    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 = \case
    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