pretty-simple 4.0.0.0 → 4.1.0.0
raw patch · 10 files changed
+148/−78 lines, 10 files
Files
- CHANGELOG.md +14/−0
- README.md +13/−4
- app/Main.hs +22/−9
- pretty-simple.cabal +3/−2
- src/Debug/Pretty/Simple.hs +52/−0
- src/Text/Pretty/Simple.hs +23/−4
- src/Text/Pretty/Simple/Internal/Color.hs +0/−1
- src/Text/Pretty/Simple/Internal/Expr.hs +0/−1
- src/Text/Pretty/Simple/Internal/ExprParser.hs +0/−3
- src/Text/Pretty/Simple/Internal/Printer.hs +21/−54
CHANGELOG.md view
@@ -1,4 +1,18 @@ +## 4.1.0.0++* Fix a regression which arose in 4.0, whereby excess spaces would be inserted for unusual strings like dates and IP addresses.+ [#105](https://github.com/cdepillabout/pretty-simple/pull/105)+* Attach warnings to debugging functions, so that they're easy to find and remove.+ [#103](https://github.com/cdepillabout/pretty-simple/pull/103)+* Some minor improvements to the CLI tool:+ * Add a `--version`/`-v` flag.+ [#83](https://github.com/cdepillabout/pretty-simple/pull/83)+ * Add a trailing newline.+ [#87](https://github.com/cdepillabout/pretty-simple/pull/87)+ * Install by default, without requiring a flag.+ [#94](https://github.com/cdepillabout/pretty-simple/pull/94)+ ## 4.0.0.0 * Expand `OutputOptions`:
README.md view
@@ -44,12 +44,18 @@ `pretty-simple` can be easily used from `ghci` when debugging. When using `stack` to run `ghci`, just append the `--package` flag to-the command line to load `pretty-simple`.+the command line to load `pretty-simple`: ```sh $ stack ghci --package pretty-simple ``` +Or, with cabal:++```sh+$ cabal repl --build-depends pretty-simple+```+ Once you get a prompt in `ghci`, you can use `import` to get `pretty-simple`'s [`pPrint`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pPrint) function in scope.@@ -81,7 +87,7 @@ - Easy to understand deeply nested data types. - Configurable - Indentation, compactness, colors and more are configurable with the- [`pPrintOpt`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pPrintOpt)+ [`pPrintOpt`](https://hackage.haskell.org/package/pretty-simple-1.0.0.6/docs/Text-Pretty-Simple.html#v:pPrintOpt) function. - Fast - No problem pretty-printing data types thousands of lines long.@@ -106,11 +112,14 @@ The `pPrint` function can be used as the default output function in GHCi. -All you need to do is run GHCi like this:+All you need to do is run GHCi with a command like one of these: ```sh $ stack ghci --ghci-options "-interactive-print=Text.Pretty.Simple.pPrint" --package pretty-simple ```+```sh+$ cabal repl --repl-options "-interactive-print=Text.Pretty.Simple.pPrint" --build-depends pretty-simple+``` Now, whenever you make GHCi evaluate an expression, GHCi will pretty-print the result using `pPrint`! See@@ -181,7 +190,7 @@ must enable the `buildexe` flag, since it will not be built by default: ```sh-$ stack install pretty-simple-4.0.0.0 --flag pretty-simple:buildexe+$ stack install pretty-simple-2.2.0.1 --flag pretty-simple:buildexe ``` When run on the command line, you can paste in the Haskell datatype you want to
app/Main.hs view
@@ -23,14 +23,16 @@ -- ] -- @ +import Data.Monoid ((<>)) import Data.Text (unpack) import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as LT-import Options.Applicative - ( Parser, ReadM, execParser, fullDesc, help, helper, info, long- , option, progDesc, readerError, short, showDefaultWith, str, value, (<**>))-import Data.Monoid ((<>))-import Text.Pretty.Simple +import Data.Version (showVersion)+import Options.Applicative+ ( Parser, ReadM, execParser, fullDesc, help, helper, info, infoOption, long+ , option, progDesc, readerError, short, showDefaultWith, str, value)+import Paths_pretty_simple (version)+import Text.Pretty.Simple ( pStringOpt, OutputOptions , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg@@ -41,7 +43,9 @@ | LightBg | NoColor -newtype Args = Args { color :: Color }+newtype Args = Args+ { color :: Color+ } colorReader :: ReadM Color colorReader = do@@ -58,19 +62,28 @@ ( long "color" <> short 'c' <> help "Select printing color. Available options: dark-bg (default), light-bg, no-color."- <> showDefaultWith (\_ -> "dark-bg")+ <> showDefaultWith (const "dark-bg") <> value DarkBg ) +versionOption :: Parser (a -> a)+versionOption =+ infoOption+ (showVersion version)+ ( long "version"+ <> short 'V'+ <> help "Show version"+ )+ main :: IO () main = do args' <- execParser opts input <- T.getContents let printOpt = getPrintOpt $ color args' output = pStringOpt printOpt $ unpack input- LT.putStr output+ LT.putStrLn output where- opts = info (args <**> helper)+ opts = info (helper <*> versionOption <*> args) ( fullDesc <> progDesc "Format Haskell data types with indentation and highlighting" )
pretty-simple.cabal view
@@ -1,5 +1,5 @@ name: pretty-simple-version: 4.0.0.0+version: 4.1.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,7 +22,7 @@ flag buildexe description: Build an small command line program that pretty-print anything from stdin.- default: False+ default: True flag buildexample description: Build a small example program showing how to use the pPrint function@@ -50,6 +50,7 @@ executable pretty-simple main-is: Main.hs+ other-modules: Paths_pretty_simple hs-source-dirs: app build-depends: base , pretty-simple
src/Debug/Pretty/Simple.hs view
@@ -95,6 +95,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceIO "'pTraceIO' remains in code" #-} pTraceIO :: String -> IO () pTraceIO = pTraceOptIO CheckColorTty defaultOutputOptionsDarkBg @@ -113,6 +114,7 @@ @since 2.0.1.0 -}+{-# WARNING pTrace "'pTrace' remains in code" #-} pTrace :: String -> a -> a pTrace = pTraceOpt CheckColorTty defaultOutputOptionsDarkBg @@ -121,6 +123,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceId "'pTraceId' remains in code" #-} pTraceId :: String -> String pTraceId = pTraceIdOpt CheckColorTty defaultOutputOptionsDarkBg @@ -139,6 +142,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceShow "'pTraceShow' remains in code" #-} pTraceShow :: (Show a) => a -> b -> b pTraceShow = pTraceShowOpt CheckColorTty defaultOutputOptionsDarkBg @@ -147,6 +151,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceShowId "'pTraceShowId' remains in code" #-} pTraceShowId :: (Show a) => a -> a pTraceShowId = pTraceShowIdOpt CheckColorTty defaultOutputOptionsDarkBg {-|@@ -168,6 +173,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceM "'pTraceM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceM :: (Monad f) => String -> f () #else@@ -185,6 +191,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceShowM "'pTraceShowM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowM :: (Show a, Monad f) => a -> f () #else@@ -204,6 +211,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceStack "'pTraceStack' remains in code" #-} pTraceStack :: String -> a -> a pTraceStack = pTraceStackOpt CheckColorTty defaultOutputOptionsDarkBg @@ -221,6 +229,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceEvent "'pTraceEvent' remains in code" #-} pTraceEvent :: String -> a -> a pTraceEvent = pTraceEventOpt CheckColorTty defaultOutputOptionsDarkBg @@ -233,6 +242,7 @@ @since 2.0.1.0 -}+{-# WARNING pTraceEventIO "'pTraceEventIO' remains in code" #-} pTraceEventIO :: String -> IO () pTraceEventIO = pTraceEventOptIO CheckColorTty defaultOutputOptionsDarkBg @@ -249,6 +259,7 @@ -- that uses 'pTraceMarker'. -- -- @since 2.0.1.0+{-# WARNING pTraceMarker "'pTraceMarker' remains in code" #-} pTraceMarker :: String -> a -> a pTraceMarker = pTraceMarkerOpt CheckColorTty defaultOutputOptionsDarkBg @@ -259,12 +270,14 @@ -- to other IO actions. -- -- @since 2.0.1.0+{-# WARNING pTraceMarkerIO "'pTraceMarkerIO' remains in code" #-} pTraceMarkerIO :: String -> IO () pTraceMarkerIO = pTraceMarkerOptIO CheckColorTty defaultOutputOptionsDarkBg ------------------------------------------ -- Helpers ------------------------------------------+{-# WARNING pStringTTYOptIO "'pStringTTYOptIO' remains in code" #-} pStringTTYOptIO :: CheckColorTty -> OutputOptions -> String -> IO Text pStringTTYOptIO checkColorTty outputOptions v = do realOutputOpts <-@@ -273,14 +286,17 @@ NoCheckColorTty -> pure outputOptions pure $ pStringOpt realOutputOpts v +{-# WARNING pStringTTYOpt "'pStringTTYOpt' remains in code" #-} pStringTTYOpt :: CheckColorTty -> OutputOptions -> String -> Text pStringTTYOpt checkColorTty outputOptions = unsafePerformIO . pStringTTYOptIO checkColorTty outputOptions +{-# WARNING pShowTTYOptIO "'pShowTTYOptIO' remains in code" #-} pShowTTYOptIO :: Show a => CheckColorTty -> OutputOptions -> a -> IO Text pShowTTYOptIO checkColorTty outputOptions = pStringTTYOptIO checkColorTty outputOptions . show +{-# WARNING pShowTTYOpt "'pShowTTYOpt' remains in code" #-} pShowTTYOpt :: Show a => CheckColorTty -> OutputOptions -> a -> Text pShowTTYOpt checkColorTty outputOptions = unsafePerformIO . pShowTTYOptIO checkColorTty outputOptions@@ -289,22 +305,27 @@ -- Traces forcing color ------------------------------------------ -- | Similar to 'pTrace', but forcing color.+{-# WARNING pTraceForceColor "'pTraceForceColor' remains in code" #-} pTraceForceColor :: String -> a -> a pTraceForceColor = pTraceOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceId', but forcing color.+{-# WARNING pTraceIdForceColor "'pTraceIdForceColor' remains in code" #-} pTraceIdForceColor :: String -> String pTraceIdForceColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShow', but forcing color.+{-# WARNING pTraceShowForceColor "'pTraceShowForceColor' remains in code" #-} pTraceShowForceColor :: (Show a) => a -> b -> b pTraceShowForceColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShowId', but forcing color.+{-# WARNING pTraceShowIdForceColor "'pTraceShowIdForceColor' remains in code" #-} pTraceShowIdForceColor :: (Show a) => a -> a pTraceShowIdForceColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceM', but forcing color.+{-# WARNING pTraceMForceColor "'pTraceMForceColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceMForceColor :: (Monad f) => String -> f () #else@@ -312,6 +333,7 @@ #endif pTraceMForceColor = pTraceOptM NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShowM', but forcing color.+{-# WARNING pTraceShowMForceColor "'pTraceShowMForceColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowMForceColor :: (Show a, Monad f) => a -> f () #else@@ -321,31 +343,37 @@ pTraceShowOptM NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceStack', but forcing color.+{-# WARNING pTraceStackForceColor "'pTraceStackForceColor' remains in code" #-} pTraceStackForceColor :: String -> a -> a pTraceStackForceColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEvent', but forcing color.+{-# WARNING pTraceEventForceColor "'pTraceEventForceColor' remains in code" #-} pTraceEventForceColor :: String -> a -> a pTraceEventForceColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEventIO', but forcing color.+{-# WARNING pTraceEventIOForceColor "'pTraceEventIOForceColor' remains in code" #-} pTraceEventIOForceColor :: String -> IO () pTraceEventIOForceColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarker', but forcing color.+{-# WARNING pTraceMarkerForceColor "'pTraceMarkerForceColor' remains in code" #-} pTraceMarkerForceColor :: String -> a -> a pTraceMarkerForceColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarkerIO', but forcing color.+{-# WARNING pTraceMarkerIOForceColor "'pTraceMarkerIOForceColor' remains in code" #-} pTraceMarkerIOForceColor :: String -> IO () pTraceMarkerIOForceColor = pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceIO', but forcing color.+{-# WARNING pTraceIOForceColor "'pTraceIOForceColor' remains in code" #-} pTraceIOForceColor :: String -> IO () pTraceIOForceColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsDarkBg @@ -359,6 +387,7 @@ -- () -- -- @since 2.0.2.0+{-# WARNING pTraceNoColor "'pTraceNoColor' remains in code" #-} pTraceNoColor :: String -> a -> a pTraceNoColor = pTraceOpt NoCheckColorTty defaultOutputOptionsNoColor @@ -372,6 +401,7 @@ -- () -- -- @since 2.0.2.0+{-# WARNING pTraceIdNoColor "'pTraceIdNoColor' remains in code" #-} pTraceIdNoColor :: String -> String pTraceIdNoColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsNoColor @@ -388,6 +418,7 @@ -- () -- -- @since 2.0.2.0+{-# WARNING pTraceShowNoColor "'pTraceShowNoColor' remains in code" #-} pTraceShowNoColor :: (Show a) => a -> b -> b pTraceShowNoColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsNoColor @@ -404,6 +435,7 @@ -- () -- -- @since 2.0.2.0+{-# WARNING pTraceShowIdNoColor "'pTraceShowIdNoColor' remains in code" #-} pTraceShowIdNoColor :: (Show a) => a -> a pTraceShowIdNoColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsNoColor@@ -413,6 +445,7 @@ -- wow -- -- @since 2.0.2.0+{-# WARNING pTraceMNoColor "'pTraceMNoColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceMNoColor :: (Monad f) => String -> f () #else@@ -428,6 +461,7 @@ -- ] -- -- @since 2.0.2.0+{-# WARNING pTraceShowMNoColor "'pTraceShowMNoColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowMNoColor :: (Show a, Monad f) => a -> f () #else@@ -442,18 +476,21 @@ -- () -- -- @since 2.0.2.0+{-# WARNING pTraceStackNoColor "'pTraceStackNoColor' remains in code" #-} pTraceStackNoColor :: String -> a -> a pTraceStackNoColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEvent', but without color. -- -- @since 2.0.2.0+{-# WARNING pTraceEventNoColor "'pTraceEventNoColor' remains in code" #-} pTraceEventNoColor :: String -> a -> a pTraceEventNoColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEventIO', but without color. -- -- @since 2.0.2.0+{-# WARNING pTraceEventIONoColor "'pTraceEventIONoColor' remains in code" #-} pTraceEventIONoColor :: String -> IO () pTraceEventIONoColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsNoColor@@ -461,6 +498,7 @@ -- | Similar to 'pTraceMarker', but without color. -- -- @since 2.0.2.0+{-# WARNING pTraceMarkerNoColor "'pTraceMarkerNoColor' remains in code" #-} pTraceMarkerNoColor :: String -> a -> a pTraceMarkerNoColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsNoColor@@ -468,6 +506,7 @@ -- | Similar to 'pTraceMarkerIO', but without color. -- -- @since 2.0.2.0+{-# WARNING pTraceMarkerIONoColor "'pTraceMarkerIONoColor' remains in code" #-} pTraceMarkerIONoColor :: String -> IO () pTraceMarkerIONoColor = pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsNoColor@@ -481,6 +520,7 @@ -- ) -- -- @since 2.0.2.0+{-# WARNING pTraceIONoColor "'pTraceIONoColor' remains in code" #-} pTraceIONoColor :: String -> IO () pTraceIONoColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsNoColor @@ -490,6 +530,7 @@ {-| Like 'pTrace' but takes OutputOptions. -}+{-# WARNING pTraceOpt "'pTraceOpt' remains in code" #-} pTraceOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceOpt checkColorTty outputOptions = trace . unpack . pStringTTYOpt checkColorTty outputOptions@@ -497,6 +538,7 @@ {-| Like 'pTraceId' but takes OutputOptions. -}+{-# WARNING pTraceIdOpt "'pTraceIdOpt' remains in code" #-} pTraceIdOpt :: CheckColorTty -> OutputOptions -> String -> String pTraceIdOpt checkColorTty outputOptions a = pTraceOpt checkColorTty outputOptions a a@@ -504,6 +546,7 @@ {-| Like 'pTraceShow' but takes OutputOptions. -}+{-# WARNING pTraceShowOpt "'pTraceShowOpt' remains in code" #-} pTraceShowOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> b -> b pTraceShowOpt checkColorTty outputOptions = trace . unpack . pShowTTYOpt checkColorTty outputOptions@@ -511,6 +554,7 @@ {-| Like 'pTraceShowId' but takes OutputOptions. -}+{-# WARNING pTraceShowIdOpt "'pTraceShowIdOpt' remains in code" #-} pTraceShowIdOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> a pTraceShowIdOpt checkColorTty outputOptions a = trace (unpack $ pShowTTYOpt checkColorTty outputOptions a) a@@ -518,12 +562,14 @@ {-| Like 'pTraceIO' but takes OutputOptions. -}+{-# WARNING pTraceOptIO "'pTraceOptIO' remains in code" #-} pTraceOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceOptIO checkColorTty outputOptions = traceIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions {-| Like 'pTraceM' but takes OutputOptions. -}+{-# WARNING pTraceOptM "'pTraceOptM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceOptM :: (Monad f) => CheckColorTty -> OutputOptions -> String -> f () #else@@ -535,6 +581,7 @@ {-| Like 'pTraceShowM' but takes OutputOptions. -}+{-# WARNING pTraceShowOptM "'pTraceShowOptM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowOptM :: (Show a, Monad f) => CheckColorTty -> OutputOptions -> a -> f ()@@ -548,6 +595,7 @@ {-| Like 'pTraceStack' but takes OutputOptions. -}+{-# WARNING pTraceStackOpt "'pTraceStackOpt' remains in code" #-} pTraceStackOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceStackOpt checkColorTty outputOptions = traceStack . unpack . pStringTTYOpt checkColorTty outputOptions@@ -555,6 +603,7 @@ {-| Like 'pTraceEvent' but takes OutputOptions. -}+{-# WARNING pTraceEventOpt "'pTraceEventOpt' remains in code" #-} pTraceEventOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceEventOpt checkColorTty outputOptions = traceEvent . unpack . pStringTTYOpt checkColorTty outputOptions@@ -562,6 +611,7 @@ {-| Like 'pTraceEventIO' but takes OutputOptions. -}+{-# WARNING pTraceEventOptIO "'pTraceEventOptIO' remains in code" #-} pTraceEventOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceEventOptIO checkColorTty outputOptions = traceEventIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions@@ -569,6 +619,7 @@ {-| Like 'pTraceMarker' but takes OutputOptions. -}+{-# WARNING pTraceMarkerOpt "'pTraceMarkerOpt' remains in code" #-} pTraceMarkerOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceMarkerOpt checkColorTty outputOptions = traceMarker . unpack . pStringTTYOpt checkColorTty outputOptions@@ -576,6 +627,7 @@ {-| Like 'pTraceMarkerIO' but takes OutputOptions. -}+{-# WARNING pTraceMarkerOptIO "'pTraceMarkerOptIO' remains in code" #-} pTraceMarkerOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceMarkerOptIO checkColorTty outputOptions = traceMarkerIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions
src/Text/Pretty/Simple.hs view
@@ -1,12 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple@@ -691,6 +687,29 @@ -- ( B -- ( B ( B A ) ) -- )+--+-- __Weird/illegal show instances__+--+-- >>> pPrintString "2019-02-18 20:56:24.265489 UTC"+-- 2019-02-18 20:56:24.265489 UTC+--+-- >>> pPrintString "a7ed86f7-7f2c-4be5-a760-46a3950c2abf"+-- a7ed86f7-7f2c-4be5-a760-46a3950c2abf+--+-- >>> pPrintString "192.168.0.1:8000"+-- 192.168.0.1:8000+--+-- >>> pPrintString "A @\"type\" 1"+-- A @"type" 1+--+-- >>> pPrintString "2+2"+-- 2+2+--+-- >>> pPrintString "1.0e-2"+-- 1.0e-2+--+-- >>> pPrintString "0x1b"+-- 0x1b -- -- __Other__ --
src/Text/Pretty/Simple/Internal/Color.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple.Internal.Color
src/Text/Pretty/Simple/Internal/Expr.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple.Internal.Expr
src/Text/Pretty/Simple/Internal/ExprParser.hs view
@@ -1,10 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple.Internal.ExprParser
src/Text/Pretty/Simple/Internal/Printer.hs view
@@ -32,14 +32,14 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad (join) import Control.Monad.State (MonadState, evalState, modify, gets)-import Data.Char (isPrint, isSpace, ord)-import Data.List (dropWhileEnd)+import Data.Char (isPrint, ord) import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.Maybe (fromMaybe) import Prettyprinter- (indent, line', PageWidth(AvailablePerLine), layoutPageWidth, nest, hsep,+ (indent, line', PageWidth(AvailablePerLine), layoutPageWidth, nest, concatWith, space, Doc, SimpleDocStream, annotate, defaultLayoutOptions,- enclose, hcat, layoutSmart, line, unAnnotateS, pretty, group)+ enclose, hcat, layoutSmart, line, unAnnotateS, pretty, group,+ removeTrailingWhitespace) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Numeric (showHex)@@ -197,11 +197,11 @@ layoutString :: OutputOptions -> String -> SimpleDocStream Style layoutString opts = annotateStyle opts+ . removeTrailingWhitespace . layoutSmart defaultLayoutOptions {layoutPageWidth = AvailablePerLine (outputOptionsPageWidth opts) 1} . indent (outputOptionsInitialIndent opts) . prettyExprs' opts- . preprocess opts . expressionParse -- | Slight adjustment of 'prettyExprs' for the outermost level,@@ -220,10 +220,10 @@ in if isSimple x then -- keep the expression on the current line- nest 2 $ space <> doc+ nest 2 doc else -- put the expression on a new line, indented (unless grouped)- nest (outputOptionsIndentAmount opts) $ line <> doc+ nest (outputOptionsIndentAmount opts) $ line' <> doc -- | Construct a 'Doc' from a single 'Expr'. prettyExpr :: OutputOptions -> Expr -> Doc Annotation@@ -231,20 +231,30 @@ Brackets xss -> list "[" "]" xss Braces xss -> list "{" "}" xss Parens xss -> list "(" ")" xss- StringLit s -> join enclose (annotate Quote "\"") $ annotate String $ pretty s+ StringLit s -> join enclose (annotate Quote "\"") $ annotate String $ pretty $+ case outputOptionsStringStyle opts of+ Literal -> s+ EscapeNonPrintable -> escapeNonPrintable $ readStr s+ DoNotEscapeNonPrintable -> readStr s CharLit s -> join enclose (annotate Quote "'") $ annotate String $ pretty s Other s -> pretty s NumberLit n -> annotate Num $ pretty n where+ readStr :: String -> String+ readStr s = fromMaybe s . readMaybe $ '"' : s ++ "\"" list :: Doc Annotation -> Doc Annotation -> CommaSeparated [Expr] -> Doc Annotation list open close (CommaSeparated xss) = enclose (annotate Open open) (annotate Close close) $ case xss of [] -> mempty [xs] | all isSimple xs ->- space <> hsep (map (prettyExpr opts) xs) <> space- _ -> concatWith lineAndCommaSep (map (prettyExprs opts) xss)+ space <> hcat (map (prettyExpr opts) xs) <> space+ _ -> concatWith lineAndCommaSep (map (\xs -> spaceIfNeeded xs <> prettyExprs opts xs) xss) <> if outputOptionsCompactParens opts then space else line+ where+ spaceIfNeeded = \case+ Other (' ' : _) : _ -> mempty+ _ -> space lineAndCommaSep x y = x <> line' <> annotate Comma "," <> y -- | Determine whether this expression should be displayed on a single line.@@ -292,33 +302,6 @@ | String | Num --- | Apply various transformations to clean up the 'Expr's.-preprocess :: OutputOptions -> [Expr] -> [Expr]-preprocess opts = map processExpr . removeEmptyOthers- where- processExpr = \case- Brackets xss -> Brackets $ cs xss- Braces xss -> Braces $ cs xss- Parens xss -> Parens $ cs xss- StringLit s -> StringLit $- case outputOptionsStringStyle opts of- Literal -> s- EscapeNonPrintable -> escapeNonPrintable $ readStr s- DoNotEscapeNonPrintable -> readStr s- CharLit s -> CharLit s- Other s -> Other $ shrinkWhitespace $ strip s- NumberLit n -> NumberLit n- cs (CommaSeparated ess) = CommaSeparated $ map (preprocess opts) ess- readStr :: String -> String- readStr s = fromMaybe s . readMaybe $ '"': s ++ "\""---- | Remove any 'Other' 'Expr's which contain only spaces.--- These provide no value, but mess up formatting if left in.-removeEmptyOthers :: [Expr] -> [Expr]-removeEmptyOthers = filter $ \case- Other s -> not $ all isSpace s- _ -> True- -- | Replace non-printable characters with hex escape sequences. -- -- >>> escapeNonPrintable "\x1\x2"@@ -334,7 +317,7 @@ -- >>> escapeNonPrintable "h\101llo" -- "hello" escapeNonPrintable :: String -> String-escapeNonPrintable input = foldr escape "" input+escapeNonPrintable = foldr escape "" -- | Replace an unprintable character except a newline -- with a hex escape sequence.@@ -342,22 +325,6 @@ escape c | isPrint c || c == '\n' = (c:) | otherwise = ('\\':) . ('x':) . showHex (ord c)---- | Compress multiple whitespaces to just one whitespace.------ >>> shrinkWhitespace " hello there "--- " hello there "-shrinkWhitespace :: String -> String-shrinkWhitespace (' ':' ':t) = shrinkWhitespace (' ':t)-shrinkWhitespace (h:t) = h : shrinkWhitespace t-shrinkWhitespace "" = ""---- | Remove trailing and leading whitespace (see 'Data.Text.strip').------ >>> strip " hello there "--- "hello there"-strip :: String -> String-strip = dropWhile isSpace . dropWhileEnd isSpace -- | A bidirectional Turing-machine tape: -- infinite in both directions, with a head pointing to one element.