diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,23 @@ +Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. All +rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + + - Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + - Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +This software is provided by the copyright holders "as is" and any express or +implied warranties, including, but not limited to, the implied warranties of +merchantability and fitness for a particular purpose are disclaimed. In no event +shall the copyright holders be liable for any direct, indirect, incidental, +special, exemplary, or consequential damages (including, but not limited to, +procurement of substitute goods or services; loss of use, data, or profits; or +business interruption) however caused and on any theory of liability, whether in +contract, strict liability, or tort (including negligence or otherwise) arising +in any way out of the use of this software, even if advised of the possibility +of such damage. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,18 @@ +ansi-wl-pprint conversion package +================================= + +This package defines a converter from the old `ansi-wl-pprint` document type to +the new `prettyprinter` one. Its purpose is making packages that only generate +`ansi-wl-pprint` data available to the `prettyprinter` ecosystem. + +Note the difference to the `prettyprinter-compat-ansi-wl-pprint` module, which +does *not* convert any data, and instead provides an API that mimicks +`ansi-wl-pprint`, while secretly being `prettyprinter`-based behind the +curtains. This package on the other hand does a proper conversion. + +``` +╭────────────────────╮ fromAnsiWlPprint ╭────────────────────╮ +│ Doc ├───────────────────────▷│ Doc AnsiStyle │ +│ (ansi-wl-pprint) │◁───────────────────────┤ (prettyprinter) │ +╰────────────────────╯ toAnsiWlPprint ╰────────────────────╯ +``` diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/prettyprinter-convert-ansi-wl-pprint.cabal b/prettyprinter-convert-ansi-wl-pprint.cabal new file mode 100644 --- /dev/null +++ b/prettyprinter-convert-ansi-wl-pprint.cabal @@ -0,0 +1,50 @@ +name: prettyprinter-convert-ansi-wl-pprint +version: 1.1 +cabal-version: >= 1.10 +category: User Interfaces, Text +synopsis: Converter from »ansi-wl-pprint« documents to »prettyprinter«-based ones. +description: See README.md +license: BSD2 +license-file: LICENSE.md +extra-source-files: README.md +author: David Luposchainsky +maintainer: David Luposchainsky +bug-reports: http://github.com/quchen/prettyprinter/issues +homepage: http://github.com/quchen/prettyprinter +build-type: Simple +tested-with: GHC==7.8.4, GHC==7.10.2, GHC==7.10.3, GHC==8.0.1, GHC==8.0.2 + +source-repository head + type: git + location: git://github.com/quchen/prettyprinter.git + +library + exposed-modules: Data.Text.Prettyprint.Convert.AnsiWlPprint + ghc-options: -Wall + hs-source-dirs: src + default-language: Haskell2010 + other-extensions: + CPP + , LambdaCase + , OverloadedStrings + + build-depends: + base >= 4.7 && < 5 + , text >= 1.2 + , prettyprinter >= 1 + , prettyprinter-ansi-terminal >= 1.1.1 + , ansi-wl-pprint >= 0.6.8 + , ansi-terminal + +test-suite doctest + type: exitcode-stdio-1.0 + hs-source-dirs: test/Doctest + main-is: Main.hs + build-depends: + base >= 4.7 && < 5 + , doctest >= 0.9 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + if impl (ghc < 7.10) + buildable: False + -- Doctest does not support searching through directories in old versions diff --git a/src/Data/Text/Prettyprint/Convert/AnsiWlPprint.hs b/src/Data/Text/Prettyprint/Convert/AnsiWlPprint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Prettyprint/Convert/AnsiWlPprint.hs @@ -0,0 +1,170 @@ +{-# 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 diff --git a/test/Doctest/Main.hs b/test/Doctest/Main.hs new file mode 100644 --- /dev/null +++ b/test/Doctest/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Test.DocTest + +main :: IO () +main = doctest ["src"]