pretty-simple-4.1.4.0/ 0000755 0000000 0000000 00000000000 07346545000 012665 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/CHANGELOG.md 0000644 0000000 0000000 00000020037 07346545000 014500 0 ustar 00 0000000 0000000 ## 4.1.4.0
* Fix double-quoting issue with `pTraceShowWith`.
[#132](https://github.com/cdepillabout/pretty-simple/pull/132)
Thanks [@leoslf](https://github.com/leoslf)!
## 4.1.3.0
* Remove custom setup. This makes cross-compiling `pretty-simple` a lot more
straightforward. No functionality has been lost from the library, since the
custom setup was only used for generating tests.
[#107](https://github.com/cdepillabout/pretty-simple/pull/107)
## 4.1.2.0
* Fix a problem with the `pHPrint` function incorrectly
outputting a trailing newline to stdout, instead of the
handle you pass it.
[#118](https://github.com/cdepillabout/pretty-simple/pull/118)
* Add a [web app](https://cdepillabout.github.io/pretty-simple/) where you
can play around with `pretty-simple` in your browser.
[#116](https://github.com/cdepillabout/pretty-simple/pull/116).
This took a lot of hard work by [@georgefst](https://github.com/georgefst)!
## 4.1.1.0
* Make the pretty-printed output with `outputOptionsCompact` enabled a little
more compact.
[#110](https://github.com/cdepillabout/pretty-simple/pull/110).
Thanks [@juhp](https://github.com/juhp)!
* Add a `--compact` / `-C` flag to the `pretty-simple` executable that enables
`outputOptionsCompact`.
[#111](https://github.com/cdepillabout/pretty-simple/pull/111).
Thanks again @juhp!
* Add `pTraceWith` and `pTraceShowWith` to `Debug.Pretty.Simple`.
[#104](https://github.com/cdepillabout/pretty-simple/pull/104).
Thanks [@LeviButcher](https://github.com/LeviButcher)!
## 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`:
* Compactness, including grouping of parentheses.
[#72](https://github.com/cdepillabout/pretty-simple/pull/72)
* Page width, affecting when lines are grouped if compact output is enabled.
[#72](https://github.com/cdepillabout/pretty-simple/pull/72)
* Indent whole expression. Useful when using `pretty-simple` for one part
of a larger output.
[#71](https://github.com/cdepillabout/pretty-simple/pull/71)
* Use `Style` type for easier configuration of colour, boldness etc.
[#73](https://github.com/cdepillabout/pretty-simple/pull/73)
* Significant internal rewrite of printing code, to make use of the [prettyprinter](https://hackage.haskell.org/package/prettyprinter)
library. The internal function `layoutString` can be used to integrate with
other `prettyprinter` backends, such as [prettyprinter-lucid](https://hackage.haskell.org/package/prettyprinter-lucid)
for HTML output.
[#67](https://github.com/cdepillabout/pretty-simple/pull/67)
## 3.3.0.0
* Add an output option to print escaped and non-printable characters
literally when outputting strings.
[#68](https://github.com/cdepillabout/pretty-simple/pull/68) and
[#69](https://github.com/cdepillabout/pretty-simple/pull/69)
Thanks Joe Hermaszewski ([@expipiplus1](https://github.com/expipiplus1))!
## 3.2.3.0
* Fix a bug that messes up printing identifiers with `'` in the name.
Now identifiers like `data Don't = Don't` show up properly.
[#65](https://github.com/cdepillabout/pretty-simple/pull/65)
Thanks George Thomas ([@georgefst](https://github.com/georgefst))!
## 3.2.2.0
* Remove whitespace from the ends of lines.
[#62](https://github.com/cdepillabout/pretty-simple/pull/62)
Thanks Gaith Hallak ([@ghallak](https://github.com/ghallak))!
## 3.2.1.0
* Added `pTraceOpt` functions to `Debug.Pretty.Simple`.
[#58](https://github.com/cdepillabout/pretty-simple/pull/58)
Thanks again [sureyeaah](https://github.com/sureyeaah)!
## 3.2.0.0
* Add support for pretty-printing Haskell character literals.
[#57](https://github.com/cdepillabout/pretty-simple/pull/57)
Thanks again [sjakobi](https://github.com/sjakobi)!
## 3.1.1.0
* Added a `pPrintString` function for pretty-printing a `String` that is the
output of `show`. Implemented in
[#54](https://github.com/cdepillabout/pretty-simple/pull/54). Thanks
[sureyeaah](https://github.com/sureyeaah)!
* Fix build on GHC-7.10.3.
[#55](https://github.com/cdepillabout/pretty-simple/pull/55). Thanks
[sjakobi](https://github.com/sjakobi).
## 3.1.0.0
* Numbers are now highlighted in green by default. Implemented in
[#51](https://github.com/cdepillabout/pretty-simple/pull/51).
Thanks [lawrencebell](https://github.com/lawrencebell)!
## 3.0.0.0
* pretty-simple now escapes non-printable characters by default. A field
called `outputOptionsEscapeNonPrintable` has been added to `OutputOptions`
to control this behavior. Implemented in
[#44](https://github.com/cdepillabout/pretty-simple/pull/44). Thanks
[dminuoso](https://github.com/dminuoso)!
* pretty-simple now checks the output `Handle` to determine whether to print
in color when using functions like `pPrint`. This makes it so that you
can redirect output to a file on disk and still be able to read the
output from `pPrint`! Implemented in
[#47](https://github.com/cdepillabout/pretty-simple/pull/47). Thanks
[metiulekm](https://github.com/metiulekm)!
* Add functions like `pHPrint` for specifying the `Handle` to output to.
Added in [#47](https://github.com/cdepillabout/pretty-simple/pull/47).
## 2.2.0.1
* Fixed a [bug](https://github.com/cdepillabout/pretty-simple/pull/41) where
the parser failed to parse escaped quotation marks in string literals.
Thanks [Andreas](https://github.com/anka-213)!
## 2.2.0.0
* Fixed a [bug](https://github.com/cdepillabout/pretty-simple/pull/33) with a
missing space after strings. Thanks again
[Andrew](https://github.com/andrew-lei)!
* Add a command line flag `--color` to be able to set whether to use colors for
a dark background (`--color dark-bg`), a light background (`--color light-bg`),
or no color (`--color no-color`). This is from
[great work](https://github.com/cdepillabout/pretty-simple/pull/35) by
[Andrew](https://github.com/andrew-lei)!
* Made parsing/printing lazy - pretty-printing will now output strings continuously
as they're read, handling potentially infinite input.
## 2.1.0.1
* Fix a [bug](https://github.com/cdepillabout/pretty-simple/pull/32) where
printing deeply nested data structures would take exponential time. Thanks
[Andrew](https://github.com/andrew-lei)!
## 2.1.0.0
* Make strings have indentation by default when pretty-printed. See
[#26](https://github.com/cdepillabout/pretty-simple/pull/26). Thanks
[Milan](https://github.com/Wizek)!
## 2.0.2.1
* Add a small command-line program that will pretty print anything from stdin
called `pretty-print`. It can be installed to `~/.local/bin` if you enable
the flag `buildexe` like so:
```sh
$ stack install pretty-simple-2.0.2.1 --flag pretty-simple:buildexe
```
When you run it, you can paste something you want formatted on stdin, then
press Ctrl-D. It will print the formatted version on
stdout:
```sh
$ pretty-simple
[(Just 3, Just 4)]
^D
[
( Just 3
, Just 4
)
]
```
## 2.0.2.0
* Fix a [problem](https://github.com/cdepillabout/pretty-simple/pull/20) with
the pTraceShow functions not working correctly.
## 2.0.1.0
* Added the `Debug.Pretty.Simple` that exports functions that work like
`Debug.Trace`.
pretty-simple-4.1.4.0/LICENSE 0000644 0000000 0000000 00000002767 07346545000 013706 0 ustar 00 0000000 0000000 Copyright Dennis Gosnell (c) 2016
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.
* Neither the name of Author name here nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"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
OWNER OR CONTRIBUTORS 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.
pretty-simple-4.1.4.0/README.md 0000644 0000000 0000000 00000017053 07346545000 014152 0 ustar 00 0000000 0000000
Text.Pretty.Simple
==================
[](https://github.com/cdepillabout/pretty-simple/actions)
[](https://hackage.haskell.org/package/pretty-simple)
[](http://stackage.org/lts/package/pretty-simple)
[](http://stackage.org/nightly/package/pretty-simple)
`pretty-simple` is a pretty printer for Haskell data types that have a `Show`
instance.
For example, imagine the following Haskell data types and values:
```haskell
data Foo = Foo { foo1 :: Integer , foo2 :: [String] } deriving Show
foo :: Foo
foo = Foo 3 ["hello", "goodbye"]
data Bar = Bar { bar1 :: Double , bar2 :: [Foo] } deriving Show
bar :: Bar
bar = Bar 10.55 [foo, foo]
```
If you run this in `ghci` and type `print bar`, you'll get output like this:
```haskell
> print bar
Bar {bar1 = 10.55, bar2 = [Foo {foo1 = 3, foo2 = ["hello","goodbye"]},Foo {foo1 = 3, foo2 = ["hello","goodbye"]}]}
```
This is pretty hard to read. Imagine if there were more fields or it were even
more deeply nested. It would be even more difficult to read.
`pretty-simple` can be used to print `bar` in an easy-to-read format:
## Usage
`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`:
```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.
```haskell
> import Text.Pretty.Simple (pPrint)
```
You can test out `pPrint` with simple data types like `Maybe` or tuples.
```haskell
> pPrint $ Just ("hello", "goodbye")
Just
( "hello"
, "goodbye"
)
```
If for whatever reason you're not able to incur a dependency on the `pretty-simple` library, you can simulate its behaviour by using `process` to call out to the command line executable (see below for installation):
```hs
pPrint :: Show a => a -> IO ()
pPrint = putStrLn <=< readProcess "pretty-simple" [] . show
```
There's also a [web app](https://cdepillabout.github.io/pretty-simple), compiled with GHCJS, where you can play around with `pretty-simple` in your browser.
## Features
- Easy-to-read
- Complex data types are simple to understand.
- Color
- Prints in color using ANSI escape codes.
- It is possible to print without color by using the
[`pPrintNoColor`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pPrintNoColor)
function.
- Rainbow Parentheses
- 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-1.0.0.6/docs/Text-Pretty-Simple.html#v:pPrintOpt)
function.
- Fast
- No problem pretty-printing data types thousands of lines long.
- Works with any data type with a `Show` instance
- Some common Haskell data types have a `Show` instance that produces
non-valid Haskell code. `pretty-simple` will pretty-print even these
data types.
## Why not `(some other package)`?
Other pretty-printing packages have some combination of these defects:
- No options for printing in color.
- No options for changing the amount of indentation
- Requires every data type to be an instance of some special typeclass (instead
of just `Show`).
- Requires all `Show` instances to output valid Haskell code.
## Other Uses
### Pretty-print all GHCi output
The `pPrint` function can be used as the default output function in GHCi.
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
[here](https://downloads.haskell.org/%7Eghc/latest/docs/html/users_guide/ghci.html#using-a-custom-interactive-printing-function)
for more info on this neat feature in GHCi.
### Pretty-printing JSON
`pretty-simple` can be used to pretty-print any `String` that is similar to
Haskell data types. The only requirement is that the `String` must correctly
use brackets, parenthese, and braces to indicate nesting.
For example, the
[`pString`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pString)
function can be used to pretty-print JSON.
Recall our example from before.
```haskell
data Foo = Foo { foo1 :: Integer , foo2 :: [String] } deriving Show
foo :: Foo
foo = Foo 3 ["hello", "goodbye"]
data Bar = Bar { bar1 :: Double , bar2 :: [Foo] } deriving Show
bar :: Bar
bar = Bar 10.55 [foo, foo]
```
You can use [`aeson`](https://hackage.haskell.org/package/aeson) to turn these
data types into JSON. First, you must derive
[`ToJSON`](https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:ToJSON)
instances for the data types. It is easiest to do this with Template Haskell:
```haskell
{-# LANGUAGE TemplateHaskell #-}
$(deriveJSON defaultOptions ''Foo)
$(deriveJSON defaultOptions ''Bar)
```
If you run this in `ghci` and type `encode bar`, you'll get output like this:
```haskell
> import Data.Aeson (encode)
> putLazyByteStringLn $ encode bar
{"bar1":10.55,"bar2":[{"foo1":3,"foo2":["hello","goodbye"]},{"foo1":3,"foo2":["hello","goodbye"]}]}
```
Just like Haskell's normal `print` output, this is pretty hard to read.
`pretty-simple` can be used to pretty-print the JSON-encoded `bar` in an
easy-to-read format:
(You can find the `lazyByteStringToString`, `putLazyByteStringLn`,
and `putLazyTextLn` in the [`ExampleJSON.hs`](example/ExampleJSON.hs)
file.)
### Pretty-printing from the command line
`pretty-simple` includes a command line executable that can be used to
pretty-print anything passed in on stdin.
It can be installed to `~/.local/bin/` with the following command.
```sh
$ stack install pretty-simple
```
When run on the command line, you can paste in the Haskell datatype you want to
be formatted, then hit Ctrl-D:
This is very useful if you accidentally print out a Haskell data type with
`print` instead of `pPrint`.
## Contributions
Feel free to open an
[issue](https://github.com/cdepillabout/pretty-simple/issues) or
[PR](https://github.com/cdepillabout/pretty-simple/pulls) for any
bugs/problems/suggestions/improvements.
### Testing
To run the test suite locally, one must install the executables `doctest` and
`cabal-doctest`, e.g. with
`cabal install --ignore-project doctest --flag cabal-doctest`.
Then run the command `cabal doctest`.
## Maintainers
- [@cdepillabout](https://github.com/cdepillabout)
- [@georgefst](https://github.com/georgefst)
pretty-simple-4.1.4.0/app/ 0000755 0000000 0000000 00000000000 07346545000 013445 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/app/Main.hs 0000644 0000000 0000000 00000005237 07346545000 014674 0 ustar 00 0000000 0000000 module Main where
-- This is a small executable that will pretty-print anything from stdin.
-- It can be installed to `~/.local/bin` if you enable the flag `buildexe` like so:
--
-- @
-- $ stack install pretty-simple-2.0.1.1 --flag pretty-simple:buildexe
-- @
--
-- When you run it, you can paste something you want formatted on stdin, then
-- press @Ctrl-D@. It will print the formatted version on stdout:
--
-- @
-- $ pretty-simple
-- [(Just 3, Just 4)]
--
-- ^D
--
-- [
-- ( Just 3
-- , Just 4
-- )
-- ]
-- @
import Data.Monoid ((<>))
import Data.Text (unpack)
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy.IO as LT
import Data.Version (showVersion)
import Options.Applicative
( Parser, ReadM, execParser, fullDesc, help, helper, info, infoOption
, long, option, progDesc, readerError, short, showDefaultWith, str
, switch, value)
import Paths_pretty_simple (version)
import Text.Pretty.Simple
( pStringOpt, OutputOptions
, defaultOutputOptionsDarkBg
, defaultOutputOptionsLightBg
, defaultOutputOptionsNoColor
, outputOptionsCompact
)
data Color = DarkBg
| LightBg
| NoColor
data Args = Args
{ color :: Color
, compact :: Bool
}
colorReader :: ReadM Color
colorReader = do
string <- str
case string of
"dark-bg" -> pure DarkBg
"light-bg" -> pure LightBg
"no-color" -> pure NoColor
x -> readerError $ "Could not parse " <> x <> " as a color."
args :: Parser Args
args = Args
<$> option colorReader
( long "color"
<> short 'c'
<> help "Select printing color. Available options: dark-bg (default), light-bg, no-color."
<> showDefaultWith (const "dark-bg")
<> value DarkBg
)
<*> switch
( long "compact"
<> short 'C'
<> help "Compact output"
)
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 output = pStringOpt (getPrintOpt args') $ unpack input
LT.putStrLn output
where
opts = info (helper <*> versionOption <*> args)
( fullDesc
<> progDesc "Format Haskell data types with indentation and highlighting"
)
getPrintOpt :: Args -> OutputOptions
getPrintOpt as =
(getColorOpt (color as)) {outputOptionsCompact = compact as}
getColorOpt :: Color -> OutputOptions
getColorOpt DarkBg = defaultOutputOptionsDarkBg
getColorOpt LightBg = defaultOutputOptionsLightBg
getColorOpt NoColor = defaultOutputOptionsNoColor
pretty-simple-4.1.4.0/bench/ 0000755 0000000 0000000 00000000000 07346545000 013744 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/bench/Bench.hs 0000644 0000000 0000000 00000002105 07346545000 015315 0 ustar 00 0000000 0000000
module Main where
import Data.Monoid ((<>))
import Data.Text.Lazy (Text)
import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf)
import Text.Pretty.Simple (pShow)
import Example.Data (foo, bar, baz)
main :: IO ()
main =
defaultMain
[ bgroup
"pShow"
[ bench "Foo" $ nf pShow foo
, bench "Bar" $ nf pShow bar
, bench "Baz" $ nf pShow baz
]
, bgroup "recursive deeply-nested data structure" (fmap nestTest [22..25])
]
data ExampleExpr
= A
| B ExampleExpr
| C [ExampleExpr]
deriving (Show)
nest :: ExampleExpr -> Int -> ExampleExpr
nest expr 0 = expr
nest expr n = nest (B expr) (n - 1)
-- | There was a bug in the pretty-simple code that caused deeply nested data
-- structures to have an exponential runtime. Effectively, the runtime doubled
-- at level. The following benchmark is to make sure that we don't
-- accidentally introduce this exponential runtime again.
nestTest :: Int -> Benchmark
nestTest n = bench ("level " <> show n) $ nf test n
where
test :: Int -> Text
test = pShow . nest (C [A,A])
pretty-simple-4.1.4.0/example/ 0000755 0000000 0000000 00000000000 07346545000 014320 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/example/Example.hs 0000644 0000000 0000000 00000001037 07346545000 016250 0 ustar 00 0000000 0000000
{- |
Copyright : Dennis Gosnell 2017
License : BSD3
Maintainer : Dennis Gosnell (cdep.illabout@gmail.com)
Stability : experimental
Portability : unknown
This is an short example of using 'pPrint' from "Text.Pretty.Simple" to
pretty-print a Haskell data type.
-}
module Main where
import Text.Pretty.Simple (pPrint)
import Example.Data (bar)
main :: IO ()
main = do
putStrLn "\nThe following normal \"print\" output:\n"
print bar
putStrLn "\ngets turned into this (using \"Text.Pretty.Simple.pPrint\"):\n"
pPrint bar
pretty-simple-4.1.4.0/example/Example/ 0000755 0000000 0000000 00000000000 07346545000 015713 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/example/Example/Data.hs 0000644 0000000 0000000 00000002443 07346545000 017123 0 ustar 00 0000000 0000000 {-# LANGUAGE DeriveDataTypeable #-}
{- |
Module : Example.Data
Copyright : Dennis Gosnell 2017
License : BSD3
Maintainer : Dennis Gosnell (cdep.illabout@gmail.com)
Stability : experimental
Portability : unknown
This module contains some data types and values that users can use to play
around with pretty-simple.
These data types are also use in the two example programs, as well as the
benchmark for pretty-simple.
Most users should use 'foo' or 'bar'. 'baz' is an extremely large data type,
only used in the benchmark.
-}
module Example.Data where
import Data.Data (Data)
import Data.Typeable (Typeable)
data Foo = Foo
{ foo1 :: Integer
, foo2 :: [String]
, foo3 :: Double
} deriving (Data, Eq, Read, Show, Typeable)
data Bar = Bar
{ bar1 :: Integer
, bar2 :: [Foo]
, bar3 :: Double
} deriving (Data, Eq, Read, Show, Typeable)
data Baz = Baz
{ baz1 :: Bar
, baz2 :: [Baz]
} deriving (Data, Eq, Read, Show, Typeable)
foo :: Foo
foo = Foo 3 fooList 3.3
bar :: Bar
bar = Bar 10 (replicate 1 foo) 10.55
bazLevel1 :: Baz
bazLevel1 = Baz bar []
bazLevel2 :: Baz
bazLevel2 = Baz bar $ replicate 50 bazLevel1
baz :: Baz
baz = Baz bar $ replicate 30 bazLevel2
fooList :: [String]
fooList =
[ "hello"
, "goodbye"
, "dog"
, "cat"
, "fox"
, "beaver"
]
pretty-simple-4.1.4.0/example/ExampleJSON.hs 0000644 0000000 0000000 00000003525 07346545000 016746 0 ustar 00 0000000 0000000 {-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Copyright : Dennis Gosnell 2017
License : BSD3
Maintainer : Dennis Gosnell (cdep.illabout@gmail.com)
Stability : experimental
Portability : unknown
This is an short example of using 'pString' from "Text.Pretty.Simple" to
pretty-print JSON.
-}
module Main where
import Data.Aeson (encode)
import Data.Aeson.TH (defaultOptions, deriveJSON)
import qualified Data.ByteString.Lazy as LByteString (ByteString, toStrict)
import Data.Text as Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as TextIO (putStrLn)
import qualified Data.Text.Lazy as LText (Text)
import qualified Data.Text.Lazy.IO as LTextIO (putStrLn)
import Text.Pretty.Simple (pString)
import Example.Data (Foo, Bar, bar)
$(deriveJSON defaultOptions ''Foo)
$(deriveJSON defaultOptions ''Bar)
main :: IO ()
main = do
putStrLn "\nThe following normal \"Data.Aeson.encode\" output:\n"
putLazyByteStringLn $ encode bar
putStrLn "\ngets turned into this (using \"Text.Pretty.Simple.pString\"):\n"
LTextIO.putStrLn . pString . lazyByteStringToString $ encode bar
-- | Convert a 'LByteString.ByteString' to a 'Text.Text' by utf8-encoding it.
lazyByteStringToText :: LByteString.ByteString -> Text.Text
lazyByteStringToText = decodeUtf8 . LByteString.toStrict
-- | Convert a 'LByteString.ByteString' to a 'String' by utf8-encoding it.
lazyByteStringToString :: LByteString.ByteString -> String
lazyByteStringToString = unpack . lazyByteStringToText
-- | Print a 'LByteString.ByteString' to the screen. Similar to 'putStrLn'.
putLazyByteStringLn :: LByteString.ByteString -> IO ()
putLazyByteStringLn = TextIO.putStrLn . lazyByteStringToText
-- | Print a 'LText.Text' to the screen. Similar to 'putStrLn'.
putLazyTextLn :: LText.Text -> IO ()
putLazyTextLn = LTextIO.putStrLn
pretty-simple-4.1.4.0/img/ 0000755 0000000 0000000 00000000000 07346545000 013441 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/img/pretty-simple-example-screenshot.png 0000644 0000000 0000000 00000035727 07346545000 022607 0 ustar 00 0000000 0000000 PNG
IHDR R -Rr bKGD pHYs tIME IDATxwx&l@ҤwTG}ņ Ղ`9*xP,@Q*"R
@ @@ FzydBP6s]{}2;p癲3""Rb.TDDA*" TDDA*" TDDA*" -[$&6%j3~XȄI(ٺ7͟[imxbb8yfi{ӲUK&N yZ>+1Q~Mm}"D֯K^y
`O]HَH/m݊gȰqwwT &55eKWGw{ED*]gФic^yu:k7DO ѶLcF1nX+eo|c2
8Ly4bbo>,\%m Ѯ]/=p|HCC[ŽO"<-} [K:|C_'&6; ЧooxKeɲEl }Ai6
Ͽ,?X̶ٰgf&wRs>|ݍF!LBC[W؊
moΤi?jC/.믥IƘf|ӷ7s>zzweg"ՍQ1d`f;vn5b0^F9=:1QFLl1 F݀F@@1FLlm[jio[cW
WWW >^}zb2X o~WP8Θ mE_[\!VTbb"yyyxyyU؊ܱ#i1;ةA
;@Oϻ\jժ>Aj2Թ#F 媫w Ϭb?\KZpt 8߈233=^beer즠mw܊_}}NB1rs
3
HzZ:˗`wYf vL ]pR?//"-fsη}s,]-l!بQ|+/M{GxD[9qd3juü[D$''C˘t+ n&"څsaWZNxD[bw9\gk Obg_`w
tԁG! cpQ, :uO=b
ҽcqPkW=0~=#';Cb̗ u҉(W
Z]_7ld0ec+rfZ ;{Ə9
G,gC1塿+bz
"%T)kkn } ēKX<ҴWXd)+? #>Ã?ªmvlf,N:ͼ?Ͼ "Ti*t܄6M=2ݏTD:ڋ(HEDjS>hD*" QD%iɝwGZ |zVDbցvm:ҿ y=L&OW=+"
RgӉ;}NH6 ŊTi!773!jʕ" =/ d2K;3٧h \9TUj''H~kIV 1::wFDX":UJq 9\r ʕ"1LЫwg4 +Wz{{Sǻ}ʕ"g ߷TRD4"`YYY~hrm\)"՝/"RYF""
RQ(HED""
RQTZ5SШxzBt4sӳiކ/.]Gt@ulf=eJ.;h9i\3כ߸~yiѢ<L#4c={{M7sOvwƛnmx[nNrssXCCttX ]YDZÀA֩S)݇a4mF!Wh6\-_~ucK3eV՟W!
cS{YmOx{{r*X%`!sO?ϧ̰CK"elr)leɲEl }Aiji];cۣvhUlF#H_Khhk?:45? (+*TCC[pї}wapC :9u:wKJ\I[Yn%~$$ c|އdddhDZիg77ֲLJsѯ Ȼd2#Sp);cv1gJ. L{sߤ0 [nyVS 6uwΘ]~UծmN^=/5[3glgԩ]_x
l6ӤIc3O?WgZLN:v@P@j vYn:
P]디T !,_'N>_pt(Hk+O#T|9 U6 QT+1ݴYSvuxi&X,N ?Qf a
[mHW>}`XHN-Gl .. 0(ZM!ZXMj#;LC{ؽ+֡2miid"11LۊFGn.@d$x#4mZfn>{ĂϾ0 ةGA۱آT~
:u䉧 tT+1!=-+ͷw}O{6
qɲbyHH8UO=FRR?]ǑѱSG }ܶ v%j+
Қ#5R28sfZ ;{Ə)Ko01
˳0iôw?q_f\37̓<<6{vw%z
sm#|s^۵s7>DmEAZ3ܳ yK;%rj{j'E椧gKysT[y|B3} 4kޔt֬^ˬ*_>#Ճ
0qaV,_8VjpPӪuwz8tARͻ ̙ ji+HҲ%|ޏTDfH>o߾2ihD*""(HED""
RqJ6F1q \u|Ymѿ xtL
(Qwv7no>z(Q"dfd%3Asy 3'NҼE3n u:ID#R'_pδnⵙoi
oNшjlUD %9E+GD#ʯ2VV/|S/iMV*;Xt7$R =Jhƈ2|9>##&6hѢ}Z͍W^nD]al߹ň?.y>YYY}XUQY[7Q`RbVmٲs?~tc,N.,UDE5Ŭ"zm# Vq\7$rT.rw/L:M瞽< >|\bcjUDw"++SN3O/j+j fX
<< 2N ":%<V+̙/"
Ru)Nep־h^DD#R(HED""T!V`̒~ɲE4m?A֬^шTDD#R9ˬYIXQvevIff:VD#RHswwc1\=t0AAdffmvf["
RL&oΞp?___K ]uhbc8VDRmWbb soo>ٝӧ8^vɐxxx0KVDA*5F=5
6L 'D.wwۊh^;k 0m ;}zѠA} wFRcL& 93mERc$ =@9Lwss#4,|NшTj 0o>xo.GcXHKKڹDmE#Ċk/"
J{=ѮF""TDDA*" >&)s75M:r⏤?f5oN xhuiK8r8!W
/Gt@ulf=eJӋ#>z8v8+#yݹӥ ;ڿ SLJޙOfLg Uo0qF5f4=zඛ}Ru fч faBye2/2ʪϔ̢o'r 7\Wibjj}={#5%6<ӄÂOІ g$aI(@K;MUd_
mE_:L{Yg #U5(HJiE1*U=-DqOž>'(k;Lwww3n4b{;GpHvW Z7zT QE48$y璖Ƅ{& #uԶ{U>UD5O搕͘IMM-iT YEi| .d aaO;k7atﾐu8^zk7mz'
!4' nnu
fFnlUSBT*qi&o,֙
ڶV:'&n奰{df eߵݻk^~? ! XIDATcmK6 o= Z՚[i* #`f nnH)))zt-9yC $g*x:ضhj"VRSc堋whsOg2_Ӥ(`L[~T
TQ&Kન
mmau3˼}l..f7 IF# }[ >Bo
yy)ʠ p鬶^әYY m>>|L2첷O:jh|}ѦͳwB+jD*R̚7 ^Z!oiVN,mmNXS~juCr煶XIJ`͚lMgq mS%u괤MgOZ[쨴0Dg뇒UH{'AڭQwo_{ ،ɗ6{aXؼf{ 96(hzxnf_yz?2}6 9%7ݽ>Y_+W9ok ( χ
y:3>>xx4 77琚uo[jL.xxR7K'O?ĉumz>Μٍo[f_22}\]=gy 5
GG_g0^^X,i :[ރ՚ [ f ; $#CL O~~nn~><It#>ҏ4"lU"#aԋHݻCH CrrNU. 4vBfa-kp%AucRsBj9s*{^F``<{چ(謽d]
Nb,[U^mlE/tjj'>>m?ge7ZoJڵH4H˖gCRINƾ}op* Vk.IIuΜ٥ 1RTDJY{.v~Q~
goD#RHEػ n*k TDDA*" TDDA*" TDDA*"R]6zR3w=HED.шTDDA*" QT.aAH6h
:F"2z2H k:Dj ]$e&3ī i \7P"8#>+͉kHIdg6,6-QnRTd 7ﳏH }z)R鬽)WfD`X0<\= }f7RF"jX }D7v2uMkh$ 3d_HMRLjTB]}) \^:VêNڋ8 ԼT(HEDDA*AZ4HIxнnw tIjlR4:}0%"
R'X 9;PHo6(HED""UN60K-i}fZuF""J9ک'HED4"Jݍpɶۙ;goۊT7 )qҵSO\5Ã)_"
R1z oa/dffrp>>,|||*34c={߷_ x5i71ѫ|{ ʮ[@7{> 0 g-5 ;uLJXW_'++>SrR2Uk0?p]ªYݻԔTڄOښn >BT*3?%e
.4U!
cS{Y
_aZԶlڵo UJebeV~/45 }0wfٟ}TUO]Fz6RT ;L&ޜ=ˡ/{T=ж塸?Y>Lӓv<Kk#-^] e)V)ǚC_y'a _`ӊFUѕW
"&6߷mÏ?S emH5"ՃN~p( qqgW2'O|B*ҠA}VU+$"w-7ξ}q5J͙0i )7 ww\M>sʳ0iôw?m>bu CVf6cF'55˪cՏFR-gѦ͚;ǒH|s`י]UEe}ҹ뎱:uZUDEA*RbUEF@@@ <}7hh^xz ㏩y"*nZ"ebfU{t䇄 m:E4"qFgxzoW! qVz &!]{шTDDA*" QT|`fOjQQQ0uT 6lHJJ
)))ޮEx7
+ngGpj[ @ߵ> ~Jԝ,\hx;v|LڊF""TwnntAACX2Gf |=k7j%%e;͑#_Wrږ BBn˫1K;
R) :8g4!!?? M˖>Nl촂 c_i;^Fsf _߈"
F``6mG+U?h^DJ,77 a ݱ!-a& ;f+ 庌m>m JXT߲e,yyg4")'WwaHIN~~&Yȑذj~?k$φ
C8vlKڿzm^^*k?g ՚G^^
ǎ-cھQsMR#Rs AZhRxh^DD#RHED"" Q(HEjP=[/UEkժ@s<<տ
RTD:ݟD.uоL RV Zz +#GLжx{&3v=Lsh` KzAǰXhР?} .]mhڵ1d _Ά
C,ŭZZfE})m)w^D0HY0,=+ybFRSmG6^a4
%He3kll{\ziaX9q"`9aaOa6Ѫ}Wș
bI')鏂n4k6ُ6mzmNԩӒ6mO?ujm϶/ JV!Re˟inF~~0`3 GhP'_ X%BaaL۠!9Gj Sfa녊^Tlaذsȗl|Cw #fMsl\Ijk 0 ? +mOpр Cj
}o{5Ç`2HZX,i9a6`22rd$яpJ?ӈTj.VS/"u
!!
9Ux UYÕՉJ n Q̩{VڄHÆ#
FtѢx(6.jRu)8l :To xBнꪝO\j)i^"i` -[N߿#
K%9ycK|Z$%֭8sfTDDOHED""
R*MgfRE})̞HED"a^wuTDD""
RTDD""
RTDD""
RHuITmD4"8TNDD#RTDDA*""
Rx
#aX b۠m5|>Q8l2F#yc1tv_H&Ħ2p@uhD*x6'n:D"%i۰LڴDA*R
KA*
R쏛:D"ڗ>"}2ISHR<\=1aAp ` Z?H#\abX0YjY5
ad ;y#)7I #
R u Zsy}X
:Ek/ /W/ RR \khT"%BH &9tIJmX0>ô(HE`1,$$:f9C "5$"RJ:F*" QTi:TIhفӾ }шTDDA* ..3xa22-!TDD""
RTDD""
RTDD""
RCѫhD*"R-F""
RTDDJf\4` L $'曐-@D4"uF-_ {[ukGm:vӎ m}}EDAZ"YY\DDAZO iF>>`6k ĉﯭ@DJݴ vmmھ}pDD# b.7t+)5W\a `\HIі "
֬<#UDDNiLZ" -OOۿYIj־u?ҢEDA|ۍ
_k_Dʄ1n$" Q(HED"" Q(HED"" Q(HEDjNc4hn IENDB` pretty-simple-4.1.4.0/pretty-simple.cabal 0000644 0000000 0000000 00000007004 07346545000 016470 0 ustar 00 0000000 0000000 name: pretty-simple
version: 4.1.4.0
synopsis: pretty printer for data types with a 'Show' instance.
description: Please see .
homepage: https://github.com/cdepillabout/pretty-simple
license: BSD3
license-file: LICENSE
author: Dennis Gosnell
maintainer: cdep.illabout@gmail.com
copyright: 2017-2019 Dennis Gosnell
category: Text
build-type: Simple
extra-source-files: CHANGELOG.md
, README.md
, img/pretty-simple-example-screenshot.png
cabal-version: >=1.10
flag buildexe
description: Build an small command line program that pretty-print anything from stdin.
default: True
flag buildexample
description: Build a small example program showing how to use the pPrint function
default: False
library
hs-source-dirs: src
exposed-modules: Debug.Pretty.Simple
, 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.Printer
build-depends: base >= 4.8 && < 5
, containers
, mtl >= 2.2
, prettyprinter >= 1.7.0
, prettyprinter-ansi-terminal >= 1.1.2
, text >= 1.2
, transformers >= 0.4
default-language: Haskell2010
ghc-options: -Wall
other-extensions: TemplateHaskell
executable pretty-simple
main-is: Main.hs
other-modules: Paths_pretty_simple
hs-source-dirs: app
build-depends: base
, pretty-simple
, text
, optparse-applicative
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
if flag(buildexe)
buildable: True
else
buildable: False
executable pretty-simple-example
main-is: Example.hs
other-modules: Example.Data
hs-source-dirs: example
build-depends: base
, pretty-simple
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
if flag(buildexample)
buildable: True
else
buildable: False
executable pretty-simple-json-example
main-is: ExampleJSON.hs
other-modules: Example.Data
hs-source-dirs: example
build-depends: base
, aeson
, bytestring
, pretty-simple
, text
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
if flag(buildexample)
buildable: True
else
buildable: False
benchmark pretty-simple-bench
type: exitcode-stdio-1.0
main-is: Bench.hs
other-modules: Example.Data
hs-source-dirs: bench
, example
build-depends: base
, criterion
, pretty-simple
, text
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
source-repository head
type: git
location: git@github.com:cdepillabout/pretty-simple.git
pretty-simple-4.1.4.0/src/Debug/Pretty/ 0000755 0000000 0000000 00000000000 07346545000 015771 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/src/Debug/Pretty/Simple.hs 0000644 0000000 0000000 00000052235 07346545000 017565 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-|
Module : Debug.Pretty.Simple
Copyright : (c) Dennis Gosnell, 2017
License : BSD-style (see LICENSE file)
Maintainer : cdep.illabout@gmail.com
Stability : experimental
Portability : POSIX
This module contains the same functionality with Prelude's "Debug.Trace" module,
with pretty printing the debug strings.
Warning: This module also shares the same unsafety of "Debug.Trace" module.
-}
module Debug.Pretty.Simple
( -- * Trace with color on dark background
-- This determines whether to print in color by looking at whether 'stderr'
-- is a TTY device.
pTrace
, pTraceId
, pTraceShow
, pTraceShowId
, pTraceIO
, pTraceM
, pTraceShowM
, pTraceStack
, pTraceEvent
, pTraceEventIO
, pTraceMarker
, pTraceMarkerIO
, pTraceWith
, pTraceShowWith
-- * Trace forcing color
, pTraceForceColor
, pTraceIdForceColor
, pTraceShowForceColor
, pTraceShowIdForceColor
, pTraceMForceColor
, pTraceShowMForceColor
, pTraceStackForceColor
, pTraceEventForceColor
, pTraceEventIOForceColor
, pTraceMarkerForceColor
, pTraceMarkerIOForceColor
, pTraceIOForceColor
-- * Trace without color
, pTraceNoColor
, pTraceIdNoColor
, pTraceShowNoColor
, pTraceShowIdNoColor
, pTraceMNoColor
, pTraceShowMNoColor
, pTraceStackNoColor
, pTraceEventNoColor
, pTraceEventIONoColor
, pTraceMarkerNoColor
, pTraceMarkerIONoColor
, pTraceIONoColor
-- * Trace With 'OutputOptions'
, pTraceOpt
, pTraceIdOpt
, pTraceShowOpt
, pTraceShowIdOpt
, pTraceOptIO
, pTraceOptM
, pTraceShowOptM
, pTraceStackOpt
, pTraceEventOpt
, pTraceEventOptIO
, pTraceMarkerOpt
, pTraceMarkerOptIO
) where
import Control.Monad ((<=<))
import Data.Text.Lazy (Text, unpack)
import Debug.Trace
(trace, traceEvent, traceEventIO, traceIO, traceM, traceMarker,
traceMarkerIO, traceStack)
import System.IO (stderr)
import System.IO.Unsafe (unsafePerformIO)
import Text.Pretty.Simple
(CheckColorTty(..), OutputOptions, pStringOpt,
defaultOutputOptionsNoColor, defaultOutputOptionsDarkBg)
import Text.Pretty.Simple.Internal (hCheckTTY)
#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
{-|
The 'pTraceIO' function outputs the trace message from the IO monad.
This sequences the output with respect to other IO actions.
@since 2.0.1.0
-}
{-# WARNING pTraceIO "'pTraceIO' remains in code" #-}
pTraceIO :: String -> IO ()
pTraceIO = pTraceOptIO CheckColorTty defaultOutputOptionsDarkBg
{-|
The 'pTrace' function pretty prints the trace message given as its first
argument, before returning the second argument as its result.
For example, this returns the value of @f x@ but first outputs the message.
> pTrace ("calling f with x = " ++ show x) (f x)
The 'pTrace' function should /only/ be used for debugging, or for monitoring
execution. The function is not referentially transparent: its type indicates
that it is a pure function but it has the side effect of outputting the
trace message.
@since 2.0.1.0
-}
{-# WARNING pTrace "'pTrace' remains in code" #-}
pTrace :: String -> a -> a
pTrace = pTraceOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
Like 'pTrace' but returns the message instead of a third value.
@since 2.0.1.0
-}
{-# WARNING pTraceId "'pTraceId' remains in code" #-}
pTraceId :: String -> String
pTraceId = pTraceIdOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
Like 'pTrace', but uses 'show' on the argument to convert it to a 'String'.
This makes it convenient for printing the values of interesting variables or
expressions inside a function. For example here we print the value of the
variables @x@ and @z@:
> f x y =
> pTraceShow (x, z) $ result
> where
> z = ...
> ...
@since 2.0.1.0
-}
{-# WARNING pTraceShow "'pTraceShow' remains in code" #-}
pTraceShow :: (Show a) => a -> b -> b
pTraceShow = pTraceShowOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
Like 'pTraceShow' but returns the shown value instead of a third value.
@since 2.0.1.0
-}
{-# WARNING pTraceShowId "'pTraceShowId' remains in code" #-}
pTraceShowId :: (Show a) => a -> a
pTraceShowId = pTraceShowIdOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
Like 'pTrace' but returning unit in an arbitrary 'Applicative' context. Allows
for convenient use in do-notation.
Note that the application of 'pTraceM' is not an action in the 'Applicative'
context, as 'pTraceIO' is in the 'IO' type. While the fresh bindings in the
following example will force the 'traceM' expressions to be reduced every time
the @do@-block is executed, @traceM "not crashed"@ would only be reduced once,
and the message would only be printed once. If your monad is in 'MonadIO',
@liftIO . pTraceIO@ may be a better option.
> ... = do
> x <- ...
> pTraceM $ "x: " ++ show x
> y <- ...
> pTraceM $ "y: " ++ show y
@since 2.0.1.0
-}
{-# WARNING pTraceM "'pTraceM' remains in code" #-}
#if __GLASGOW_HASKELL__ < 800
pTraceM :: (Monad f) => String -> f ()
#else
pTraceM :: (Applicative f) => String -> f ()
#endif
pTraceM = pTraceOptM CheckColorTty defaultOutputOptionsDarkBg
{-|
Like 'pTraceM', but uses 'show' on the argument to convert it to a 'String'.
> ... = do
> x <- ...
> pTraceShowM $ x
> y <- ...
> pTraceShowM $ x + y
@since 2.0.1.0
-}
{-# WARNING pTraceShowM "'pTraceShowM' remains in code" #-}
#if __GLASGOW_HASKELL__ < 800
pTraceShowM :: (Show a, Monad f) => a -> f ()
#else
pTraceShowM :: (Show a, Applicative f) => a -> f ()
#endif
pTraceShowM = pTraceShowOptM CheckColorTty defaultOutputOptionsDarkBg
{-|
like 'pTrace', but additionally prints a call stack if one is
available.
In the current GHC implementation, the call stack is only
available if the program was compiled with @-prof@; otherwise
'pTraceStack' behaves exactly like 'pTrace'. Entries in the call
stack correspond to @SCC@ annotations, so it is a good idea to use
@-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically.
@since 2.0.1.0
-}
{-# WARNING pTraceStack "'pTraceStack' remains in code" #-}
pTraceStack :: String -> a -> a
pTraceStack = pTraceStackOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
The 'pTraceEvent' function behaves like 'trace' with the difference that
the message is emitted to the eventlog, if eventlog profiling is available
and enabled at runtime.
It is suitable for use in pure code. In an IO context use 'pTraceEventIO'
instead.
Note that when using GHC's SMP runtime, it is possible (but rare) to get
duplicate events emitted if two CPUs simultaneously evaluate the same thunk
that uses 'pTraceEvent'.
@since 2.0.1.0
-}
{-# WARNING pTraceEvent "'pTraceEvent' remains in code" #-}
pTraceEvent :: String -> a -> a
pTraceEvent = pTraceEventOpt CheckColorTty defaultOutputOptionsDarkBg
{-|
The 'pTraceEventIO' function emits a message to the eventlog, if eventlog
profiling is available and enabled at runtime.
Compared to 'pTraceEvent', 'pTraceEventIO' sequences the event with respect to
other IO actions.
@since 2.0.1.0
-}
{-# WARNING pTraceEventIO "'pTraceEventIO' remains in code" #-}
pTraceEventIO :: String -> IO ()
pTraceEventIO = pTraceEventOptIO CheckColorTty defaultOutputOptionsDarkBg
-- | The 'pTraceMarker' function emits a marker to the eventlog, if eventlog
-- profiling is available and enabled at runtime. The @String@ is the name of
-- the marker. The name is just used in the profiling tools to help you keep
-- clear which marker is which.
--
-- This function is suitable for use in pure code. In an IO context use
-- 'pTraceMarkerIO' instead.
--
-- Note that when using GHC's SMP runtime, it is possible (but rare) to get
-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk
-- that uses 'pTraceMarker'.
--
-- @since 2.0.1.0
{-# WARNING pTraceMarker "'pTraceMarker' remains in code" #-}
pTraceMarker :: String -> a -> a
pTraceMarker = pTraceMarkerOpt CheckColorTty defaultOutputOptionsDarkBg
-- | The 'pTraceMarkerIO' function emits a marker to the eventlog, if eventlog
-- profiling is available and enabled at runtime.
--
-- Compared to 'pTraceMarker', 'pTraceMarkerIO' sequences the event with respect
-- to other IO actions.
--
-- @since 2.0.1.0
{-# WARNING pTraceMarkerIO "'pTraceMarkerIO' remains in code" #-}
pTraceMarkerIO :: String -> IO ()
pTraceMarkerIO = pTraceMarkerOptIO CheckColorTty defaultOutputOptionsDarkBg
-- | The 'pTraceWith' function pretty prints the result of
-- applying @f to @a and returns back @a
--
-- @since ?
{-# WARNING pTraceWith "'pTraceWith' remains in code" #-}
pTraceWith :: (a -> String) -> a -> a
pTraceWith f a = pTrace (f a) a
-- | The 'pTraceShowWith' function similar to 'pTraceWith' except that
-- @f can return any type that implements Show
--
-- @since ?
{-# WARNING pTraceShowWith "'pTraceShowWith' remains in code" #-}
pTraceShowWith :: Show b => (a -> b) -> a -> a
pTraceShowWith f = pTraceWith (show . f)
------------------------------------------
-- Helpers
------------------------------------------
{-# WARNING pStringTTYOptIO "'pStringTTYOptIO' remains in code" #-}
pStringTTYOptIO :: CheckColorTty -> OutputOptions -> String -> IO Text
pStringTTYOptIO checkColorTty outputOptions v = do
realOutputOpts <-
case checkColorTty of
CheckColorTty -> hCheckTTY stderr outputOptions
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
------------------------------------------
-- 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
pTraceMForceColor :: (Applicative f) => String -> f ()
#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
pTraceShowMForceColor :: (Show a, Applicative f) => a -> f ()
#endif
pTraceShowMForceColor =
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
------------------------------------------
-- Traces without color
------------------------------------------
-- | Similar to 'pTrace', but without color.
--
-- >>> pTraceNoColor "wow" ()
-- wow
-- ()
--
-- @since 2.0.2.0
{-# WARNING pTraceNoColor "'pTraceNoColor' remains in code" #-}
pTraceNoColor :: String -> a -> a
pTraceNoColor = pTraceOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceId', but without color.
--
-- >>> pTraceIdNoColor "(1, 2, 3)" `seq` ()
-- ( 1
-- , 2
-- , 3
-- )
-- ()
--
-- @since 2.0.2.0
{-# WARNING pTraceIdNoColor "'pTraceIdNoColor' remains in code" #-}
pTraceIdNoColor :: String -> String
pTraceIdNoColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceShow', but without color.
--
-- >>> import qualified Data.Map as M
-- >>> pTraceShowNoColor (M.fromList [(1, True)]) ()
-- fromList
-- [
-- ( 1
-- , True
-- )
-- ]
-- ()
--
-- @since 2.0.2.0
{-# WARNING pTraceShowNoColor "'pTraceShowNoColor' remains in code" #-}
pTraceShowNoColor :: (Show a) => a -> b -> b
pTraceShowNoColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceShowId', but without color.
--
-- >>> import qualified Data.Map as M
-- >>> pTraceShowIdNoColor (M.fromList [(1, True)]) `seq` ()
-- fromList
-- [
-- ( 1
-- , True
-- )
-- ]
-- ()
--
-- @since 2.0.2.0
{-# WARNING pTraceShowIdNoColor "'pTraceShowIdNoColor' remains in code" #-}
pTraceShowIdNoColor :: (Show a) => a -> a
pTraceShowIdNoColor =
pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceM', but without color.
--
-- >>> pTraceMNoColor "wow"
-- wow
--
-- @since 2.0.2.0
{-# WARNING pTraceMNoColor "'pTraceMNoColor' remains in code" #-}
#if __GLASGOW_HASKELL__ < 800
pTraceMNoColor :: (Monad f) => String -> f ()
#else
pTraceMNoColor :: (Applicative f) => String -> f ()
#endif
pTraceMNoColor = pTraceOptM NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceShowM', but without color.
--
-- >>> pTraceShowMNoColor [1,2,3]
-- [ 1
-- , 2
-- , 3
-- ]
--
-- @since 2.0.2.0
{-# WARNING pTraceShowMNoColor "'pTraceShowMNoColor' remains in code" #-}
#if __GLASGOW_HASKELL__ < 800
pTraceShowMNoColor :: (Show a, Monad f) => a -> f ()
#else
pTraceShowMNoColor :: (Show a, Applicative f) => a -> f ()
#endif
pTraceShowMNoColor = pTraceShowOptM NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceStack', but without color.
--
-- >>> pTraceStackNoColor "wow" () `seq` ()
-- wow
-- ()
--
-- @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
-- | 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
-- | Similar to 'pTraceMarkerIO', but without color.
--
-- @since 2.0.2.0
{-# WARNING pTraceMarkerIONoColor "'pTraceMarkerIONoColor' remains in code" #-}
pTraceMarkerIONoColor :: String -> IO ()
pTraceMarkerIONoColor =
pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pTraceIO', but without color.
--
-- >>> pTraceIONoColor "(1, 2, 3)"
-- ( 1
-- , 2
-- , 3
-- )
--
-- @since 2.0.2.0
{-# WARNING pTraceIONoColor "'pTraceIONoColor' remains in code" #-}
pTraceIONoColor :: String -> IO ()
pTraceIONoColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsNoColor
------------------------------------------
-- Traces that take options
------------------------------------------
{-|
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
{-|
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
{-|
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
{-|
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
{-|
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
pTraceOptM ::
(Applicative f) => CheckColorTty -> OutputOptions -> String -> f ()
#endif
pTraceOptM checkColorTty outputOptions string =
trace (unpack $ pStringTTYOpt checkColorTty outputOptions string) $ pure ()
{-|
Like 'pTraceShowM' but takes OutputOptions.
-}
{-# WARNING pTraceShowOptM "'pTraceShowOptM' remains in code" #-}
#if __GLASGOW_HASKELL__ < 800
pTraceShowOptM ::
(Show a, Monad f) => CheckColorTty -> OutputOptions -> a -> f ()
#else
pTraceShowOptM ::
(Show a, Applicative f) => CheckColorTty -> OutputOptions -> a -> f ()
#endif
pTraceShowOptM checkColorTty outputOptions =
traceM . unpack . pShowTTYOpt checkColorTty outputOptions
{-|
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
{-|
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
{-|
Like 'pTraceEventIO' but takes OutputOptions.
-}
{-# WARNING pTraceEventOptIO "'pTraceEventOptIO' remains in code" #-}
pTraceEventOptIO :: CheckColorTty -> OutputOptions -> String -> IO ()
pTraceEventOptIO checkColorTty outputOptions =
traceEventIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions
{-|
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
{-|
Like 'pTraceMarkerIO' but takes OutputOptions.
-}
{-# WARNING pTraceMarkerOptIO "'pTraceMarkerOptIO' remains in code" #-}
pTraceMarkerOptIO :: CheckColorTty -> OutputOptions -> String -> IO ()
pTraceMarkerOptIO checkColorTty outputOptions =
traceMarkerIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions
pretty-simple-4.1.4.0/src/Text/Pretty/ 0000755 0000000 0000000 00000000000 07346545000 015667 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/src/Text/Pretty/Simple.hs 0000644 0000000 0000000 00000053435 07346545000 017466 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Text.Pretty.Simple
Copyright : (c) Dennis Gosnell, 2016
License : BSD-style (see LICENSE file)
Maintainer : cdep.illabout@gmail.com
Stability : experimental
Portability : POSIX
This module contains the functions 'pPrint', 'pShow', and 'pString' for
pretty-printing any Haskell data type with a 'Show' instance.
'pPrint' is the main go-to function when debugging Haskell code. 'pShow' and
'pString' are slight variations on 'pPrint'.
'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.
'pPrint' and 'pPrintLightBg' will intelligently decide whether or not to use
ANSI escape codes for coloring depending on whether or not the output is
a TTY. This works in most cases. If you want to force color output,
you can use the 'pPrintForceColor' or 'pPrintForceColorLightBg' functions.
The variations 'pPrintOpt', 'pShowOpt', and 'pStringOpt' are used when
specifying the 'OutputOptions'. Most users can ignore these.
There are a few other functions available that are similar to 'pPrint'.
See the Examples section at the end of this module for examples of acutally
using 'pPrint'. See the
for examples of printing in color.
-}
module Text.Pretty.Simple
(
-- * Output with color on dark background
pPrint
, pHPrint
, pPrintString
, pHPrintString
, pPrintForceColor
, pHPrintForceColor
, pPrintStringForceColor
, pHPrintStringForceColor
, pShow
, pString
-- * Aliases for output with color on dark background
, pPrintDarkBg
, pHPrintDarkBg
, pPrintStringDarkBg
, pHPrintStringDarkBg
, pPrintForceColorDarkBg
, pHPrintForceColorDarkBg
, pPrintStringForceColorDarkBg
, pHPrintStringForceColorDarkBg
, pShowDarkBg
, pStringDarkBg
-- * Output with color on light background
, pPrintLightBg
, pHPrintLightBg
, pPrintStringLightBg
, pHPrintStringLightBg
, pPrintForceColorLightBg
, pHPrintForceColorLightBg
, pPrintStringForceColorLightBg
, pHPrintStringForceColorLightBg
, pShowLightBg
, pStringLightBg
-- * Output with NO color
, pPrintNoColor
, pHPrintNoColor
, pPrintStringNoColor
, pHPrintStringNoColor
, pShowNoColor
, pStringNoColor
-- * Output With 'OutputOptions'
, pPrintOpt
, pHPrintOpt
, pPrintStringOpt
, pHPrintStringOpt
, pShowOpt
, pStringOpt
-- * 'OutputOptions'
, OutputOptions(..)
, StringOutputStyle(..)
, defaultOutputOptionsDarkBg
, defaultOutputOptionsLightBg
, defaultOutputOptionsNoColor
, CheckColorTty(..)
-- * 'ColorOptions'
, defaultColorOptionsDarkBg
, defaultColorOptionsLightBg
, ColorOptions(..)
, Style(..)
, Color(..)
, Intensity(..)
, colorNull
-- * Examples
-- $examples
) 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 Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text.Lazy (Text)
import Prettyprinter (SimpleDocStream)
import Prettyprinter.Render.Terminal
(Color (..), Intensity(Vivid,Dull), AnsiStyle,
renderLazy, renderIO)
import System.IO (Handle, stdout, hPutStrLn)
import Text.Pretty.Simple.Internal
(ColorOptions(..), Style(..), CheckColorTty(..),
OutputOptions(..), StringOutputStyle(..),
convertStyle, colorNull,
defaultColorOptionsDarkBg, defaultColorOptionsLightBg,
defaultOutputOptionsDarkBg, defaultOutputOptionsLightBg,
defaultOutputOptionsNoColor, hCheckTTY, layoutString)
-- $setup
-- >>> import Data.Text.Lazy (unpack)
----------------------------------------------------------
-- functions for printing in color to a dark background --
----------------------------------------------------------
-- | Pretty-print any data type that has a 'Show' instance.
--
-- If you've never seen 'MonadIO' before, you can think of this function as
-- having the following type signature:
--
-- @
-- pPrint :: Show a => a -> IO ()
-- @
--
-- This function will only use colors if it detects it's printing to a TTY.
--
-- This function is for printing to a dark background. Use 'pPrintLightBg' for
-- printing to a terminal with a light background. Different colors are used.
--
-- Prints to 'stdout'. Use 'pHPrint' to print to a different 'Handle'.
--
-- >>> pPrint [Just (1, "hello")]
-- [ Just
-- ( 1
-- , "hello"
-- )
-- ]
pPrint :: (MonadIO m, Show a) => a -> m ()
pPrint = pPrintOpt CheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrint', but take a 'Handle' to print to.
--
-- >>> pHPrint stdout [Just (1, "hello")]
-- [ Just
-- ( 1
-- , "hello"
-- )
-- ]
pHPrint :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrint = pHPrintOpt CheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrint', but the first argument is a 'String' representing a
-- data type that has already been 'show'ed.
--
-- >>> pPrintString $ show [ Just (1, "hello"), Nothing ]
-- [ Just
-- ( 1
-- , "hello"
-- )
-- , Nothing
-- ]
pPrintString :: MonadIO m => String -> m ()
pPrintString = pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pHPrintString', but take a 'Handle' to print to.
--
-- >>> pHPrintString stdout $ show [ Just (1, "hello"), Nothing ]
-- [ Just
-- ( 1
-- , "hello"
-- )
-- , Nothing
-- ]
pHPrintString :: MonadIO m => Handle -> String -> m ()
pHPrintString = pHPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrint', but print in color regardless of whether the output
-- goes to a TTY or not.
--
-- See 'pPrint' for an example of how to use this function.
pPrintForceColor :: (MonadIO m, Show a) => a -> m ()
pPrintForceColor = pPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrintForceColor', but take a 'Handle' to print to.
--
-- See 'pHPrint' for an example of how to use this function.
pHPrintForceColor :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintForceColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrintString', but print in color regardless of whether the
-- output goes to a TTY or not.
--
-- See 'pPrintString' for an example of how to use this function.
pPrintStringForceColor :: MonadIO m => String -> m ()
pPrintStringForceColor = pPrintStringOpt NoCheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pHPrintString', but print in color regardless of whether the
-- output goes to a TTY or not.
--
-- See 'pHPrintString' for an example of how to use this function.
pHPrintStringForceColor :: MonadIO m => Handle -> String -> m ()
pHPrintStringForceColor = pHPrintStringOpt NoCheckColorTty defaultOutputOptionsDarkBg
-- | Similar to 'pPrintForceColor', 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.
--
-- See 'pShowNoColor' for an example of how to use this function.
pShow :: Show a => a -> Text
pShow = pShowOpt defaultOutputOptionsDarkBg
-- | Similar to 'pShow', but the first argument is a 'String' representing a
-- data type that has already been 'show'ed.
--
-- This will work on any 'String' that is similar to a Haskell data type. The
-- 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.
--
-- See 'pStringNoColor' for an example of how to use this function.
pString :: String -> Text
pString = pStringOpt defaultOutputOptionsDarkBg
--------------------------------------------------------
-- aliases for printing in color to a dark background --
--------------------------------------------------------
-- | Alias for 'pPrint'.
pPrintDarkBg :: (MonadIO m, Show a) => a -> m ()
pPrintDarkBg = pPrint
-- | Alias for 'pHPrint'.
pHPrintDarkBg :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintDarkBg = pHPrint
-- | Alias for 'pPrintString'.
pPrintStringDarkBg :: MonadIO m => String -> m ()
pPrintStringDarkBg = pPrintString
-- | Alias for 'pHPrintString'.
pHPrintStringDarkBg :: MonadIO m => Handle -> String -> m ()
pHPrintStringDarkBg = pHPrintString
-- | Alias for 'pPrintForceColor'.
pPrintForceColorDarkBg :: (MonadIO m, Show a) => a -> m ()
pPrintForceColorDarkBg = pPrintForceColor
-- | Alias for 'pHPrintForceColor'.
pHPrintForceColorDarkBg :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintForceColorDarkBg = pHPrintForceColor
-- | Alias for 'pPrintStringForceColor'.
pPrintStringForceColorDarkBg :: MonadIO m => String -> m ()
pPrintStringForceColorDarkBg = pPrintStringForceColor
-- | Alias for 'pHPrintStringForceColor'.
pHPrintStringForceColorDarkBg :: MonadIO m => Handle -> String -> m ()
pHPrintStringForceColorDarkBg = pHPrintStringForceColor
-- | 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 CheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pHPrintDarkBg', but for printing to a light background.
pHPrintLightBg :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintLightBg = pHPrintOpt CheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pPrintStringDarkBg', but for printing to a light background.
pPrintStringLightBg :: MonadIO m => String -> m ()
pPrintStringLightBg = pPrintStringOpt CheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pHPrintStringDarkBg', but for printing to a light background.
pHPrintStringLightBg :: MonadIO m => Handle -> String -> m ()
pHPrintStringLightBg = pHPrintStringOpt CheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pPrintForceColorDarkBg', but for printing to a light
-- background.
pPrintForceColorLightBg :: (MonadIO m, Show a) => a -> m ()
pPrintForceColorLightBg = pPrintOpt NoCheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pHPrintForceColorDarkBg', but for printing to a light
-- background.
pHPrintForceColorLightBg :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintForceColorLightBg = pHPrintOpt NoCheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pPrintStringForceColorDarkBg', but for printing to a light
-- background.
pPrintStringForceColorLightBg :: MonadIO m => String -> m ()
pPrintStringForceColorLightBg = pPrintStringOpt NoCheckColorTty defaultOutputOptionsLightBg
-- | Just like 'pHPrintStringForceColorDarkBg', but for printing to a light
-- background.
pHPrintStringForceColorLightBg :: MonadIO m => Handle -> String -> m ()
pHPrintStringForceColorLightBg = pHPrintStringOpt NoCheckColorTty 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.
--
-- >>> pPrintNoColor $ Just ["hello", "bye"]
-- Just
-- [ "hello"
-- , "bye"
-- ]
pPrintNoColor :: (MonadIO m, Show a) => a -> m ()
pPrintNoColor = pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Like 'pPrintNoColor', but take a 'Handle' to determine where to print to.
--
-- >>> pHPrintNoColor stdout $ Just ["hello", "bye"]
-- Just
-- [ "hello"
-- , "bye"
-- ]
pHPrintNoColor :: (MonadIO m, Show a) => Handle -> a -> m ()
pHPrintNoColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Similar to 'pPrintString', but doesn't print in color. However, data types
-- will still be indented nicely.
--
-- >>> pPrintStringNoColor $ show $ Just ["hello", "bye"]
-- Just
-- [ "hello"
-- , "bye"
-- ]
pPrintStringNoColor :: MonadIO m => String -> m ()
pPrintStringNoColor = pPrintStringOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Like 'pPrintStringNoColor', but take a 'Handle' to determine where to print to.
--
-- >>> pHPrintStringNoColor stdout $ show $ Just ["hello", "bye"]
-- Just
-- [ "hello"
-- , "bye"
-- ]
pHPrintStringNoColor :: MonadIO m => Handle -> String -> m ()
pHPrintStringNoColor = pHPrintStringOpt NoCheckColorTty defaultOutputOptionsNoColor
-- | Like 'pShow', but without color.
--
-- >>> pShowNoColor [ Nothing, Just (1, "hello") ]
-- "[ Nothing\n, Just\n ( 1\n , \"hello\"\n )\n]"
pShowNoColor :: Show a => a -> Text
pShowNoColor = pShowOpt defaultOutputOptionsNoColor
-- | LIke 'pString', but without color.
--
-- >>> pStringNoColor $ show [1, 2, 3]
-- "[ 1\n, 2\n, 3\n]"
pStringNoColor :: String -> Text
pStringNoColor = pStringOpt defaultOutputOptionsNoColor
---------------------------------
-- functions that take options --
---------------------------------
-- | Similar to 'pPrint' but takes 'OutputOptions' to change how the
-- pretty-printing is done.
--
-- For example, 'pPrintOpt' can be used to make the indentation much smaller
-- than normal.
--
-- This is what the normal indentation looks like:
--
-- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor $ Just ("hello", "bye")
-- Just
-- ( "hello"
-- , "bye"
-- )
--
-- This is what smaller indentation looks like:
--
-- >>> let smallIndent = defaultOutputOptionsNoColor {outputOptionsIndentAmount = 1}
-- >>> pPrintOpt CheckColorTty smallIndent $ Just ("hello", "bye")
-- Just
-- ( "hello"
-- , "bye"
-- )
--
-- Lines in strings get indented
--
-- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor (1, (2, "foo\nbar\nbaz", 3))
-- ( 1
-- ,
-- ( 2
-- , "foo
-- bar
-- baz"
-- , 3
-- )
-- )
--
-- Lines get indented even in custom show instances
--
-- >>> data Foo = Foo
-- >>> instance Show Foo where show _ = "foo\nbar\nbaz"
-- >>> pPrintOpt CheckColorTty defaultOutputOptionsNoColor (1, (2, Foo, 3))
-- ( 1
-- ,
-- ( 2
-- , foo
-- bar
-- baz
-- , 3
-- )
-- )
--
-- 'CheckColorTty' determines whether to test 'stdout' for whether or not it is
-- connected to a TTY.
--
-- If set to 'NoCheckColorTty', then 'pPrintOpt' won't
-- check if 'stdout' is a TTY. It will print in color depending on the value
-- of 'outputOptionsColorOptions'.
--
-- If set to 'CheckColorTty', then 'pPrintOpt' will check if 'stdout' is
-- conneted to a TTY. If 'stdout' is determined to be connected to a TTY, then
-- it will print in color depending on the value of
-- 'outputOptionsColorOptions'. If 'stdout' is determined to NOT be connected
-- to a TTY, then it will NOT print in color, regardless of the value of
-- 'outputOptionsColorOptions'.
pPrintOpt :: (MonadIO m, Show a) => CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt checkColorTty outputOptions =
pHPrintOpt checkColorTty outputOptions stdout
-- | Similar to 'pPrintOpt', but take a 'Handle' to determine where to print
-- to.
pHPrintOpt ::
(MonadIO m, Show a)
=> CheckColorTty
-> OutputOptions
-> Handle
-> a
-> m ()
pHPrintOpt checkColorTty outputOptions handle a =
pHPrintStringOpt checkColorTty outputOptions handle $ show a
-- | Similar to 'pPrintOpt', but the last argument is a string representing a
-- data structure that has already been 'show'ed.
--
-- >>> let foo = show (1, (2, "hello", 3))
-- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsNoColor foo
-- ( 1
-- ,
-- ( 2
-- , "hello"
-- , 3
-- )
-- )
pPrintStringOpt :: MonadIO m => CheckColorTty -> OutputOptions -> String -> m ()
pPrintStringOpt checkColorTty outputOptions =
pHPrintStringOpt checkColorTty outputOptions stdout
-- | Similar to 'pPrintStringOpt', but take a 'Handle' to determine where to
-- print to.
--
-- >>> let foo = show (1, (2, "hello", 3))
-- >>> pHPrintStringOpt CheckColorTty defaultOutputOptionsNoColor stdout foo
-- ( 1
-- ,
-- ( 2
-- , "hello"
-- , 3
-- )
-- )
pHPrintStringOpt ::
MonadIO m
=> CheckColorTty
-> OutputOptions
-> Handle
-> String
-> m ()
pHPrintStringOpt checkColorTty outputOptions handle str = do
realOutputOpts <-
case checkColorTty of
CheckColorTty -> hCheckTTY handle outputOptions
NoCheckColorTty -> pure outputOptions
liftIO $ do
renderIO handle $ layoutStringAnsi realOutputOpts str
hPutStrLn handle ""
-- | Like 'pShow' but takes 'OutputOptions' to change how the
-- pretty-printing is done.
pShowOpt :: Show a => OutputOptions -> a -> Text
pShowOpt outputOptions = pStringOpt outputOptions . show
-- | Like 'pString' but takes 'OutputOptions' to change how the
-- pretty-printing is done.
pStringOpt :: OutputOptions -> String -> Text
pStringOpt outputOptions = renderLazy . layoutStringAnsi outputOptions
layoutStringAnsi :: OutputOptions -> String -> SimpleDocStream AnsiStyle
layoutStringAnsi opts = fmap convertStyle . layoutString opts
-- $examples
--
-- Here are some examples of using 'pPrint' on different data types. You can
-- look at these examples to get an idea of what 'pPrint' will output.
--
-- __Simple Haskell data type__
--
-- >>> data Foo a = Foo a String Char deriving Show
--
-- >>> pPrint $ Foo 3 "hello" 'a'
-- Foo 3 "hello" 'a'
--
-- __List__
--
-- >>> pPrint $ [1,2,3]
-- [ 1
-- , 2
-- , 3
-- ]
--
-- __Slightly more complicated list__
--
-- >>> pPrint $ [ Foo [ (), () ] "hello" 'b' ]
-- [ Foo
-- [ ()
-- , ()
-- ] "hello" 'b'
-- ]
--
-- >>> pPrint $ [ Foo [ "bar", "baz" ] "hello" 'a', Foo [] "bye" 'b' ]
-- [ Foo
-- [ "bar"
-- , "baz"
-- ] "hello" 'a'
-- , Foo [] "bye" 'b'
-- ]
--
-- __Record__
--
-- >>> :{
-- data Bar b = Bar
-- { barInt :: Int
-- , barA :: b
-- , barList :: [Foo Double]
-- } deriving Show
-- :}
--
-- >>> pPrint $ Bar 1 [10, 11] [Foo 1.1 "" 'a', Foo 2.2 "hello" 'b']
-- Bar
-- { barInt = 1
-- , barA =
-- [ 10
-- , 11
-- ]
-- , barList =
-- [ Foo 1.1 "" 'a'
-- , Foo 2.2 "hello" 'b'
-- ]
-- }
--
-- __Newtype__
--
-- >>> newtype Baz = Baz { unBaz :: [String] } deriving Show
--
-- >>> pPrint $ Baz ["hello", "bye"]
-- Baz
-- { unBaz =
-- [ "hello"
-- , "bye"
-- ]
-- }
--
-- __Newline Rules__
--
-- >>> data Foo = A | B Foo | C [Foo] [Foo] deriving Show
--
-- >>> pPrint $ B ( B A )
-- B ( B A )
--
-- >>> pPrint $ B ( B ( B A ) )
-- B
-- ( B ( B A ) )
--
-- >>> pPrint $ B ( B ( B ( B A ) ) )
-- B
-- ( B
-- ( B ( B A ) )
-- )
--
-- >>> pPrint $ B ( C [A, A] [B A, B (B (B A))] )
-- B
-- ( C
-- [ A
-- , A
-- ]
-- [ B A
-- , B
-- ( B ( B A ) )
-- ]
-- )
--
-- __Laziness__
--
-- >>> take 100 . unpack . pShowNoColor $ [1..]
-- "[ 1\n, 2\n, 3\n, 4\n, 5\n, 6\n, 7\n, 8\n, 9\n, 10\n, 11\n, 12\n, 13\n, 14\n, 15\n, 16\n, 17\n, 18\n, 19\n, 20\n, 21\n, 22"
--
-- __Unicode__
--
-- >>> pPrint $ Baz ["猫", "犬", "ヤギ"]
-- Baz
-- { unBaz =
-- [ "猫"
-- , "犬"
-- , "ヤギ"
-- ]
-- }
--
-- __Char__
--
-- >>> pPrint 'λ'
-- 'λ'
--
-- __Compactness options__
--
-- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompact = True} "AST [] [Def ((3,1),(5,30)) (Id \"fact'\" \"fact'\") [] (Forall ((3,9),(3,26)) [((Id \"n\" \"n_0\"),KPromote (TyCon (Id \"Nat\" \"Nat\")))])]"
-- AST []
-- [ Def
-- ( ( 3, 1 ), ( 5, 30 ) )
-- ( Id "fact'" "fact'" ) []
-- ( Forall
-- ( ( 3, 9 ), ( 3, 26 ) )
-- [ ( ( Id "n" "n_0" ), KPromote ( TyCon ( Id "Nat" "Nat" ) ) ) ]
-- )
-- ]
--
-- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompactParens = True} $ B ( C [A, A] [B A, B (B (B A))] )
-- B
-- ( C
-- [ A
-- , A ]
-- [ B A
-- , B
-- ( B ( B A ) ) ] )
--
-- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompact = True} $ [("id", 123), ("state", 1), ("pass", 1), ("tested", 100), ("time", 12345)]
-- [
-- ( "id", 123 ),
-- ( "state", 1 ),
-- ( "pass", 1 ),
-- ( "tested", 100 ),
-- ( "time", 12345 )
-- ]
--
-- __Initial indent__
--
-- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsInitialIndent = 3} $ B ( B ( B ( B A ) ) )
-- B
-- ( 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__
--
-- Making sure the spacing after a string is correct.
--
-- >>> data Foo = Foo String Int deriving Show
--
-- >>> pPrint $ Foo "bar" 0
-- Foo "bar" 0
--
-- Non-printable characters will get escaped.
--
-- >>> pPrint "this string has non-printable characters: \x8 and \x9"
-- "this string has non-printable characters: \x8 and \x9"
--
-- If you don't want non-printable characters to be escaped, take a look at
-- 'outputOptionsStringStyle' and 'StringOutputStyle'.
pretty-simple-4.1.4.0/src/Text/Pretty/Simple/ 0000755 0000000 0000000 00000000000 07346545000 017120 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal.hs 0000644 0000000 0000000 00000000722 07346545000 021231 0 ustar 00 0000000 0000000 {-|
Module : Text.Pretty.Simple.Internal
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
( 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.Printer as X
pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal/ 0000755 0000000 0000000 00000000000 07346545000 020674 5 ustar 00 0000000 0000000 pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal/Color.hs 0000644 0000000 0000000 00000007277 07346545000 022323 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Text.Pretty.Simple.Internal.Color
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.Typeable (Typeable)
import GHC.Generics (Generic)
import Prettyprinter.Render.Terminal
(AnsiStyle, Intensity(Dull,Vivid), Color(..))
import qualified Prettyprinter.Render.Terminal as Ansi
-- | These options are for colorizing the output of functions like 'pPrint'.
--
-- If you don't want to use a color for one of the options, use 'colorNull'.
data ColorOptions = ColorOptions
{ colorQuote :: Style
-- ^ Color to use for quote characters (@\"@) around strings.
, colorString :: Style
-- ^ Color to use for strings.
, colorError :: Style
-- ^ Color for errors, e.g. unmatched brackets.
, colorNum :: Style
-- ^ Color to use for numbers.
, colorRainbowParens :: [Style]
-- ^ A list of 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)
-- | Default color options for use on a dark background.
defaultColorOptionsDarkBg :: ColorOptions
defaultColorOptionsDarkBg =
ColorOptions
{ colorQuote = colorBold Vivid White
, colorString = colorBold Vivid Blue
, colorError = colorBold Vivid Red
, colorNum = colorBold Vivid Green
, colorRainbowParens =
[ colorBold Vivid Magenta
, colorBold Vivid Cyan
, colorBold Vivid Yellow
, color Dull Magenta
, color Dull Cyan
, color Dull Yellow
, colorBold Dull Magenta
, colorBold Dull Cyan
, colorBold Dull Yellow
, color Vivid Magenta
, color Vivid Cyan
, color Vivid Yellow
]
}
-- | Default color options for use on a light background.
defaultColorOptionsLightBg :: ColorOptions
defaultColorOptionsLightBg =
ColorOptions
{ colorQuote = colorBold Vivid Black
, colorString = colorBold Vivid Blue
, colorError = colorBold Vivid Red
, colorNum = colorBold Vivid Green
, colorRainbowParens =
[ colorBold Vivid Magenta
, colorBold Vivid Cyan
, color Dull Magenta
, color Dull Cyan
, colorBold Dull Magenta
, colorBold Dull Cyan
, color Vivid Magenta
, color Vivid Cyan
]
}
-- | No styling.
colorNull :: Style
colorNull = Style
{ styleColor = Nothing
, styleBold = False
, styleItalic = False
, styleUnderlined = False
}
-- | Ways to style terminal output.
data Style = Style
{ styleColor :: Maybe (Color, Intensity)
, styleBold :: Bool
, styleItalic :: Bool
, styleUnderlined :: Bool
}
deriving (Eq, Generic, Show, Typeable)
color :: Intensity -> Color -> Style
color i c = colorNull {styleColor = Just (c, i)}
colorBold :: Intensity -> Color -> Style
colorBold i c = (color i c) {styleBold = True}
convertStyle :: Style -> AnsiStyle
convertStyle Style {..} =
mconcat
[ maybe mempty (uncurry $ flip col) styleColor
, if styleBold then Ansi.bold else mempty
, if styleItalic then Ansi.italicized else mempty
, if styleUnderlined then Ansi.underlined else mempty
]
where
col = \case
Vivid -> Ansi.color
Dull -> Ansi.colorDull
pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal/Expr.hs 0000644 0000000 0000000 00000002566 07346545000 022157 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Text.Pretty.Simple.Internal.Expr
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.Expr
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.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
newtype CommaSeparated a = CommaSeparated { unCommaSeparated :: [a] }
deriving (Data, Eq, Generic, Show, Typeable)
data Expr
= Brackets !(CommaSeparated [Expr])
| Braces !(CommaSeparated [Expr])
| Parens !(CommaSeparated [Expr])
| StringLit !String
| CharLit !String
| NumberLit !String
-- ^ We could store this as a 'Rational', say, instead of a 'String'.
-- However, we will never need to use its value for anything. Indeed, the
-- only thing we will be doing with it is turning it /back/ into a string
-- at some stage, so we might as well cut out the middle man and store it
-- directly like this.
| Other !String
deriving (Data, Eq, Generic, Show, Typeable)
pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal/ExprParser.hs 0000644 0000000 0000000 00000014552 07346545000 023332 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Text.Pretty.Simple.Internal.ExprParser
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.ExprParser
where
import Text.Pretty.Simple.Internal.Expr (CommaSeparated(..), Expr(..))
import Control.Arrow (first)
import Data.Char (isAlpha, isDigit)
-- | 'testString1' and 'testString2' are convenient to use in GHCi when playing
-- around with how parsing works.
testString1 :: String
testString1 = "Just [TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}, TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}]"
-- | See 'testString1'.
testString2 :: String
testString2 = "some stuff (hello [\"dia\\x40iahello\", why wh, bye] ) (bye)"
expressionParse :: String -> [Expr]
expressionParse = fst . parseExprs
parseExpr :: String -> (Expr, String)
parseExpr ('(':rest) = first (Parens . CommaSeparated) $ parseCSep ')' rest
parseExpr ('[':rest) = first (Brackets . CommaSeparated) $ parseCSep ']' rest
parseExpr ('{':rest) = first (Braces . CommaSeparated) $ parseCSep '}' rest
parseExpr ('"':rest) = first StringLit $ parseStringLit rest
parseExpr ('\'':rest) = first CharLit $ parseCharLit rest
parseExpr (c:rest) | isDigit c = first NumberLit $ parseNumberLit c rest
parseExpr other = first Other $ parseOther other
-- | Parse multiple expressions.
--
-- >>> parseExprs "Just 'a'"
-- ([Other "Just ",CharLit "a"],"")
--
-- Handle escaped characters correctly
--
-- >>> parseExprs $ "Foo \"hello \\\"world!\""
-- ([Other "Foo ",StringLit "hello \\\"world!"],"")
-- >>> parseExprs $ "'\\''"
-- ([CharLit "\\'"],"")
parseExprs :: String -> ([Expr], String)
parseExprs [] = ([], "")
parseExprs s@(c:_)
| c `elem` (")]}," :: String) = ([], s)
| otherwise = let (parsed, rest') = parseExpr s
(toParse, rest) = parseExprs rest'
in (parsed : toParse, rest)
parseCSep :: Char -> String -> ([[Expr]], String)
parseCSep _ [] = ([], "")
parseCSep end s@(c:cs)
| c == end = ([], cs)
-- Mismatch condition; if the end does not match, there is a mistake
-- Perhaps there should be a Missing constructor for Expr
| c `elem` (")]}" :: String) = ([], s)
| c == ',' = parseCSep end cs
| otherwise = let (parsed, rest') = parseExprs s
(toParse, rest) = parseCSep end rest'
in (parsed : toParse, rest)
-- | Parse string literals until a trailing double quote.
--
-- >>> parseStringLit "foobar\" baz"
-- ("foobar"," baz")
--
-- Keep literal back slashes:
--
-- >>> parseStringLit "foobar\\\" baz\" after"
-- ("foobar\\\" baz"," after")
parseStringLit :: String -> (String, String)
parseStringLit [] = ("", "")
parseStringLit ('"':rest) = ("", rest)
parseStringLit ('\\':c:cs) = ('\\':c:cs', rest)
where (cs', rest) = parseStringLit cs
parseStringLit (c:cs) = (c:cs', rest)
where (cs', rest) = parseStringLit cs
-- | Parse character literals until a trailing single quote.
--
-- >>> parseCharLit "a' foobar"
-- ("a"," foobar")
--
-- Keep literal back slashes:
--
-- >>> parseCharLit "\\'' hello"
-- ("\\'"," hello")
parseCharLit :: String -> (String, String)
parseCharLit [] = ("", "")
parseCharLit ('\'':rest) = ("", rest)
parseCharLit ('\\':c:cs) = ('\\':c:cs', rest)
where (cs', rest) = parseCharLit cs
parseCharLit (c:cs) = (c:cs', rest)
where (cs', rest) = parseCharLit cs
-- | Parses integers and reals, like @123@ and @45.67@.
--
-- To be more precise, any numbers matching the regex @\\d+(\\.\\d+)?@ should
-- get parsed by this function.
--
-- >>> parseNumberLit '3' "456hello world []"
-- ("3456","hello world []")
-- >>> parseNumberLit '0' ".12399880 foobar"
-- ("0.12399880"," foobar")
parseNumberLit :: Char -> String -> (String, String)
parseNumberLit firstDigit rest1 =
case rest2 of
[] -> (firstDigit:remainingDigits, "")
'.':rest3 ->
let (digitsAfterDot, rest4) = span isDigit rest3
in ((firstDigit : remainingDigits) ++ ('.' : digitsAfterDot), rest4)
_ -> (firstDigit:remainingDigits, rest2)
where
remainingDigits :: String
rest2 :: String
(remainingDigits, rest2) = span isDigit rest1
-- | This function consumes input, stopping only when it hits a special
-- character or a digit. However, if the digit is in the middle of a
-- Haskell-style identifier (e.g. @foo123@), then keep going
-- anyway.
--
-- This is almost the same as the function
--
-- > parseOtherSimple = span $ \c ->
-- > notElem c ("{[()]}\"," :: String) && not (isDigit c) && (c /= '\'')
--
-- except 'parseOther' ignores digits and single quotes that appear in
-- Haskell-like identifiers.
--
-- >>> parseOther "hello world []"
-- ("hello world ","[]")
-- >>> parseOther "hello234 world"
-- ("hello234 world","")
-- >>> parseOther "hello 234 world"
-- ("hello ","234 world")
-- >>> parseOther "hello{[ 234 world"
-- ("hello","{[ 234 world")
-- >>> parseOther "H3110 World"
-- ("H3110 World","")
-- >>> parseOther "Node' (Leaf' 1) (Leaf' 2)"
-- ("Node' ","(Leaf' 1) (Leaf' 2)")
-- >>> parseOther "I'm One"
-- ("I'm One","")
-- >>> parseOther "I'm 2"
-- ("I'm ","2")
parseOther :: String -> (String, String)
parseOther = go False
where
go
:: Bool
-- ^ in an identifier?
-> String
-> (String, String)
go _ [] = ("", "")
go insideIdent cs@(c:cs')
| c `elem` ("{[()]}\"," :: String) = ("", cs)
| ignoreInIdent c && not insideIdent = ("", cs)
| insideIdent = first (c :) (go (isIdentRest c) cs')
| otherwise = first (c :) (go (isIdentBegin c) cs')
isIdentBegin :: Char -> Bool
isIdentBegin '_' = True
isIdentBegin c = isAlpha c
isIdentRest :: Char -> Bool
isIdentRest '_' = True
isIdentRest '\'' = True
isIdentRest c = isAlpha c || ignoreInIdent c
ignoreInIdent :: Char -> Bool
ignoreInIdent x = isDigit x || x == '\''
pretty-simple-4.1.4.0/src/Text/Pretty/Simple/Internal/Printer.hs 0000644 0000000 0000000 00000032237 07346545000 022662 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Text.Pretty.Simple.Internal.Printer
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.Printer
where
-- We don't need these imports for later GHCs as all required functions
-- are exported from Prelude
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid ((<>))
#endif
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad (join)
import Control.Monad.State (MonadState, evalState, modify, gets)
import Data.Char (isPrint, ord)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe (fromMaybe)
import Prettyprinter
(indent, line', PageWidth(AvailablePerLine), layoutPageWidth, nest,
concatWith, space, Doc, SimpleDocStream, annotate, defaultLayoutOptions,
enclose, hcat, layoutSmart, line, unAnnotateS, pretty, group,
removeTrailingWhitespace)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Numeric (showHex)
import System.IO (Handle, hIsTerminalDevice)
import Text.Read (readMaybe)
import Text.Pretty.Simple.Internal.Expr
(Expr(..), CommaSeparated(CommaSeparated))
import Text.Pretty.Simple.Internal.ExprParser (expressionParse)
import Text.Pretty.Simple.Internal.Color
(colorNull, Style, ColorOptions(..), defaultColorOptionsDarkBg,
defaultColorOptionsLightBg)
-- $setup
-- >>> import Text.Pretty.Simple (pPrintString, pPrintStringOpt)
-- | Determines whether pretty-simple should check if the output 'Handle' is a
-- TTY device. Normally, users only want to print in color if the output
-- 'Handle' is a TTY device.
data CheckColorTty
= CheckColorTty
-- ^ Check if the output 'Handle' is a TTY device. If the output 'Handle' is
-- a TTY device, determine whether to print in color based on
-- 'outputOptionsColorOptions'. If not, then set 'outputOptionsColorOptions'
-- to 'Nothing' so the output does not get colorized.
| NoCheckColorTty
-- ^ Don't check if the output 'Handle' is a TTY device. Determine whether to
-- colorize the output based solely on the value of
-- 'outputOptionsColorOptions'.
deriving (Eq, Generic, Show, Typeable)
-- | Control how escaped and non-printable are output for strings.
--
-- See 'outputOptionsStringStyle' for what the output looks like with each of
-- these options.
data StringOutputStyle
= Literal
-- ^ Output string literals by printing the source characters exactly.
--
-- For examples: without this option the printer will insert a newline in
-- place of @"\n"@, with this options the printer will output @'\'@ and
-- @'n'@. Similarly the exact escape codes used in the input string will be
-- replicated, so @"\65"@ will be printed as @"\65"@ and not @"A"@.
| EscapeNonPrintable
-- ^ Replace non-printable characters with hexadecimal escape sequences.
| DoNotEscapeNonPrintable
-- ^ Output non-printable characters without modification.
deriving (Eq, Generic, 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.
, outputOptionsPageWidth :: Int
-- ^ The maximum number of characters to fit on to one line.
, outputOptionsCompact :: Bool
-- ^ Use less vertical (and more horizontal) space.
, outputOptionsCompactParens :: Bool
-- ^ Group closing parentheses on to a single line.
, outputOptionsInitialIndent :: Int
-- ^ Indent the whole output by this amount.
, 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.
--
, outputOptionsStringStyle :: StringOutputStyle
-- ^ Controls how string literals are output.
--
-- By default, the pPrint functions escape non-printable characters, but
-- print all printable characters:
--
-- >>> pPrintString "\"A \\x42 Ä \\xC4 \\x1 \\n\""
-- "A B Ä Ä \x1
-- "
--
-- Here, you can see that the character @A@ has been printed as-is. @\x42@
-- has been printed in the non-escaped version, @B@. The non-printable
-- character @\x1@ has been printed as @\x1@. Newlines will be removed to
-- make the output easier to read.
--
-- This corresponds to the 'StringOutputStyle' called 'EscapeNonPrintable'.
--
-- (Note that in the above and following examples, the characters have to be
-- double-escaped, which makes it somewhat confusing...)
--
-- Another output style is 'DoNotEscapeNonPrintable'. This is similar
-- to 'EscapeNonPrintable', except that non-printable characters get printed
-- out literally to the screen.
--
-- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = DoNotEscapeNonPrintable } "\"A \\x42 Ä \\xC4 \\n\""
-- "A B Ä Ä
-- "
--
-- If you change the above example to contain @\x1@, you can see that it is
-- output as a literal, non-escaped character. Newlines are still removed
-- for readability.
--
-- Another output style is 'Literal'. This just outputs all escape characters.
--
-- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = Literal } "\"A \\x42 Ä \\xC4 \\x1 \\n\""
-- "A \x42 Ä \xC4 \x1 \n"
--
-- You can see that all the escape characters get output literally, including
-- newline.
} deriving (Eq, Generic, Show, Typeable)
-- | Default values for 'OutputOptions' when printing to a console with a dark
-- background. 'outputOptionsIndentAmount' is 4, and
-- 'outputOptionsColorOptions' is 'defaultColorOptionsDarkBg'.
defaultOutputOptionsDarkBg :: OutputOptions
defaultOutputOptionsDarkBg =
defaultOutputOptionsNoColor
{ 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 =
defaultOutputOptionsNoColor
{ 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
, outputOptionsPageWidth = 80
, outputOptionsCompact = False
, outputOptionsCompactParens = False
, outputOptionsInitialIndent = 0
, outputOptionsColorOptions = Nothing
, outputOptionsStringStyle = EscapeNonPrintable
}
-- | Given 'OutputOptions', disable colorful output if the given handle
-- is not connected to a TTY.
hCheckTTY :: MonadIO m => Handle -> OutputOptions -> m OutputOptions
hCheckTTY h options = liftIO $ conv <$> tty
where
conv :: Bool -> OutputOptions
conv True = options
conv False = options { outputOptionsColorOptions = Nothing }
tty :: IO Bool
tty = hIsTerminalDevice h
-- | Parse a string, and generate an intermediate representation,
-- suitable for passing to any /prettyprinter/ backend.
-- Used by 'Simple.pString' etc.
layoutString :: OutputOptions -> String -> SimpleDocStream Style
layoutString opts = annotateStyle opts . layoutStringAbstract opts
layoutStringAbstract :: OutputOptions -> String -> SimpleDocStream Annotation
layoutStringAbstract opts =
removeTrailingWhitespace
. layoutSmart defaultLayoutOptions
{layoutPageWidth = AvailablePerLine (outputOptionsPageWidth opts) 1}
. indent (outputOptionsInitialIndent opts)
. prettyExprs' opts
. expressionParse
-- | Slight adjustment of 'prettyExprs' for the outermost level,
-- to avoid indenting everything.
prettyExprs' :: OutputOptions -> [Expr] -> Doc Annotation
prettyExprs' opts = \case
[] -> mempty
x : xs -> prettyExpr opts x <> prettyExprs opts xs
-- | Construct a 'Doc' from multiple 'Expr's.
prettyExprs :: OutputOptions -> [Expr] -> Doc Annotation
prettyExprs opts = hcat . map subExpr
where
subExpr x =
let doc = prettyExpr opts x
in
if isSimple x then
-- keep the expression on the current line
nest 2 doc
else
-- put the expression on a new line, indented (unless grouped)
nest (outputOptionsIndentAmount opts) $ line' <> doc
-- | Construct a 'Doc' from a single 'Expr'.
prettyExpr :: OutputOptions -> Expr -> Doc Annotation
prettyExpr opts = (if outputOptionsCompact opts then group else id) . \case
Brackets xss -> list "[" "]" xss
Braces xss -> list "{" "}" xss
Parens xss -> list "(" ")" xss
StringLit s -> join enclose (annotate Quote "\"") $ annotate String $ pretty $ escapeString s
CharLit s -> join enclose (annotate Quote "'") $ annotate String $ pretty $ escapeString s
Other s -> pretty s
NumberLit n -> annotate Num $ pretty n
where
escapeString s = case outputOptionsStringStyle opts of
Literal -> s
EscapeNonPrintable -> escapeNonPrintable $ readStr s
DoNotEscapeNonPrintable -> readStr s
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 <> 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 <> munless (outputOptionsCompact opts) line' <> annotate Comma "," <> y
munless b x = if b then mempty else x
-- | Determine whether this expression should be displayed on a single line.
isSimple :: Expr -> Bool
isSimple = \case
Brackets (CommaSeparated xs) -> isListSimple xs
Braces (CommaSeparated xs) -> isListSimple xs
Parens (CommaSeparated xs) -> isListSimple xs
_ -> True
where
isListSimple = \case
[[e]] -> isSimple e
_:_ -> False
[] -> True
-- | Traverse the stream, using a 'Tape' to keep track of the current style.
annotateStyle :: OutputOptions -> SimpleDocStream Annotation
-> SimpleDocStream Style
annotateStyle opts ds = case outputOptionsColorOptions opts of
Nothing -> unAnnotateS ds
Just ColorOptions {..} -> evalState (traverse style ds) initialTape
where
style :: MonadState (Tape Style) m => Annotation -> m Style
style = \case
Open -> modify moveR *> gets tapeHead
Close -> gets tapeHead <* modify moveL
Comma -> gets tapeHead
Quote -> pure colorQuote
String -> pure colorString
Num -> pure colorNum
initialTape = Tape
{ tapeLeft = streamRepeat colorError
, tapeHead = colorError
, tapeRight = streamCycle $ fromMaybe (pure colorNull)
$ nonEmpty colorRainbowParens
}
-- | An abstract annotation type, representing the various elements
-- we may want to highlight.
data Annotation
= Open
| Close
| Comma
| Quote
| String
| Num
deriving (Eq, Show)
-- | Replace non-printable characters with hex escape sequences.
--
-- >>> escapeNonPrintable "\x1\x2"
-- "\\x1\\x2"
--
-- Newlines will not be escaped.
--
-- >>> escapeNonPrintable "hello\nworld"
-- "hello\nworld"
--
-- Printable characters will not be escaped.
--
-- >>> escapeNonPrintable "h\101llo"
-- "hello"
escapeNonPrintable :: String -> String
escapeNonPrintable = foldr escape ""
-- | Replace an unprintable character except a newline
-- with a hex escape sequence.
escape :: Char -> ShowS
escape c
| isPrint c || c == '\n' = (c:)
| otherwise = ('\\':) . ('x':) . showHex (ord c)
-- | A bidirectional Turing-machine tape:
-- infinite in both directions, with a head pointing to one element.
data Tape a = Tape
{ tapeLeft :: Stream a -- ^ the side of the 'Tape' left of 'tapeHead'
, tapeHead :: a -- ^ the focused element
, tapeRight :: Stream a -- ^ the side of the 'Tape' right of 'tapeHead'
} deriving Show
-- | Move the head left
moveL :: Tape a -> Tape a
moveL (Tape (l :.. ls) c rs) = Tape ls l (c :.. rs)
-- | Move the head right
moveR :: Tape a -> Tape a
moveR (Tape ls c (r :.. rs)) = Tape (c :.. ls) r rs
-- | An infinite list
data Stream a = a :.. Stream a deriving Show
-- | Analogous to 'repeat'
streamRepeat :: t -> Stream t
streamRepeat x = x :.. streamRepeat x
-- | Analogous to 'cycle'
-- While the inferred signature here is more general,
-- it would diverge on an empty structure
streamCycle :: NonEmpty a -> Stream a
streamCycle xs = foldr (:..) (streamCycle xs) xs