prettyprinter-ansi-terminal 1.0.1 → 1.1

raw patch · 4 files changed

+113/−85 lines, 4 filesdep +semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• CONTRIBUTORS.md +0/−2
• prettyprinter-ansi-terminal.cabal +5/−2
• src/Data/Text/Prettyprint/Doc/Render/Terminal.hs +95/−81

@@ -0,0 +1,13 @@+# 1.1++- Overhauled the API significantly – Styles are now combined using the+  `Semigroup` instance from a number of readable primitives.++# 1.0.1++Fix version shenanigans, since the prerelease was released to Hackage as version+1 already, so uploading the »new« version 1 did not work++# 1++Initial release

@@ -7,8 +7,6 @@  ## `prettyprinter` library (this one) -- Moritz Kiefer, @cocreature-- Daniel Mendler, @minad – several ideas after the preliminary release - David Luposchainsky, @quchen – current maintainer  ## `ansi-wl-pprint` (origin forked from)

@@ -1,5 +1,5 @@ name:                prettyprinter-ansi-terminal-version:             1.0.1+version:             1.1 cabal-version:       >= 1.10 category:            User Interfaces, Text synopsis:            ANSI terminal backend for the »prettyprinter« package.@@ -9,6 +9,7 @@ extra-source-files:  README.md                    , misc/version-compatibility-macros.h                    , CONTRIBUTORS.md+                   , CHANGELOG.md author:              David Luposchainsky maintainer:          David Luposchainsky <dluposchainsky at google> bug-reports:         http://github.com/quchen/prettyprinter/issues@@ -36,10 +37,12 @@           base          >= 4.7 && < 5         , ansi-terminal >= 0.4.0 && < 0.7         , text          == 1.2.*-        , prettyprinter < 1.1+        , prettyprinter < 1.2      if impl(ghc >= 8.0)         ghc-options: -Wcompat+    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.1 && < 0.19  test-suite doctest     type: exitcode-stdio-1.0

@@ -7,16 +7,17 @@ -- | Render 'SimpleDocStream' in a terminal. module Data.Text.Prettyprint.Doc.Render.Terminal (     -- * Styling-    AnsiTerminal(..), Color(..), Intensity(..), Layer(..),+    AnsiStyle,+    Color(..), -    -- ** Font color convenience definitions+    -- ** Font color     color, colorDull,-    ---    -- ** Background color convenience definitions++    -- ** Background color     bgColor, bgColorDull, -    -- ** Font style convenience definitions-    bold, italics, underline,+    -- ** Font style+    bold, italicized, underlined,      -- * Conversion to ANSI-infused 'Text'     renderLazy, renderStrict,@@ -30,9 +31,9 @@   -import           Control.Monad-import           Data.Functor+import           Control.Applicative import           Data.Maybe+import           Data.Semigroup import           Data.Text              (Text) import qualified Data.Text              as T import qualified Data.Text.Lazy         as TL@@ -62,16 +63,7 @@   --- | A general ANSI style. Use e.g. 'color' or 'bold' to apply a style to a--- 'Doc'ument.-data AnsiTerminal =-      Italicized-    | Bold-    | Underlined-    | Color Layer Intensity Color-    deriving (Eq, Ord, Show)---- | 8 different colors, so that all can be displayed in an ANSI terminal.+-- | The 8 ANSI terminal colors. data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White     deriving (Eq, Ord, Show) @@ -83,35 +75,40 @@ data Layer = Foreground | Background     deriving (Eq, Ord, Show) +data Bold       = Bold       deriving (Eq, Ord, Show)+data Underlined = Underlined deriving (Eq, Ord, Show)+data Italicized = Italicized deriving (Eq, Ord, Show)+ -- | Style the foreground with a vivid color.-color :: Color -> Doc AnsiTerminal -> Doc AnsiTerminal-color c = annotate (Color Foreground Vivid c)+color :: Color -> AnsiStyle+color c = mempty { ansiForeground = Just (Vivid, c) }  -- | Style the background with a vivid color.-bgColor :: Color -> Doc AnsiTerminal -> Doc AnsiTerminal-bgColor c = annotate (Color Background Vivid c)+bgColor :: Color -> AnsiStyle+bgColor c =  mempty { ansiBackground = Just (Vivid, c) }  -- | Style the foreground with a dull color.-colorDull :: Color -> Doc AnsiTerminal -> Doc AnsiTerminal-colorDull c = annotate (Color Foreground Dull c)+colorDull :: Color -> AnsiStyle+colorDull c =  mempty { ansiForeground = Just (Dull, c) }  -- | Style the background with a dull color.-bgColorDull :: Color -> Doc AnsiTerminal -> Doc AnsiTerminal-bgColorDull c = annotate (Color Background Dull c)+bgColorDull :: Color -> AnsiStyle+bgColorDull c =  mempty { ansiBackground = Just (Dull, c) } --- | Render the enclosed document in __bold__.-bold :: Doc AnsiTerminal -> Doc AnsiTerminal-bold = annotate Bold+-- | Render in __bold__.+bold :: AnsiStyle+bold = mempty { ansiBold = Just Bold } --- | Render the enclosed document in /italics/.-italics :: Doc AnsiTerminal -> Doc AnsiTerminal-italics = annotate Italicized+-- | Render in /italics/.+italicized :: AnsiStyle+italicized = mempty { ansiItalics = Just Italicized } --- | Render the enclosed document underlined.-underline :: Doc AnsiTerminal -> Doc AnsiTerminal-underline = annotate Underlined+-- | Render underlined.+underlined :: AnsiStyle+underlined = mempty { ansiUnderlining = Just Underlined }  + -- | @('renderLazy' doc)@ takes the output @doc@ from a rendering function -- and transforms it to lazy text, including ANSI styling directives for things -- like colorization.@@ -124,18 +121,18 @@ -- that would render colored in an ANSI terminal: -- -- >>> let render = TL.putStrLn . TL.replace "\ESC" "\\e" . renderLazy . layoutPretty defaultLayoutOptions--- >>> let doc = color Red ("red" <+> align (vsep [color Blue ("blue" <+> bold "bold" <+> "blue"), "red"]))+-- >>> let doc = annotate (color Red) ("red" <+> align (vsep [annotate (color Blue <> underlined) ("blue+u" <+> annotate bold "bold" <+> "blue+u"), "red"])) -- >>> render (unAnnotate doc)--- red blue bold blue+-- red blue+u bold blue+u --     red -- >>> render doc--- \e[0;91mred \e[0;94mblue \e[0;94;1mbold\e[0;94m blue\e[0;91m+-- \e[0;91mred \e[0;94;4mblue+u \e[0;94;1;4mbold\e[0;94;4m blue+u\e[0;91m --     red\e[0m -- -- Run the above via @echo -e '...'@ in your terminal to see the coloring.-renderLazy :: SimpleDocStream AnsiTerminal -> TL.Text+renderLazy :: SimpleDocStream AnsiStyle -> TL.Text renderLazy doc-  = let (resultBuilder, remainingStyles) = execStackMachine [emptyStyle] (build doc)+  = let (resultBuilder, remainingStyles) = execStackMachine [mempty] (build doc)     in case remainingStyles of         [] -> error ("There is no empty style left at the end of rendering" ++                      " (but there should be). Please report this as a bug.")@@ -144,7 +141,7 @@                      "end of rendering (there should be only 1). Please report" ++                      " this as a bug.") -build :: SimpleDocStream AnsiTerminal -> StackMachine TLB.Builder CombinedStyle ()+build :: SimpleDocStream AnsiStyle -> StackMachine TLB.Builder AnsiStyle () build = \case     SFail -> panicUncaughtFail     SEmpty -> pure ()@@ -160,47 +157,67 @@         build x     SAnnPush s x -> do         currentStyle <- unsafePeekStyle-        let newStyle = currentStyle `addStyle` s-        writeOutput (styleToBuilder newStyle)+        let newStyle = s <> currentStyle+        writeOutput (styleToRaw newStyle)         pushStyle newStyle         build x     SAnnPop x -> do         _currentStyle <- unsafePopStyle         newStyle <- unsafePeekStyle-        writeOutput (styleToBuilder newStyle)+        writeOutput (styleToRaw newStyle)         build x -styleToBuilder :: CombinedStyle -> TLB.Builder-styleToBuilder = TLB.fromString . ANSI.setSGRCode . stylesToSgrs--data CombinedStyle = CombinedStyle-    (Maybe (Intensity, Color)) -- Foreground-    (Maybe (Intensity, Color)) -- Background-    Bool                       -- Bold-    Bool                       -- Italics-    Bool                       -- Underlining+-- | Begin rendering in a certain style. Instead of using this type directly,+-- use the 'Semigroup' instance to create new styles out of the smart+-- constructors, such as+--+-- @+-- style = 'color' 'Green' '<>' 'bold'+-- styledDoc = 'annotate' style "hello world"+-- @+data AnsiStyle = SetAnsiStyle+    { ansiForeground  :: Maybe (Intensity, Color)+    , ansiBackground  :: Maybe (Intensity, Color)+    , ansiBold        :: Maybe Bold+    , ansiItalics     :: Maybe Italicized+    , ansiUnderlining :: Maybe Underlined }+    deriving (Eq, Ord, Show) -addStyle :: CombinedStyle -> AnsiTerminal -> CombinedStyle-addStyle (CombinedStyle m'fg m'bg b i u) = \case-    Italicized              -> CombinedStyle m'fg m'bg b True u-    Bold                    -> CombinedStyle m'fg m'bg True i u-    Underlined              -> CombinedStyle m'fg m'bg b i True-    Color Foreground dv col -> CombinedStyle (Just (dv, col)) m'bg b i u-    Color Background dv col -> CombinedStyle m'fg (Just (dv, col)) b i u+-- | Keep the first decision for each of foreground color, background color,+-- boldness, italication, and underlining.+--+-- Example:+--+-- @+-- 'color' 'Red' '<>' 'color' 'Green'+-- @+--+-- is red.+instance Semigroup AnsiStyle where+    cs1 <> cs2 = SetAnsiStyle+        { ansiForeground  = ansiForeground  cs1 <|> ansiForeground  cs2+        , ansiBackground  = ansiBackground  cs1 <|> ansiBackground  cs2+        , ansiBold        = ansiBold        cs1 <|> ansiBold        cs2+        , ansiItalics     = ansiItalics     cs1 <|> ansiItalics     cs2+        , ansiUnderlining = ansiUnderlining cs1 <|> ansiUnderlining cs2 } -emptyStyle :: CombinedStyle-emptyStyle = CombinedStyle Nothing Nothing False False False+instance Monoid AnsiStyle where+    mempty = SetAnsiStyle Nothing Nothing Nothing Nothing Nothing+    mappend = (<>) -stylesToSgrs :: CombinedStyle -> [ANSI.SGR]-stylesToSgrs (CombinedStyle m'fg m'bg b i u) = catMaybes-    [ Just ANSI.Reset-    , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Foreground (convertIntensity intensity) (convertColor c)) m'fg-    , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Background (convertIntensity intensity) (convertColor c)) m'bg-    , guard b $> ANSI.SetConsoleIntensity ANSI.BoldIntensity-    , guard i $> ANSI.SetItalicized True-    , guard u $> ANSI.SetUnderlining ANSI.SingleUnderline-    ]+styleToRaw :: AnsiStyle -> TLB.Builder+styleToRaw = TLB.fromString . ANSI.setSGRCode . stylesToSgrs   where+    stylesToSgrs :: AnsiStyle -> [ANSI.SGR]+    stylesToSgrs (SetAnsiStyle fg bg b i u) = catMaybes+        [ Just ANSI.Reset+        , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Foreground (convertIntensity intensity) (convertColor c)) fg+        , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Background (convertIntensity intensity) (convertColor c)) bg+        , fmap (\_              -> ANSI.SetConsoleIntensity ANSI.BoldIntensity) b+        , fmap (\_              -> ANSI.SetItalicized True) i+        , fmap (\_              -> ANSI.SetUnderlining ANSI.SingleUnderline) u+        ]+     convertIntensity :: Intensity -> ANSI.ColorIntensity     convertIntensity = \case         Vivid -> ANSI.Vivid@@ -221,21 +238,19 @@  -- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering and -- transforms it to strict text.-renderStrict :: SimpleDocStream AnsiTerminal -> Text+renderStrict :: SimpleDocStream AnsiStyle -> Text renderStrict = TL.toStrict . renderLazy -- -- | @('renderIO' h sdoc)@ writes @sdoc@ to the file @h@. -- -- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld") -- hello -- world-renderIO :: Handle -> SimpleDocStream AnsiTerminal -> IO ()+renderIO :: Handle -> SimpleDocStream AnsiStyle -> IO () renderIO h sdoc = TL.hPutStrLn h (renderLazy sdoc) --- | @('putDoc' doc)@ prettyprints document @doc@ to standard output, with a page--- width of 80 characters and a ribbon width of 32 characters.+-- | @('putDoc' doc)@ prettyprints document @doc@ to standard output using+-- 'defaultLayoutOptions'. -- -- >>> putDoc ("hello" <+> "world") -- hello world@@ -243,17 +258,16 @@ -- @ -- 'putDoc' = 'hPutDoc' 'stdout' -- @-putDoc :: Doc AnsiTerminal -> IO ()+putDoc :: Doc AnsiStyle -> IO () putDoc = hPutDoc stdout  -- | Like 'putDoc', but instead of using 'stdout', print to a user-provided--- handle, e.g. a file or a socket. Uses a line length of 80, and a ribbon width--- of 32 characters.+-- handle, e.g. a file or a socket using 'defaultLayoutOptions'. -- -- > main = withFile "someFile.txt" (\h -> hPutDoc h (vcat ["vertical", "text"])) -- -- @ -- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc) -- @-hPutDoc :: Handle -> Doc AnsiTerminal -> IO ()+hPutDoc :: Handle -> Doc AnsiStyle -> IO () hPutDoc h doc = renderIO h (layoutPretty defaultLayoutOptions doc)