pretty-simple 1.1.0.3 → 2.0.0.0

raw patch · 5 files changed

+504/−149 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pretty-simple.cabal +2/−1
• src/Text/Pretty/Simple.hs +95/−33
• src/Text/Pretty/Simple/Internal.hs +1/−0
• src/Text/Pretty/Simple/Internal/Color.hs +307/−0
• src/Text/Pretty/Simple/Internal/OutputPrinter.hs +99/−115

@@ -1,5 +1,5 @@ name:                pretty-simple-version:             1.1.0.3+version:             2.0.0.0 synopsis:            pretty printer for data types with a 'Show' instance. description:         Please see <https://github.com/cdepillabout/pretty-simple#readme README.md>. homepage:            https://github.com/cdepillabout/pretty-simple@@ -22,6 +22,7 @@   hs-source-dirs:      src   exposed-modules:     Text.Pretty.Simple                      , Text.Pretty.Simple.Internal+                     , Text.Pretty.Simple.Internal.Color                      , Text.Pretty.Simple.Internal.Expr                      , Text.Pretty.Simple.Internal.ExprParser                      , Text.Pretty.Simple.Internal.ExprToOutput

@@ -20,30 +20,52 @@ 'pPrint' is the main go-to function when debugging Haskell code.  'pShow' and 'pString' are slight variations on 'pPrint'. -The other variations of 'pPrint', 'pShow', and 'pString' are for printing-without color and changing the indentation amount.  Most users can ignore these.+'pPrint', 'pShow', and 'pString' will pretty-print in color using ANSI escape+codes.  They look good on a console with a dark (black) background. The+variations 'pPrintLightBg', 'pShowLightBg', and 'pStringLightBg' are for+printing in color to a console with a light (white) background.  The variations+'pPrintNoColor', 'pShowNoColor', and 'pStringNoColor' are for pretty-printing+without using color. +The variations 'pPrintOpt', 'pShowOpt', and 'pStringOpt' are used when+specifying the 'OutputOptions'.  Most users can ignore these.+ See the Examples section at the end of this module for examples of acutally-using 'pPrint'.+using 'pPrint'.  See the+<https://github.com/cdepillabout/pretty-simple#textprettysimple README.md>+for examples of printing in color. -} module Text.Pretty.Simple   (-  -- * Output With Color-    pShow-  , pPrint+  -- * Output with color on dark background+    pPrint+  , pShow   , pString-  -- * Output With NO Color-  , pShowNoColor+  -- * Aliases for output with color on dark background+  , pPrintDarkBg+  , pShowDarkBg+  , pStringDarkBg+  -- * Output with color on light background+  , pPrintLightBg+  , pShowLightBg+  , pStringLightBg+  -- * Output with NO color   , pPrintNoColor+  , pShowNoColor   , pStringNoColor-  -- * Output With Output Options-  , pShowOpt+  -- * Output With 'OutputOptions'   , pPrintOpt+  , pShowOpt   , pStringOpt+  -- * 'OutputOptions'   , OutputOptions(..)-  , UseColor(..)-  , defaultOutputOptions-  , noColorOutputOptions+  , defaultOutputOptionsDarkBg+  , defaultOutputOptionsLightBg+  , defaultOutputOptionsNoColor+  -- * 'ColorOptions'+  -- $colorOptions+  , defaultColorOptionsDarkBg+  , defaultColorOptionsLightBg   -- * Examples   -- $examples   ) where@@ -60,12 +82,14 @@ import Data.Text.Lazy.IO as LText  import Text.Pretty.Simple.Internal-       (OutputOptions(..), UseColor(..), defaultOutputOptions,+       (OutputOptions(..), defaultColorOptionsDarkBg,+        defaultColorOptionsLightBg, defaultOutputOptionsDarkBg,+        defaultOutputOptionsLightBg, defaultOutputOptionsNoColor,         expressionParse, expressionsToOutputs, render) ---------------------------------- normal (color) functions ---------------------------------+----------------------------------------------------------+-- functions for printing in color to a dark background --+----------------------------------------------------------  -- | Pretty-print any data type that has a 'Show' instance. --@@ -75,13 +99,17 @@ -- @ --  pPrint :: Show a => a -> IO () -- @+--+-- This function is for printing to a dark background. pPrint :: (MonadIO m, Show a) => a -> m ()-pPrint = pPrintOpt defaultOutputOptions+pPrint = pPrintOpt defaultOutputOptionsDarkBg  -- | Similar to 'pPrint', but just return the resulting pretty-printed data -- type as a 'Text' instead of printing it to the screen.+--+-- This function is for printing to a dark background. pShow :: Show a => a -> Text-pShow = pShowOpt defaultOutputOptions+pShow = pShowOpt defaultOutputOptionsDarkBg  -- | Similar to 'pShow', but the first argument is a 'String' representing a -- data type that has already been 'show'ed.@@ -90,13 +118,47 @@ -- only requirement is that the strings are quoted, and braces, parentheses, and -- brackets are correctly used to represent indentation.  For example, -- 'pString' will correctly pretty-print JSON.+--+-- This function is for printing to a dark background. pString :: String -> Text-pString = pStringOpt defaultOutputOptions+pString = pStringOpt defaultOutputOptionsDarkBg ---------------------------- no-color functions ---------------------------+--------------------------------------------------------+-- aliases for printing in color to a dark background --+-------------------------------------------------------- +-- | Alias for 'pPrint'.+pPrintDarkBg :: (MonadIO m, Show a) => a -> m ()+pPrintDarkBg = pPrint++-- | Alias for 'pShow'.+pShowDarkBg :: Show a => a -> Text+pShowDarkBg = pShow++-- | Alias for 'pString'.+pStringDarkBg :: String -> Text+pStringDarkBg = pString++-----------------------------------------------------------+-- functions for printing in color to a light background --+-----------------------------------------------------------++-- | Just like 'pPrintDarkBg', but for printing to a light background.+pPrintLightBg :: (MonadIO m, Show a) => a -> m ()+pPrintLightBg = pPrintOpt defaultOutputOptionsLightBg++-- | Just like 'pShowDarkBg', but for printing to a light background.+pShowLightBg :: Show a => a -> Text+pShowLightBg = pShowOpt defaultOutputOptionsLightBg++-- | Just like 'pStringDarkBg', but for printing to a light background.+pStringLightBg :: String -> Text+pStringLightBg = pStringOpt defaultOutputOptionsLightBg++------------------------------------------+-- functions for printing without color --+------------------------------------------+ -- | Similar to 'pPrint', but doesn't print in color.  However, data types -- will still be indented nicely. --@@ -106,20 +168,15 @@ --     , "bye" --     ] pPrintNoColor :: (MonadIO m, Show a) => a -> m ()-pPrintNoColor = pPrintOpt noColorOutputOptions+pPrintNoColor = pPrintOpt defaultOutputOptionsNoColor  -- | Like 'pShow', but without color. pShowNoColor :: Show a => a -> Text-pShowNoColor = pShowOpt noColorOutputOptions+pShowNoColor = pShowOpt defaultOutputOptionsNoColor  -- | LIke 'pString', but without color. pStringNoColor :: String -> Text-pStringNoColor = pStringOpt noColorOutputOptions---- | 'noColorOutputOptions' is just like 'defaultOutputOptions', but--- 'outputOptionsUseColor' is set to 'NoColor'.-noColorOutputOptions :: OutputOptions-noColorOutputOptions = defaultOutputOptions {outputOptionsUseColor = NoColor}+pStringNoColor = pStringOpt defaultOutputOptionsNoColor  --------------------------------- -- functions that take options --@@ -133,7 +190,7 @@ -- -- This is what the normal indentation looks like: ----- >>> pPrintOpt noColorOutputOptions $ Just ("hello", "bye")+-- >>> pPrintOpt defaultOutputOptionsNoColor $ Just ("hello", "bye") -- Just --     ( "hello" --     , "bye"@@ -141,7 +198,7 @@ -- -- This is what smaller indentation looks like: ----- >>> let smallIndent = noColorOutputOptions {outputOptionsIndentAmount = 1}+-- >>> let smallIndent = defaultOutputOptionsNoColor {outputOptionsIndentAmount = 1} -- >>> pPrintOpt smallIndent $ Just ("hello", "bye") -- Just --  ( "hello"@@ -163,6 +220,11 @@     Left _ -> pack string     Right expressions ->       render outputOptions . toList $ expressionsToOutputs expressions++-- $colorOptions+--+-- Additional settings for color options can be found in+-- 'Text.Pretty.Simple.Internal.Color'.  -- $examples --

@@ -11,6 +11,7 @@   ( module X   ) where +import Text.Pretty.Simple.Internal.Color as X import Text.Pretty.Simple.Internal.ExprParser as X import Text.Pretty.Simple.Internal.Expr as X import Text.Pretty.Simple.Internal.ExprToOutput as X

@@ -0,0 +1,307 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++{-|+Module      : Text.Pretty.Simple.Internal.OutputPrinter+Copyright   : (c) Dennis Gosnell, 2016+License     : BSD-style (see LICENSE file)+Maintainer  : cdep.illabout@gmail.com+Stability   : experimental+Portability : POSIX++-}+module Text.Pretty.Simple.Internal.Color+  where++#if __GLASGOW_HASKELL__ < 710+-- We don't need this import for GHC 7.10 as it exports all required functions+-- from Prelude+import Control.Applicative+#endif++import Data.Text.Lazy.Builder (Builder, fromString)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import System.Console.ANSI+       (Color(..), ColorIntensity(..), ConsoleIntensity(..),+        ConsoleLayer(..), SGR(..), setSGRCode)++-- | These options are for colorizing the output of functions like 'pPrint'.+--+-- For example, if you set 'colorQuote' to something like 'colorVividBlueBold',+-- then the quote character (@\"@) will be output as bright blue in bold.+--+-- If you don't want to use a color for one of the options, use 'colorNull'.+data ColorOptions = ColorOptions+  { colorQuote :: Builder+  -- ^ Color to use for quote characters (@\"@) around strings.+  , colorString :: Builder+  -- ^ Color to use for strings.+  , colorError :: Builder+  -- ^ (currently not used)+  , colorNum :: Builder+  -- ^ (currently not used)+  , colorRainbowParens :: [Builder]+  -- ^ A list of 'Builder' colors to use for rainbow parenthesis output.  Use+  -- '[]' if you don't want rainbow parenthesis.  Use just a single item if you+  -- want all the rainbow parenthesis to be colored the same.+  } deriving (Eq, Generic, Show, Typeable)++------------------------------------+-- Dark background default colors --+------------------------------------++-- | Default color options for use on a dark background.+--+-- 'colorQuote' is 'defaultColorQuoteDarkBg'. 'colorString' is+-- 'defaultColorStringDarkBg'.  'colorError' is 'defaultColorErrorDarkBg'.+-- 'colorNum' is 'defaultColorNumDarkBg'.  'colorRainbowParens' is+-- 'defaultColorRainboxParensDarkBg'.+defaultColorOptionsDarkBg :: ColorOptions+defaultColorOptionsDarkBg =+  ColorOptions+  { colorQuote = defaultColorQuoteDarkBg+  , colorString = defaultColorStringDarkBg+  , colorError = defaultColorErrorDarkBg+  , colorNum = defaultColorNumDarkBg+  , colorRainbowParens = defaultColorRainbowParensDarkBg+  }++-- | Default color for 'colorQuote' for dark backgrounds. This is+-- 'colorVividWhiteBold'.+defaultColorQuoteDarkBg :: Builder+defaultColorQuoteDarkBg = colorVividWhiteBold++-- | Default color for 'colorString' for dark backgrounds. This is+-- 'colorVividBlueBold'.+defaultColorStringDarkBg :: Builder+defaultColorStringDarkBg = colorVividBlueBold++-- | Default color for 'colorError' for dark backgrounds.  This is+-- 'colorVividRedBold'.+defaultColorErrorDarkBg :: Builder+defaultColorErrorDarkBg = colorVividRedBold++-- | Default color for 'colorNum' for dark backgrounds.  This is+-- 'colorVividGreenBold'.+defaultColorNumDarkBg :: Builder+defaultColorNumDarkBg = colorVividGreenBold++-- | Default colors for 'colorRainbowParens' for dark backgrounds.+defaultColorRainbowParensDarkBg :: [Builder]+defaultColorRainbowParensDarkBg =+  [ colorVividMagentaBold+  , colorVividCyanBold+  , colorVividYellowBold+  , colorDullMagenta+  , colorDullCyan+  , colorDullYellow+  , colorDullMagentaBold+  , colorDullCyanBold+  , colorDullYellowBold+  , colorVividMagenta+  , colorVividCyan+  , colorVividYellow+  ]++-------------------------------------+-- Light background default colors --+-------------------------------------++-- | Default color options for use on a light background.+--+-- 'colorQuote' is 'defaultColorQuoteLightBg'. 'colorString' is+-- 'defaultColorStringLightBg'.  'colorError' is 'defaultColorErrorLightBg'.+-- 'colorNum' is 'defaultColorNumLightBg'.  'colorRainbowParens' is+-- 'defaultColorRainboxParensLightBg'.+defaultColorOptionsLightBg :: ColorOptions+defaultColorOptionsLightBg =+  ColorOptions+  { colorQuote = defaultColorQuoteLightBg+  , colorString = defaultColorStringLightBg+  , colorError = defaultColorErrorLightBg+  , colorNum = defaultColorNumLightBg+  , colorRainbowParens = defaultColorRainbowParensLightBg+  }++-- | Default color for 'colorQuote' for light backgrounds. This is+-- 'colorVividWhiteBold'.+defaultColorQuoteLightBg :: Builder+defaultColorQuoteLightBg = colorVividBlackBold++-- | Default color for 'colorString' for light backgrounds. This is+-- 'colorVividBlueBold'.+defaultColorStringLightBg :: Builder+defaultColorStringLightBg = colorVividBlueBold++-- | Default color for 'colorError' for light backgrounds.  This is+-- 'colorVividRedBold'.+defaultColorErrorLightBg :: Builder+defaultColorErrorLightBg = colorVividRedBold++-- | Default color for 'colorNum' for light backgrounds.  This is+-- 'colorVividGreenBold'.+defaultColorNumLightBg :: Builder+defaultColorNumLightBg = colorVividGreenBold++-- | Default colors for 'colorRainbowParens' for light backgrounds.+defaultColorRainbowParensLightBg :: [Builder]+defaultColorRainbowParensLightBg =+  [ colorVividMagentaBold+  , colorVividCyanBold+  , colorDullMagenta+  , colorDullCyan+  , colorDullMagentaBold+  , colorDullCyanBold+  , colorVividMagenta+  , colorVividCyan+  ]++-----------------------+-- Vivid Bold Colors --+-----------------------++colorVividBlackBold :: Builder+colorVividBlackBold = colorBold `mappend` colorVividBlack++colorVividBlueBold :: Builder+colorVividBlueBold = colorBold `mappend` colorVividBlue++colorVividCyanBold :: Builder+colorVividCyanBold = colorBold `mappend` colorVividCyan++colorVividGreenBold :: Builder+colorVividGreenBold = colorBold `mappend` colorVividGreen++colorVividMagentaBold :: Builder+colorVividMagentaBold = colorBold `mappend` colorVividMagenta++colorVividRedBold :: Builder+colorVividRedBold = colorBold `mappend` colorVividRed++colorVividWhiteBold :: Builder+colorVividWhiteBold = colorBold `mappend` colorVividWhite++colorVividYellowBold :: Builder+colorVividYellowBold = colorBold `mappend` colorVividYellow++-----------------------+-- Dull Bold Colors --+-----------------------++colorDullBlackBold :: Builder+colorDullBlackBold = colorBold `mappend` colorDullBlack++colorDullBlueBold :: Builder+colorDullBlueBold = colorBold `mappend` colorDullBlue++colorDullCyanBold :: Builder+colorDullCyanBold = colorBold `mappend` colorDullCyan++colorDullGreenBold :: Builder+colorDullGreenBold = colorBold `mappend` colorDullGreen++colorDullMagentaBold :: Builder+colorDullMagentaBold = colorBold `mappend` colorDullMagenta++colorDullRedBold :: Builder+colorDullRedBold = colorBold `mappend` colorDullRed++colorDullWhiteBold :: Builder+colorDullWhiteBold = colorBold `mappend` colorDullWhite++colorDullYellowBold :: Builder+colorDullYellowBold = colorBold `mappend` colorDullYellow++------------------+-- Vivid Colors --+------------------++colorVividBlack :: Builder+colorVividBlack = colorHelper Vivid Black++colorVividBlue :: Builder+colorVividBlue = colorHelper Vivid Blue++colorVividCyan :: Builder+colorVividCyan = colorHelper Vivid Cyan++colorVividGreen :: Builder+colorVividGreen = colorHelper Vivid Green++colorVividMagenta :: Builder+colorVividMagenta = colorHelper Vivid Magenta++colorVividRed :: Builder+colorVividRed = colorHelper Vivid Red++colorVividWhite :: Builder+colorVividWhite = colorHelper Vivid White++colorVividYellow :: Builder+colorVividYellow = colorHelper Vivid Yellow++------------------+-- Dull Colors --+------------------++colorDullBlack :: Builder+colorDullBlack = colorHelper Dull Black++colorDullBlue :: Builder+colorDullBlue = colorHelper Dull Blue++colorDullCyan :: Builder+colorDullCyan = colorHelper Dull Cyan++colorDullGreen :: Builder+colorDullGreen = colorHelper Dull Green++colorDullMagenta :: Builder+colorDullMagenta = colorHelper Dull Magenta++colorDullRed :: Builder+colorDullRed = colorHelper Dull Red++colorDullWhite :: Builder+colorDullWhite = colorHelper Dull White++colorDullYellow :: Builder+colorDullYellow = colorHelper Dull Yellow++--------------------+-- Special Colors --+--------------------++-- | Change the intensity to 'BoldIntensity'.+colorBold :: Builder+colorBold = setSGRCodeBuilder [SetConsoleIntensity BoldIntensity]++-- | 'Reset' the console color back to normal.+colorReset :: Builder+colorReset = setSGRCodeBuilder [Reset]++-- | Empty string.+colorNull :: Builder+colorNull = ""++-------------+-- Helpers --+-------------++-- | Helper for creating a 'Builder' for an ANSI escape sequence color based on+-- a 'ColorIntensity' and a 'Color'.+colorHelper :: ColorIntensity -> Color -> Builder+colorHelper colorIntensity color =+  setSGRCodeBuilder [SetColor Foreground colorIntensity color]++-- | Convert a list of 'SGR' to a 'Builder'.+setSGRCodeBuilder :: [SGR] -> Builder+setSGRCodeBuilder = fromString . setSGRCode+

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -26,46 +27,64 @@ #endif  import Control.Monad.Reader (MonadReader(reader), runReader)-import Data.Data (Data) import Data.Foldable (fold, foldlM) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import Data.Typeable (Typeable) import GHC.Generics (Generic)-import System.Console.ANSI-       (Color(..), ColorIntensity(..), ConsoleIntensity(..),-        ConsoleLayer(..), SGR(..), setSGRCode) +import Text.Pretty.Simple.Internal.Color+       (ColorOptions(..), colorReset, defaultColorOptionsDarkBg,+        defaultColorOptionsLightBg) import Text.Pretty.Simple.Internal.Output        (NestLevel(..), Output(..), OutputType(..)) --- | 'UseColor' describes whether or not we want to use color when printing the--- 'Output' list.-data UseColor-  = NoColor-  | UseColor-  deriving (Data, Eq, Generic, Read, Show, Typeable)- -- | Data-type wrapping up all the options available when rendering the list -- of 'Output's. data OutputOptions = OutputOptions   { outputOptionsIndentAmount :: Int   -- ^ Number of spaces to use when indenting.  It should probably be either 2   -- or 4.-  , outputOptionsUseColor :: UseColor-  -- ^ Whether or not to use ansi escape sequences to print colors.-  } deriving (Data, Eq, Generic, Read, Show, Typeable)+  , outputOptionsColorOptions :: Maybe ColorOptions+  -- ^ If this is 'Nothing', then don't colorize the output.  If this is+  -- @'Just' colorOptions@, then use @colorOptions@ to colorize the output.+  } deriving (Eq, Generic, Show, Typeable) --- | Default values for 'OutputOptions'.  'outputOptionsIndentAmount' defaults--- to 4, and 'outputOptionsUseColor' defaults to 'UseColor'.-defaultOutputOptions :: OutputOptions-defaultOutputOptions =+-- | Default values for 'OutputOptions' when printing to a console with a dark+-- background.  'outputOptionsIndentAmount' is 4, and+-- 'outputOptionsColorOptions' is 'defaultColorOptionsDarkBg'.+defaultOutputOptionsDarkBg :: OutputOptions+defaultOutputOptionsDarkBg =   OutputOptions-  {outputOptionsIndentAmount = 4, outputOptionsUseColor = UseColor}+  { outputOptionsIndentAmount = 4+  , outputOptionsColorOptions = Just defaultColorOptionsDarkBg+  } +-- | Default values for 'OutputOptions' when printing to a console with a light+-- background.  'outputOptionsIndentAmount' is 4, and+-- 'outputOptionsColorOptions' is 'defaultColorOptionsLightBg'.+defaultOutputOptionsLightBg :: OutputOptions+defaultOutputOptionsLightBg =+  OutputOptions+  { outputOptionsIndentAmount = 4+  , outputOptionsColorOptions = Just defaultColorOptionsLightBg+  }++-- | Default values for 'OutputOptions' when printing using using ANSI escape+-- sequences for color.  'outputOptionsIndentAmount' is 4, and+-- 'outputOptionsColorOptions' is 'Nothing'.+defaultOutputOptionsNoColor :: OutputOptions+defaultOutputOptionsNoColor =+  OutputOptions+  {outputOptionsIndentAmount = 4, outputOptionsColorOptions = Nothing}++-- | Given 'OutputOptions' and a list of 'Output', turn the 'Output' into a+-- lazy 'Text'. render :: OutputOptions -> [Output] -> Text render options outputs = toLazyText $ runReader (renderOutputs outputs) options +-- | Turn a list of 'Output' into a 'Builder', using the options specified in+-- the 'OutputOptions'. renderOutputs   :: forall m.      MonadReader OutputOptions m@@ -75,12 +94,8 @@     foldFunc :: Builder -> Output -> m Builder     foldFunc accum output = mappend accum <$> renderOutput output -renderRaibowParenFor-  :: MonadReader OutputOptions m-  => NestLevel -> Builder -> m Builder-renderRaibowParenFor nest string =-  sequenceFold [rainbowParen nest, pure string, colorReset]-+-- | Render a single 'Output' as a 'Builder', using the options specified in+-- the 'OutputOptions'. renderOutput :: MonadReader OutputOptions m => Output -> m Builder renderOutput (Output nest OutputCloseBrace) = renderRaibowParenFor nest "}" renderOutput (Output nest OutputCloseBracket) = renderRaibowParenFor nest "]"@@ -98,16 +113,71 @@   pure $ fromString string renderOutput (Output _ (OutputStringLit string)) = do   sequenceFold-    [ colorQuote+    [ useColorQuote     , pure "\""-    , colorString+    , useColorReset+    , useColorString     -- TODO: This probably shouldn't be a string to begin with.     , pure $ fromString string-    , colorQuote+    , useColorReset+    , useColorQuote     , pure "\""-    , colorReset+    , useColorReset     ] +-- | Produce a 'Builder' corresponding to the ANSI escape sequence for the+-- color for the @\"@, based on whether or not 'outputOptionsColorOptions' is+-- 'Just' or 'Nothing', and the value of 'colorQuote'.+useColorQuote :: forall m. MonadReader OutputOptions m => m Builder+useColorQuote = maybe "" colorQuote <$> reader outputOptionsColorOptions++-- | Produce a 'Builder' corresponding to the ANSI escape sequence for the+-- color for the characters of a string, based on whether or not+-- 'outputOptionsColorOptions' is 'Just' or 'Nothing', and the value of+-- 'colorString'.+useColorString :: forall m. MonadReader OutputOptions m => m Builder+useColorString = maybe "" colorString <$> reader outputOptionsColorOptions++useColorError :: forall m. MonadReader OutputOptions m => m Builder+useColorError = maybe "" colorError <$> reader outputOptionsColorOptions++useColorNum :: forall m. MonadReader OutputOptions m => m Builder+useColorNum = maybe "" colorNum <$> reader outputOptionsColorOptions++-- | Produce a 'Builder' corresponding to the ANSI escape sequence for+-- resetting the console color back to the default. Produces an empty 'Builder'+-- if 'outputOptionsColorOptions' is 'Nothing'.+useColorReset :: forall m. MonadReader OutputOptions m => m Builder+useColorReset = maybe "" (const colorReset) <$> reader outputOptionsColorOptions++-- | Produce a 'Builder' representing the ANSI escape sequence for the color of+-- the rainbow parenthesis, given an input 'NestLevel' and 'Builder' to use as+-- the input character.+--+-- If 'outputOptionsColorOptions' is 'Nothing', then just return the input+-- character.  If it is 'Just', then return the input character colorized.+renderRaibowParenFor+  :: MonadReader OutputOptions m+  => NestLevel -> Builder -> m Builder+renderRaibowParenFor nest string =+  sequenceFold [useColorRainbowParens nest, pure string, useColorReset]++useColorRainbowParens+  :: forall m.+     MonadReader OutputOptions m+  => NestLevel -> m Builder+useColorRainbowParens nest = do+  maybeOutputColor <- reader outputOptionsColorOptions+  pure $+    case maybeOutputColor of+      Just ColorOptions {colorRainbowParens} -> do+        let choicesLen = length colorRainbowParens+        if choicesLen == 0+          then ""+          else colorRainbowParens !! (unNestLevel nest `mod` choicesLen)+      Nothing -> ""++-- | This is simply @'fmap' 'fold' '.' 'sequence'@. sequenceFold :: (Monad f, Monoid a, Traversable t) => t (f a) -> f a sequenceFold = fmap fold . sequence @@ -155,89 +225,3 @@ shrinkWhitespace (' ':' ':t) = shrinkWhitespace (' ':t) shrinkWhitespace (h:t) = h : shrinkWhitespace t shrinkWhitespace "" = ""---------------------------- High-level colors ----------------------------colorQuote :: MonadReader OutputOptions m => m Builder-colorQuote = appendColors colorBold colorVividWhite--colorString :: MonadReader OutputOptions m => m Builder-colorString = appendColors colorBold colorVividBlue--colorError :: MonadReader OutputOptions m => m Builder-colorError = appendColors colorBold colorVividRed--colorNum :: MonadReader OutputOptions m => m Builder-colorNum = appendColors colorBold colorVividGreen--rainbowParen-  :: forall m.-     MonadReader OutputOptions m-  => NestLevel -> m Builder-rainbowParen (NestLevel nestLevel) =-  let choicesLen = length rainbowParenChoices-  in rainbowParenChoices !! (nestLevel `mod` choicesLen)-  where-    rainbowParenChoices :: [m Builder]-    rainbowParenChoices =-        [ appendColors colorBold colorVividMagenta-        , appendColors colorBold colorVividCyan-        , appendColors colorBold colorVividYellow-        ]--------------------------- Low-level Colors ---------------------------canUseColor :: MonadReader OutputOptions m => m Bool-canUseColor = do-  color <- reader outputOptionsUseColor-  case color of-    NoColor -> pure False-    UseColor -> pure True--ifM :: Monad m => m Bool -> a -> a -> m a-ifM comparisonM thenValue elseValue = do-  res <- comparisonM-  case res of-    True -> pure thenValue-    False -> pure elseValue--colorBold :: MonadReader OutputOptions m => m Builder-colorBold = ifM canUseColor (setSGRCodeBuilder [SetConsoleIntensity BoldIntensity]) ""--colorReset :: MonadReader OutputOptions m => m Builder-colorReset = ifM canUseColor (setSGRCodeBuilder [Reset]) ""--colorVividBlue :: MonadReader OutputOptions m => m Builder-colorVividBlue = colorHelper Vivid Blue--colorVividCyan :: MonadReader OutputOptions m => m Builder-colorVividCyan = colorHelper Vivid Cyan--colorVividGreen :: MonadReader OutputOptions m => m Builder-colorVividGreen = colorHelper Vivid Green--colorVividMagenta :: MonadReader OutputOptions m => m Builder-colorVividMagenta = colorHelper Vivid Magenta--colorVividRed :: MonadReader OutputOptions m => m Builder-colorVividRed = colorHelper Vivid Red--colorVividWhite :: MonadReader OutputOptions m => m Builder-colorVividWhite = colorHelper Vivid White--colorVividYellow :: MonadReader OutputOptions m => m Builder-colorVividYellow = colorHelper Vivid Yellow--colorHelper :: MonadReader OutputOptions m => ColorIntensity -> Color -> m Builder-colorHelper colorIntensity color =-  ifM canUseColor (setSGRCodeBuilder [SetColor Foreground colorIntensity color]) ""--appendColors :: MonadReader OutputOptions m => m Builder -> m Builder -> m Builder-appendColors color1 color2 = mappend <$> color1 <*> color2--setSGRCodeBuilder :: [SGR] -> Builder-setSGRCodeBuilder = fromString . setSGRCode