prettyprinter-ansi-terminal-1.1.3/0000755000000000000000000000000007346545000015401 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/CHANGELOG.md0000644000000000000000000000352307346545000017215 0ustar0000000000000000# [1.1.3] - [Deprecate the `Data.Text.Prettyprint.*` modules](https://github.com/quchen/prettyprinter/pull/203) * Users should migrate to the new `Prettyprinter` module hierarchy. * The old modules will be removed no sooner than September 2022. [1.1.3]: https://github.com/quchen/prettyprinter/compare/ansi-terminal-v1.1.2...ansi-terminal-v1.1.3 # [1.1.2] - [Add shallower `Prettyprinter` module hierarchy exposing the same API.](https://github.com/quchen/prettyprinter/pull/174) * The current plan for the existing `Data.Text.Prettyprint.Doc*` modules is: * Start deprecation in early 2021. * Remove the modules after a deprecation period of at least one year. - [Make `renderLazy` lazy, and speed it up.](https://github.com/quchen/prettyprinter/pull/176) - [Add export list for Prettyprinter.Render.Terminal.Internal.](https://github.com/quchen/prettyprinter/pull/148) - [Optimize generating spaces for indentation.](https://github.com/quchen/prettyprinter/pull/132) - [Enable `-O2`.](https://github.com/quchen/prettyprinter/pull/144) - [Extend GHC support to 7.6 and 7.4.](https://github.com/quchen/prettyprinter/pull/74) [1.1.2]: https://github.com/quchen/prettyprinter/compare/ansi-terminal-v1.1.1.2...ansi-terminal-v1.1.2 # 1.1.1.2 - Fix documentation claiming there would be a trailing newline in `renderIO` when there is none # 1.1.1.1 - `renderIO` now renders directly to STDOUT, instead of first building a textual rendering and then printing that to STDOUT. # 1.1.1 - Expose `AnsiStyle`’s constructors for adaptability # 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 prettyprinter-ansi-terminal-1.1.3/LICENSE.md0000644000000000000000000000244307346545000017010 0ustar0000000000000000Copyright 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. prettyprinter-ansi-terminal-1.1.3/README.md0000644000000000000000000000061307346545000016660 0ustar0000000000000000ANSI terminal prettyprinter renderer ==================================== This package defines a renderer for documents generated by the `prettyprinter` package, suitable for displaying them on ANSI-compatible terminals, including colors, boldening, underlining and italication. For more information about the prettyprinter in general, refer to the main `prettyprinter` package documentation. prettyprinter-ansi-terminal-1.1.3/Setup.lhs0000644000000000000000000000011407346545000017205 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain prettyprinter-ansi-terminal-1.1.3/bench/0000755000000000000000000000000007346545000016460 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/bench/LargeOutput.hs0000644000000000000000000001347607346545000021302 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | This benchmark is derived from the large-output benchmark in prettyprinter, but contains additional annotations. module Main (main) where import Prelude () import Prelude.Compat import Control.DeepSeq import Control.Monad.Compat import Data.Char import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import Gauge import GHC.Generics import Prettyprinter import Prettyprinter.Render.Terminal as Terminal import qualified Prettyprinter.Render.Text as Text import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.Random newtype Program = Program Binds deriving (Show, Generic) newtype Binds = Binds (Map Text LambdaForm) deriving (Show, Generic) data LambdaForm = LambdaForm ![Text] ![Text] !Expr deriving (Show, Generic) data Expr = Let Binds Expr | Case Expr [Alt] | AppF Text [Text] | AppC Text [Text] | AppP Text Text Text | LitE Int deriving (Show, Generic) data Alt = Alt Text [Text] Expr deriving (Show, Generic) instance NFData Program instance NFData Binds instance NFData LambdaForm instance NFData Expr instance NFData Alt instance Arbitrary Program where arbitrary = fmap Program arbitrary instance Arbitrary Binds where arbitrary = do NonEmpty xs <- arbitrary pure (Binds (M.fromList xs)) instance Arbitrary LambdaForm where arbitrary = LambdaForm <$> fromTo 0 2 arbitrary <*> fromTo 0 2 arbitrary <*> arbitrary instance Arbitrary Expr where arbitrary = (oneof . map scaled) [ Let <$> arbitrary <*> arbitrary , Case <$> arbitrary <*> (do NonEmpty xs <- arbitrary; pure xs) , AppF <$> arbitrary <*> fromTo 0 3 arbitrary , AppC <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary , AppP <$> arbitrary <*> arbitrary <*> arbitrary , LitE <$> arbitrary ] instance Arbitrary Alt where arbitrary = Alt <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary <*> arbitrary instance Arbitrary Text where arbitrary = do n <- choose (3,6) str <- replicateM n (elements ['a'..'z']) if str `elem` ["let", "in", "case", "of"] then arbitrary else pure (T.pack str) ucFirst :: Gen Text -> Gen Text ucFirst gen = do x <- gen case T.uncons x of Nothing -> pure x Just (t,ext) -> pure (T.cons (toUpper t) ext) anCol :: Color -> Doc AnsiStyle -> Doc AnsiStyle anCol = annotate . color prettyProgram :: Program -> Doc AnsiStyle prettyProgram (Program binds) = annotate italicized $ prettyBinds binds prettyBinds :: Binds -> Doc AnsiStyle prettyBinds (Binds bs) = align (vsep (map prettyBinding (M.assocs bs))) where prettyBinding (var, lambda) = pretty var <+> anCol Red "=" <+> prettyLambdaForm lambda prettyLambdaForm :: LambdaForm -> Doc AnsiStyle prettyLambdaForm (LambdaForm free bound body) = prettyExp . (<+> anCol Blue "->") . prettyBound . prettyFree $ anCol Blue "\\" where prettyFree | null free = id | otherwise = (<> anCol Blue lparen <> hsep (map pretty free) <> anCol Blue rparen) prettyBound | null bound = id | null free = (<> hsep (map pretty bound)) | otherwise = (<+> hsep (map pretty bound)) prettyExp = (<+> prettyExpr body) prettyExpr :: Expr -> Doc AnsiStyle prettyExpr = \case Let binds body -> align (vsep [ anCol Red "let" <+> align (prettyBinds binds) , anCol Red "in" <+> prettyExpr body ]) Case scrutinee alts -> vsep [ anCol Yellow "case" <+> prettyExpr scrutinee <+> anCol Yellow "of" , indent 4 (align (vsep (map prettyAlt alts))) ] AppF f [] -> annotate bold . anCol Green $ pretty f AppF f args -> annotate bold . anCol Green $ pretty f <+> hsep (map pretty args) AppC c [] -> annotate bold . anCol Green $ pretty c AppC c args -> annotate bold . anCol Green $ pretty c <+> hsep (map pretty args) AppP op x y -> annotate bold . anCol Green $ pretty op <+> pretty x <+> pretty y LitE lit -> annotate bold . anCol Green $ pretty lit prettyAlt :: Alt -> Doc AnsiStyle prettyAlt (Alt con [] body) = pretty con <+> anCol Yellow "->" <+> prettyExpr body prettyAlt (Alt con args body) = pretty con <+> hsep (map pretty args) <+> anCol Yellow "->" <+> prettyExpr body scaled :: Gen a -> Gen a scaled = scale (\n -> n * 2 `quot` 3) fromTo :: Int -> Int -> Gen b -> Gen b fromTo a b gen = do n <- choose (min a b, max a b) resize n gen randomProgram :: Int -- ^ Seed -> Int -- ^ Generator size -> Program randomProgram seed size = let MkGen gen = arbitrary in gen (mkQCGen seed) size main :: IO () main = do let prog = randomProgram 1 60 layoutOpts = defaultLayoutOptions { layoutPageWidth = Unbounded } renderedProg = (renderLazy . layoutPretty layoutOpts . prettyProgram) prog (progLines, progWidth) = let l = TL.lines renderedProg in (length l, maximum (map TL.length l)) putDoc ("Program size:" <+> pretty progLines <+> "lines, maximum width:" <+> pretty progWidth) let render :: (SimpleDocStream AnsiStyle -> TL.Text) -> Program -> TL.Text render r = r . layoutPretty layoutOpts . prettyProgram rnf prog `seq` T.putStrLn "Starting benchmark…" defaultMain [ bench "prettyprinter-ansi-terminal" $ nf (render Terminal.renderLazy) prog , bench "prettyprinter" $ nf (render Text.renderLazy) prog ] prettyprinter-ansi-terminal-1.1.3/misc/0000755000000000000000000000000007346545000016334 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/misc/version-compatibility-macros.h0000644000000000000000000000150707346545000024326 0ustar0000000000000000#ifndef VERSION_COMPATIBILITY_MACROS #define VERSION_COMPATIBILITY_MACROS #ifndef MIN_VERSION_base #error "MIN_VERSION_base macro not defined!" #endif -- These macros allow writing CPP compatibility hacks in a way that makes their -- purpose much clearer than just demanding a specific version of a library. #define APPLICATIVE_MONAD MIN_VERSION_base(4,8,0) #define FOLDABLE_TRAVERSABLE_IN_PRELUDE MIN_VERSION_base(4,8,0) #define FUNCTOR_IDENTITY_IN_BASE MIN_VERSION_base(4,8,0) #define MONOID_IN_PRELUDE MIN_VERSION_base(4,8,0) #define NATURAL_IN_BASE MIN_VERSION_base(4,8,0) #define SEMIGROUP_IN_BASE MIN_VERSION_base(4,9,0) #define SEMIGROUP_MONOID_SUPERCLASS MIN_VERSION_base(4,11,0) #define FAIL_IN_MONAD !(MIN_VERSION_base(4,13,0)) #endif prettyprinter-ansi-terminal-1.1.3/prettyprinter-ansi-terminal.cabal0000644000000000000000000000501607346545000024063 0ustar0000000000000000name: prettyprinter-ansi-terminal version: 1.1.3 cabal-version: >= 1.10 category: User Interfaces, Text synopsis: ANSI terminal backend for the »prettyprinter« package. description: See README.md license: BSD2 license-file: LICENSE.md extra-source-files: README.md , misc/version-compatibility-macros.h , CHANGELOG.md author: David Luposchainsky maintainer: Simon Jakobi , David Luposchainsky bug-reports: http://github.com/quchen/prettyprinter/issues homepage: http://github.com/quchen/prettyprinter build-type: Simple tested-with: GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 source-repository head type: git location: git://github.com/quchen/prettyprinter.git library exposed-modules: Data.Text.Prettyprint.Doc.Render.Terminal , Data.Text.Prettyprint.Doc.Render.Terminal.Internal , Prettyprinter.Render.Terminal , Prettyprinter.Render.Terminal.Internal ghc-options: -Wall -O2 hs-source-dirs: src include-dirs: misc default-language: Haskell2010 other-extensions: CPP , OverloadedStrings build-depends: base >= 4.5 && < 5 , ansi-terminal >= 0.4.0 , text >= 1.2 , prettyprinter >= 1.7.0 if impl(ghc >= 8.0) ghc-options: -Wcompat if !impl(ghc >= 8.0) build-depends: semigroups >= 0.1 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 cannot search folders in old versions it seems :-( benchmark large-output build-depends: base >= 4.5 && < 5 , base-compat >=0.9.3 && <0.12 , containers , deepseq , gauge >= 0.2 , prettyprinter , prettyprinter-ansi-terminal , QuickCheck >= 2.7 , text hs-source-dirs: bench main-is: LargeOutput.hs ghc-options: -O2 -rtsopts -Wall default-language: Haskell2010 type: exitcode-stdio-1.0 prettyprinter-ansi-terminal-1.1.3/src/Data/Text/Prettyprint/Doc/Render/0000755000000000000000000000000007346545000024255 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/src/Data/Text/Prettyprint/Doc/Render/Terminal.hs0000644000000000000000000000031707346545000026365 0ustar0000000000000000module Data.Text.Prettyprint.Doc.Render.Terminal {-# DEPRECATED "Use \"Prettyprinter.Render.Terminal\" instead." #-} ( module Prettyprinter.Render.Terminal ) where import Prettyprinter.Render.Terminal prettyprinter-ansi-terminal-1.1.3/src/Data/Text/Prettyprint/Doc/Render/Terminal/0000755000000000000000000000000007346545000026030 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs0000644000000000000000000000036407346545000030143 0ustar0000000000000000module Data.Text.Prettyprint.Doc.Render.Terminal.Internal {-# DEPRECATED "Use \"Prettyprinter.Render.Terminal.Internal\" instead." #-} ( module Prettyprinter.Render.Terminal.Internal ) where import Prettyprinter.Render.Terminal.Internal prettyprinter-ansi-terminal-1.1.3/src/Prettyprinter/Render/0000755000000000000000000000000007346545000022302 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/src/Prettyprinter/Render/Terminal.hs0000644000000000000000000000140107346545000024405 0ustar0000000000000000-- | Render 'SimpleDocStream' in a terminal. module Prettyprinter.Render.Terminal ( -- * Styling AnsiStyle, Color(..), -- ** Font color color, colorDull, -- ** Background color bgColor, bgColorDull, -- ** Font style bold, italicized, underlined, -- ** Internal markers -- -- | These should only be used for writing adaptors to other libraries; for -- the average use case, use 'bold', 'bgColorDull', etc. Intensity(..), Bold(..), Underlined(..), Italicized(..), -- * Conversion to ANSI-infused 'Text' renderLazy, renderStrict, -- * Render directly to 'stdout' renderIO, -- ** Convenience functions putDoc, hPutDoc, ) where import Prettyprinter.Render.Terminal.Internal prettyprinter-ansi-terminal-1.1.3/src/Prettyprinter/Render/Terminal/0000755000000000000000000000000007346545000024055 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/src/Prettyprinter/Render/Terminal/Internal.hs0000644000000000000000000003007707346545000026174 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK not-home #-} #include "version-compatibility-macros.h" -- | __Warning:__ Internal module. May change arbitrarily between versions. module Prettyprinter.Render.Terminal.Internal ( -- * Styling AnsiStyle(..), Color(..), -- ** Font color color, colorDull, -- ** Background color bgColor, bgColorDull, -- ** Font style bold, italicized, underlined, -- ** Internal markers Intensity(..), Bold(..), Underlined(..), Italicized(..), -- * Conversion to ANSI-infused 'Text' renderLazy, renderStrict, -- * Render directly to 'stdout' renderIO, -- ** Convenience functions putDoc, hPutDoc, ) where import Control.Applicative import Data.IORef import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified System.Console.ANSI as ANSI import System.IO (Handle, hPutChar, stdout) import Prettyprinter import Prettyprinter.Render.Util.Panic #if !(SEMIGROUP_MONOID_SUPERCLASS) import Data.Semigroup #endif #if !(MIN_VERSION_base(4,6,0)) modifyIORef' :: IORef a -> (a -> a) -> IO () modifyIORef' ref f = do x <- readIORef ref let x' = f x x' `seq` writeIORef ref x' #endif -- $setup -- -- (Definitions for the doctests) -- -- >>> :set -XOverloadedStrings -- >>> import qualified Data.Text.Lazy.IO as TL -- >>> import qualified Data.Text.Lazy as TL -- >>> import Prettyprinter.Render.Terminal -- | The 8 ANSI terminal colors. data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Eq, Ord, Show) -- | Dull or vivid coloring, as supported by ANSI terminals. data Intensity = Vivid | Dull deriving (Eq, Ord, Show) -- | Foreground (text) or background (paper) color 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 -> AnsiStyle color c = mempty { ansiForeground = Just (Vivid, c) } -- | Style the background with a vivid color. bgColor :: Color -> AnsiStyle bgColor c = mempty { ansiBackground = Just (Vivid, c) } -- | Style the foreground with a dull color. colorDull :: Color -> AnsiStyle colorDull c = mempty { ansiForeground = Just (Dull, c) } -- | Style the background with a dull color. bgColorDull :: Color -> AnsiStyle bgColorDull c = mempty { ansiBackground = Just (Dull, c) } -- | Render in __bold__. bold :: AnsiStyle bold = mempty { ansiBold = Just Bold } -- | Render in /italics/. italicized :: AnsiStyle italicized = mempty { ansiItalics = Just Italicized } -- | 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. -- -- ANSI color information will be discarded by this function unless you are -- running on a Unix-like operating system. This is due to a technical -- limitation in Windows ANSI support. -- -- With a bit of trickery to make the ANSI codes printable, here is an example -- that would render colored in an ANSI terminal: -- -- >>> let render = TL.putStrLn . TL.replace "\ESC" "\\e" . renderLazy . layoutPretty defaultLayoutOptions -- >>> 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+u bold blue+u -- red -- >>> render doc -- \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 AnsiStyle -> TL.Text renderLazy = let push x = (x :) unsafePeek [] = panicPeekedEmpty unsafePeek (x:_) = x unsafePop [] = panicPoppedEmpty unsafePop (x:xs) = (x, xs) go :: [AnsiStyle] -> SimpleDocStream AnsiStyle -> TLB.Builder go s sds = case sds of SFail -> panicUncaughtFail SEmpty -> mempty SChar c rest -> TLB.singleton c <> go s rest SText _ t rest -> TLB.fromText t <> go s rest SLine i rest -> TLB.singleton '\n' <> TLB.fromText (T.replicate i " ") <> go s rest SAnnPush style rest -> let currentStyle = unsafePeek s newStyle = style <> currentStyle in TLB.fromText (styleToRawText newStyle) <> go (push style s) rest SAnnPop rest -> let (_currentStyle, s') = unsafePop s newStyle = unsafePeek s' in TLB.fromText (styleToRawText newStyle) <> go s' rest in TLB.toLazyText . go [mempty] -- | @('renderIO' h sdoc)@ writes @sdoc@ to the handle @h@. -- -- >>> let render = renderIO System.IO.stdout . layoutPretty defaultLayoutOptions -- >>> let doc = annotate (color Red) ("red" <+> align (vsep [annotate (color Blue <> underlined) ("blue+u" <+> annotate bold "bold" <+> "blue+u"), "red"])) -- -- We render the 'unAnnotate'd version here, since the ANSI codes don’t display -- well in Haddock, -- -- >>> render (unAnnotate doc) -- red blue+u bold blue+u -- red -- -- This function behaves just like -- -- @ -- 'renderIO' h sdoc = 'TL.hPutStr' h ('renderLazy' sdoc) -- @ -- -- but will not generate any intermediate text, rendering directly to the -- handle. renderIO :: Handle -> SimpleDocStream AnsiStyle -> IO () renderIO h sdoc = do styleStackRef <- newIORef [mempty] let push x = modifyIORef' styleStackRef (x :) unsafePeek = readIORef styleStackRef >>= \tok -> case tok of [] -> panicPeekedEmpty x:_ -> pure x unsafePop = readIORef styleStackRef >>= \tok -> case tok of [] -> panicPoppedEmpty x:xs -> writeIORef styleStackRef xs >> pure x let go = \sds -> case sds of SFail -> panicUncaughtFail SEmpty -> pure () SChar c rest -> do hPutChar h c go rest SText _ t rest -> do T.hPutStr h t go rest SLine i rest -> do hPutChar h '\n' T.hPutStr h (T.replicate i (T.singleton ' ')) go rest SAnnPush style rest -> do currentStyle <- unsafePeek let newStyle = style <> currentStyle push newStyle T.hPutStr h (styleToRawText newStyle) go rest SAnnPop rest -> do _currentStyle <- unsafePop newStyle <- unsafePeek T.hPutStr h (styleToRawText newStyle) go rest go sdoc readIORef styleStackRef >>= \stack -> case stack of [] -> panicStyleStackFullyConsumed [_] -> pure () xs -> panicStyleStackNotFullyConsumed (length xs) panicStyleStackFullyConsumed :: void panicStyleStackFullyConsumed = error ("There is no empty style left at the end of rendering" ++ " (but there should be). Please report this as a bug.") panicStyleStackNotFullyConsumed :: Int -> void panicStyleStackNotFullyConsumed len = error ("There are " <> show len <> " styles left at the" ++ "end of rendering (there should be only 1). Please report" ++ " this as a bug.") -- $ -- >>> let render = renderIO System.IO.stdout . layoutPretty defaultLayoutOptions -- >>> 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+u bold blue+u -- red -- -- This test won’t work since I don’t know how to type \ESC for doctest :-/ -- -- >>> render doc -- -- \ESC[0;91mred \ESC[0;94;4mblue+u \ESC[0;94;1;4mbold\ESC[0;94;4m blue+u\ESC[0;91m -- -- red\ESC[0m -- | Render the annotated document in a certain style. Styles not set in the -- annotation will use the style of the surrounding document, or the terminal’s -- default if none has been set yet. -- -- @ -- style = 'color' 'Green' '<>' 'bold' -- styledDoc = 'annotate' style "hello world" -- @ data AnsiStyle = SetAnsiStyle { ansiForeground :: Maybe (Intensity, Color) -- ^ Set the foreground color, or keep the old one. , ansiBackground :: Maybe (Intensity, Color) -- ^ Set the background color, or keep the old one. , ansiBold :: Maybe Bold -- ^ Switch on boldness, or don’t do anything. , ansiItalics :: Maybe Italicized -- ^ Switch on italics, or don’t do anything. , ansiUnderlining :: Maybe Underlined -- ^ Switch on underlining, or don’t do anything. } deriving (Eq, Ord, Show) -- | Keep the first decision for each of foreground color, background color, -- boldness, italication, and underlining. If a certain style is not set, the -- terminal’s default will be used. -- -- Example: -- -- @ -- 'color' 'Red' '<>' 'color' 'Green' -- @ -- -- is red because the first color wins, and not bold because (or if) that’s the -- terminal’s default. 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 } -- | 'mempty' does nothing, which is equivalent to inheriting the style of the -- surrounding doc, or the terminal’s default if no style has been set yet. instance Monoid AnsiStyle where mempty = SetAnsiStyle Nothing Nothing Nothing Nothing Nothing mappend = (<>) styleToRawText :: AnsiStyle -> Text styleToRawText = T.pack . 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 = \i -> case i of Vivid -> ANSI.Vivid Dull -> ANSI.Dull convertColor :: Color -> ANSI.Color convertColor = \c -> case c of Black -> ANSI.Black Red -> ANSI.Red Green -> ANSI.Green Yellow -> ANSI.Yellow Blue -> ANSI.Blue Magenta -> ANSI.Magenta Cyan -> ANSI.Cyan White -> ANSI.White -- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering and -- transforms it to strict text. renderStrict :: SimpleDocStream AnsiStyle -> Text renderStrict = TL.toStrict . renderLazy -- | @('putDoc' doc)@ prettyprints document @doc@ to standard output using -- 'defaultLayoutOptions'. -- -- >>> putDoc ("hello" <+> "world") -- hello world -- -- @ -- 'putDoc' = 'hPutDoc' 'stdout' -- @ 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 using 'defaultLayoutOptions'. -- -- > main = withFile "someFile.txt" (\h -> hPutDoc h (vcat ["vertical", "text"])) -- -- @ -- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc) -- @ hPutDoc :: Handle -> Doc AnsiStyle -> IO () hPutDoc h doc = renderIO h (layoutPretty defaultLayoutOptions doc) prettyprinter-ansi-terminal-1.1.3/test/Doctest/0000755000000000000000000000000007346545000017765 5ustar0000000000000000prettyprinter-ansi-terminal-1.1.3/test/Doctest/Main.hs0000644000000000000000000000014007346545000021200 0ustar0000000000000000module Main (main) where import Test.DocTest main :: IO () main = doctest [ "src" , "-Imisc"]