Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Text.PrettyPrint.Reader #6

Open
wants to merge 5 commits into from

2 participants

Warren Harris David Terei
Warren Harris

I found this wrapper code around Text.PrettyPrint.HughesPJ to be useful when wishing to do IO operations in the course of pretty-printing. It allows the pretty-printing combinators to be used in much the same way as before, but also allows lifted operations to be called for things such as db lookups.

Although this code seems generally useful to me, I'm not sure whether it belongs in haskell-proper, or in a separate library. Please let me know what you suggest.

Also, I'm not sure whether the PP type should be exposed as a synonym for ReaderT as it is now, whether ReaderT should be hidden in some way, or just used directly in the interface.

David Terei
Collaborator

Cool. I am snowed under right now so may be a two - three weeks before I can look at this seriously. The code looks fine on first glance though, just need to make sure I think it's right to include in the package this kind of functionality.

I can do this myself but in general try to just provide one cleanly named patch.

Warren Harris
David Terei
Collaborator
dterei commented

Hey Warren,

Sorry for the long delay here. I may get some time to look at it this week. Otherwise go ahead and release as its own package and I can always pull it into pretty at a later date when I've evaluated it more. So just let me know.

Cheers,
David

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.

Showing 2 changed files with 390 additions and 2 deletions. Show diff stats Hide diff stats

  1. +4 2 pretty.cabal
  2. +386 0 src/Text/PrettyPrint/Reader.hs
6 pretty.cabal
... ... @@ -1,5 +1,5 @@
1 1 name: pretty
2   -version: 1.1.1.0
  2 +version: 1.1.2.0
3 3 synopsis: Pretty-printing library
4 4 description:
5 5 This package contains a pretty-printing library, a set of API's
@@ -30,7 +30,9 @@ Library
30 30 exposed-modules:
31 31 Text.PrettyPrint
32 32 Text.PrettyPrint.HughesPJ
33   - build-depends: base >= 3 && < 5
  33 + Text.PrettyPrint.Reader
  34 + build-depends: base >= 3 && < 5,
  35 + mtl >= 2
34 36 extensions: CPP, BangPatterns
35 37 ghc-options: -Wall -fwarn-tabs
36 38
386 src/Text/PrettyPrint/Reader.hs
... ... @@ -0,0 +1,386 @@
  1 +-----------------------------------------------------------------------------
  2 +-- |
  3 +-- Module : Text.PrettyPrint.Reader
  4 +-- Copyright : (c) Warren Harris 2012
  5 +-- License : BSD-style (see the file LICENSE)
  6 +--
  7 +-- Maintainer : Warren Harris <warrensomebody@gmail.com>
  8 +-- Stability : stable
  9 +-- Portability : portable
  10 +--
  11 +-- A wrapper around the John Hughes's and Simon Peyton Jones's Pretty
  12 +-- Printer combinators based on the ReaderT monad transformer, allowing
  13 +-- lookups to be performed during the pretty-printing process.
  14 +-----------------------------------------------------------------------------
  15 +
  16 +module Text.PrettyPrint.Reader (
  17 +
  18 + -- * The document type
  19 + PP, P.Doc, P.TextDetails(..),
  20 +
  21 + -- * Constructing documents
  22 +
  23 + -- ** Converting values into documents
  24 + char, text, ptext, sizedText, zeroWidthText,
  25 + int, integer, float, double, rational,
  26 +
  27 + -- ** Simple derived documents
  28 + semi, comma, colon, space, equals,
  29 + lparen, rparen, lbrack, rbrack, lbrace, rbrace,
  30 +
  31 + -- ** Wrapping documents in delimiters
  32 + parens, brackets, braces, quotes, doubleQuotes,
  33 +
  34 + -- ** Combining documents
  35 + empty,
  36 + (<>), (<+>), hcat, hsep,
  37 + ($$), ($+$), vcat,
  38 + sep, cat,
  39 + fsep, fcat,
  40 + nest,
  41 + hang, punctuate,
  42 +
  43 + -- * Predicates on documents
  44 + isEmpty,
  45 +
  46 + {-
  47 + -- * Utility functions for documents
  48 + first, reduceDoc,
  49 + -- TODO: Should these be exported? Previously they weren't
  50 + -- WH: These don't make sense because RDoc isn't exposed or otherwise used.
  51 + -}
  52 +
  53 + -- * Rendering documents
  54 +
  55 + -- ** Default rendering
  56 + render,
  57 +
  58 + -- ** Rendering with a particular style
  59 + P.Style(..),
  60 + P.style,
  61 + renderStyle,
  62 + P.Mode(..),
  63 +
  64 + -- ** General rendering
  65 + fullRender,
  66 +
  67 + -- * State
  68 + ask,
  69 + lift
  70 +
  71 + ) where
  72 +
  73 +import Control.Applicative hiding (empty)
  74 +import Control.Monad.Reader
  75 +--import Control.Monad.Trans.Class
  76 +import qualified Text.PrettyPrint.HughesPJ as P
  77 +
  78 +--------------------------------------------------------------------------------
  79 +-- Operator fixity
  80 +
  81 +infixl 6 <>
  82 +infixl 6 <+>
  83 +infixl 5 $$, $+$
  84 +
  85 +--------------------------------------------------------------------------------
  86 +
  87 +-- | PP is a ReaderT monad transformer that allows lookups to be
  88 +-- performed during the pretty-printing process. For instance, suppose
  89 +-- you have an abstract syntax with interned symbols:
  90 +--
  91 +-- > data Lang = ... | Symbol Id
  92 +--
  93 +-- and a lookup operation:
  94 +--
  95 +-- > symbolName :: Store -> Id -> IO String
  96 +--
  97 +-- A pretty-printer for this syntax can be written thus:
  98 +--
  99 +-- > pp :: Lang -> PP Store IO Doc
  100 +-- > pp (Symbol id) = do store <- ask
  101 +-- > name <- lift $ symbolName store id
  102 +-- > text name
  103 +-- > pp (...) = ...
  104 +type PP u m a = ReaderT u m a
  105 +
  106 +-- ---------------------------------------------------------------------------
  107 +-- Values and Predicates on GDocs and TextDetails
  108 +
  109 +-- | A document of height and width 1, containing a literal character.
  110 +char :: (Monad m, Applicative m) => Char -> PP u m P.Doc
  111 +char c = return $ P.char c
  112 +
  113 +-- | A document of height 1 containing a literal string.
  114 +-- 'text' satisfies the following laws:
  115 +--
  116 +-- * @'text' s '<>' 'text' t = 'text' (s'++'t)@
  117 +--
  118 +-- * @'text' \"\" '<>' x = x@, if @x@ non-empty
  119 +--
  120 +-- The side condition on the last law is necessary because @'text' \"\"@
  121 +-- has height 1, while 'empty' has no height.
  122 +text :: (Monad m, Applicative m) => String -> PP u m P.Doc
  123 +text s = return $ P.text s
  124 +
  125 +-- | Same as @text@. Used to be used for Bytestrings.
  126 +ptext :: (Monad m, Applicative m) => String -> PP u m P.Doc
  127 +ptext s = return $ P.ptext s
  128 +
  129 +-- | Some text with any width. (@text s = sizedText (length s) s@)
  130 +sizedText :: (Monad m, Applicative m) => Int -> String -> PP u m P.Doc
  131 +sizedText l s = return $ P.sizedText l s
  132 +
  133 +-- | Some text, but without any width. Use for non-printing text
  134 +-- such as a HTML or Latex tags
  135 +zeroWidthText :: (Monad m, Applicative m) => String -> PP u m P.Doc
  136 +zeroWidthText s = return $ P.zeroWidthText s
  137 +
  138 +-- | The empty document, with no height and no width.
  139 +-- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere
  140 +-- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
  141 +empty :: (Monad m, Applicative m) => PP u m P.Doc
  142 +empty = return P.empty
  143 +
  144 +-- | Returns 'True' if the document is empty
  145 +isEmpty :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m Bool
  146 +isEmpty doc = P.isEmpty <$> doc
  147 +
  148 +-- | A ';' character
  149 +semi :: (Monad m, Applicative m) => PP u m P.Doc
  150 +semi = return P.semi
  151 +
  152 +-- | A ',' character
  153 +comma :: (Monad m, Applicative m) => PP u m P.Doc
  154 +comma = return P.comma
  155 +
  156 +-- | A ':' character
  157 +colon :: (Monad m, Applicative m) => PP u m P.Doc
  158 +colon = return P.colon
  159 +
  160 +-- | A space character
  161 +space :: (Monad m, Applicative m) => PP u m P.Doc
  162 +space = return P.space
  163 +
  164 +-- | A '=' character
  165 +equals :: (Monad m, Applicative m) => PP u m P.Doc
  166 +equals = return P.equals
  167 +
  168 +-- | A '(' character
  169 +lparen :: (Monad m, Applicative m) => PP u m P.Doc
  170 +lparen = return P.lparen
  171 +
  172 +-- | A ')' character
  173 +rparen :: (Monad m, Applicative m) => PP u m P.Doc
  174 +rparen = return P.rparen
  175 +
  176 +-- | A '[' character
  177 +lbrack :: (Monad m, Applicative m) => PP u m P.Doc
  178 +lbrack = return P.lbrack
  179 +
  180 +-- | A ']' character
  181 +rbrack :: (Monad m, Applicative m) => PP u m P.Doc
  182 +rbrack = return P.rbrack
  183 +
  184 +-- | A '{' character
  185 +lbrace :: (Monad m, Applicative m) => PP u m P.Doc
  186 +lbrace = return P.lbrace
  187 +
  188 +-- | A '}' character
  189 +rbrace :: (Monad m, Applicative m) => PP u m P.Doc
  190 +rbrace = return P.rbrace
  191 +
  192 +-- | @int n = text (show n)@
  193 +int :: (Monad m, Applicative m) => Int -> PP u m P.Doc
  194 +int = return . P.int
  195 +
  196 +-- | @integer n = text (show n)@
  197 +integer :: (Monad m, Applicative m) => Integer -> PP u m P.Doc
  198 +integer = return . P.integer
  199 +
  200 +-- | @float n = text (show n)@
  201 +float :: (Monad m, Applicative m) => Float -> PP u m P.Doc
  202 +float = return . P.float
  203 +
  204 +-- | @double n = text (show n)@
  205 +double :: (Monad m, Applicative m) => Double -> PP u m P.Doc
  206 +double = return . P.double
  207 +
  208 +-- | @rational n = text (show n)@
  209 +rational :: (Monad m, Applicative m) => Rational -> PP u m P.Doc
  210 +rational = return . P.rational
  211 +
  212 +-- | Wrap document in @(...)@
  213 +parens :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc
  214 +parens p = P.parens <$> p
  215 +
  216 +-- | Wrap document in @[...]@
  217 +brackets :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc
  218 +brackets p = P.brackets <$> p
  219 +
  220 +-- | Wrap document in @{...}@
  221 +braces :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc
  222 +braces p = P.braces <$> p
  223 +
  224 +-- | Wrap document in @\'...\'@
  225 +quotes :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc
  226 +quotes p = P.quotes <$> p
  227 +
  228 +-- | Wrap document in @\"...\"@
  229 +doubleQuotes :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc
  230 +doubleQuotes p = P.doubleQuotes <$> p
  231 +
  232 +-- ---------------------------------------------------------------------------
  233 +-- Structural operations on GDocs
  234 +
  235 +{-
  236 +-- | Perform some simplification of a built up @GDoc@.
  237 +reduceDoc :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.RDoc
  238 +reduceDoc p = p >>= return . P.reduceDoc
  239 +-}
  240 +
  241 +-- | List version of '<>'.
  242 +hcat :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  243 +hcat l = P.hcat <$> l
  244 +
  245 +-- | List version of '<+>'.
  246 +hsep :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  247 +hsep l = P.hsep <$> l
  248 +
  249 +-- | List version of '$$'.
  250 +vcat :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  251 +vcat l = P.vcat <$> l
  252 +
  253 +-- | Nest (or indent) a document by a given number of positions
  254 +-- (which may also be negative). 'nest' satisfies the laws:
  255 +--
  256 +-- * @'nest' 0 x = x@
  257 +--
  258 +-- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@
  259 +--
  260 +-- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@
  261 +--
  262 +-- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@
  263 +--
  264 +-- * @'nest' k 'empty' = 'empty'@
  265 +--
  266 +-- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty
  267 +--
  268 +-- The side condition on the last law is needed because
  269 +-- 'empty' is a left identity for '<>'.
  270 +nest :: (Monad m, Applicative m) => Int -> PP u m P.Doc -> PP u m P.Doc
  271 +nest k p = P.nest k <$> p
  272 +
  273 +-- | @hang d1 n d2 = sep [d1, nest n d2]@
  274 +hang :: (Monad m, Applicative m) => PP u m P.Doc -> Int -> PP u m P.Doc -> PP u m P.Doc
  275 +--hang d1 n d2 = do d1' <- d1; d2' <- d2; return $ P.hang d1' n d2'
  276 +hang d1 n d2 = flip P.hang n <$> d1 <*> d2
  277 +
  278 +-- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
  279 +punctuate :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m [P.Doc] -> PP u m [P.Doc]
  280 +punctuate p l = P.punctuate <$> p <*> l
  281 +
  282 +-- ---------------------------------------------------------------------------
  283 +-- Vertical composition @$$@
  284 +
  285 +-- | Above, except that if the last line of the first argument stops
  286 +-- at least one position before the first line of the second begins,
  287 +-- these two lines are overlapped. For example:
  288 +--
  289 +-- > text "hi" $$ nest 5 (text "there")
  290 +--
  291 +-- lays out as
  292 +--
  293 +-- > hi there
  294 +--
  295 +-- rather than
  296 +--
  297 +-- > hi
  298 +-- > there
  299 +--
  300 +-- '$$' is associative, with identity 'empty', and also satisfies
  301 +--
  302 +-- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
  303 +--
  304 +($$) :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc -> PP u m P.Doc
  305 +p $$ q = (P.$$) <$> p <*> q
  306 +
  307 +-- | Above, with no overlapping.
  308 +-- '$+$' is associative, with identity 'empty'.
  309 +($+$) :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc -> PP u m P.Doc
  310 +p $+$ q = (P.$+$) <$> p <*> q
  311 +
  312 +-- ---------------------------------------------------------------------------
  313 +-- Horizontal composition @<>@
  314 +
  315 +-- We intentionally avoid Data.Monoid.(<>) here due to interactions of
  316 +-- Data.Monoid.(<>) and (<+>). See
  317 +-- http://www.haskell.org/pipermail/libraries/2011-November/017066.html
  318 +
  319 +-- | Beside.
  320 +-- '<>' is associative, with identity 'empty'.
  321 +(<>) :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc -> PP u m P.Doc
  322 +p <> q = (P.<>) <$> p <*> q
  323 +
  324 +-- | Beside, separated by space, unless one of the arguments is 'empty'.
  325 +-- '<+>' is associative, with identity 'empty'.
  326 +(<+>) :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc -> PP u m P.Doc
  327 +p <+> q = (P.<+>) <$> p <*> q
  328 +
  329 +-- ---------------------------------------------------------------------------
  330 +-- Separate, @sep@
  331 +
  332 +-- Specification: sep ps = oneLiner (hsep ps)
  333 +-- `union`
  334 +-- vcat ps
  335 +
  336 +-- | Either 'hsep' or 'vcat'.
  337 +sep :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  338 +sep l = P.sep <$> l
  339 +
  340 +-- | Either 'hcat' or 'vcat'.
  341 +cat :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  342 +cat l = P.cat <$> l
  343 +
  344 +-- ---------------------------------------------------------------------------
  345 +-- @fill@
  346 +
  347 +-- | \"Paragraph fill\" version of 'cat'.
  348 +fcat :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  349 +fcat l = P.fcat <$> l
  350 +
  351 +-- | \"Paragraph fill\" version of 'sep'.
  352 +fsep :: (Monad m, Applicative m) => PP u m [P.Doc] -> PP u m P.Doc
  353 +fsep l = P.fsep <$> l
  354 +
  355 +-- ---------------------------------------------------------------------------
  356 +-- Selecting the best layout
  357 +{-
  358 +-- | @first@ returns its first argument if it is non-empty, otherwise its second.
  359 +first :: (Monad m, Applicative m) => PP u m P.Doc -> PP u m P.Doc -> PP u m P.Doc
  360 +first p q = do p' <- p; q' <- q; return $ P.first p' q'
  361 +-}
  362 +-- ---------------------------------------------------------------------------
  363 +-- Rendering
  364 +
  365 +-- | Render the @Doc@ to a String using the default @Style@.
  366 +render :: (Monad m, Applicative m) => u -> PP u m P.Doc -> m String
  367 +render u doc = runReaderT doc u >>= return . P.render
  368 +
  369 +-- | Render the @Doc@ to a String using the given @Style@.
  370 +renderStyle :: (Monad m, Applicative m) => u -> P.Style -> PP u m P.Doc -> m String
  371 +renderStyle u s doc = runReaderT doc u >>= return . P.renderStyle s
  372 +
  373 +-- | The general rendering interface.
  374 +fullRender :: (Monad m, Applicative m) =>
  375 + u -- ^ User-defined state
  376 + -> P.Mode -- ^ Rendering mode
  377 + -> Int -- ^ Line length
  378 + -> Float -- ^ Ribbons per line
  379 + -> (P.TextDetails -> a -> a) -- ^ What to do with text
  380 + -> a -- ^ What to do at the end
  381 + -> PP u m P.Doc -- ^ The document
  382 + -> m a -- ^ Result
  383 +fullRender u m lineLen ribbons txt rest doc =
  384 + runReaderT doc u >>= return . P.fullRender m lineLen ribbons txt rest
  385 +
  386 +--------------------------------------------------------------------------------

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.