pretty 1.1.1.3 → 1.1.2.0

raw patch · 9 files changed

+359/−71 lines, 9 filesdep +ghc-primdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−13
• README.md +12/−11
• pretty.cabal +9/−4
• src/Text/PrettyPrint.hs +4/−3
• src/Text/PrettyPrint/HughesPJ.hs +75/−34
• src/Text/PrettyPrint/HughesPJClass.hs +146/−0
• tests/Test.hs +5/−6
• tests/UnitPP1.hs +76/−0
• tests/UnitT3911.hs +25/−0

@@ -1,5 +1,12 @@ # Pretty library change log +## 1.1.2.0 -- 25th December, 2014++* Merge in prettyclass package -- new Text.PrettyPrint.HughesPHClass.+* Add in 'maybe\*' variants of various bracket functins.+* Add Generic instances for appropriate data types.+* Fix compilation under GHC 7.10+ ## 1.1.1.3 -- 21st December, 2014  * Remove upper bound on `deepseq` package to fix build issues with@@ -13,19 +20,6 @@  * Update pretty cabal file and readme. * Fix tests to work with latest quickcheck.--## Version 4.0, 24 August 2011--* Big change to the structure of the library. Now we don't have a fixed-  TextDetails data type for storing the various String types that we-  support. Instead we have changed that to be a type class that just-  provides a way to convert String and Chars to an arbitary type. This-  arbitary type is now provided by the user of the library so that they-  can implement support very easily for any String type they want.--  This new code lives in Text.PrettyPrint.Core and the Text.PrettyPrint-  module uses it to implement the old API. The Text.PrettyPrint.HughesPJ-  module has been left unchanged for a compatability module but deprecated.  ## Version 3.0, 28 May 1987 

@@ -11,7 +11,6 @@ Programming, 1995. It can be found [here](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.38.8777). - ## Licensing  This library is BSD-licensed.@@ -19,23 +18,25 @@ ## Building  The library uses the Cabal build system, so building is simply a-matter of running+matter of running:  ```+cabal sandbox init+cabal install "QuickCheck >= 2.5 && < 3"+cabal install --only-dependencies cabal configure --enable-tests cabal build+cabal test ``` -## Branches--Usually two branches are maintained for Pretty development:-- * master: This branch is generally kept in a stable state and is-   where release are pulled and made from. The reason for this is GHC-   includes the pretty library and tracks the master branch by default-   so we don't want experimental code being pulled into GHC at times.+We have to install `QuickCheck` manually as otherwise Cabal currently+throws an error due to the cyclic dependency between `pretty` and+`QuickCheck`. - * next: This branch is the general development branch.+*If `cabal test` freezes*, then run+`cabal test --show-details=streaming` instead. This is due to a+[bug](https://github.com/haskell/cabal/issues/1810) in certain+versions of Cabal.  ## Get involved! 

@@ -1,5 +1,5 @@ name:          pretty-version:       1.1.1.3+version:       1.1.2.0 synopsis:      Pretty-printing library description:         This package contains a pretty-printing library, a set of API's@@ -30,9 +30,11 @@     exposed-modules:         Text.PrettyPrint         Text.PrettyPrint.HughesPJ+        Text.PrettyPrint.HughesPJClass     build-depends: base >= 3 && < 5,-                   deepseq >= 1.1-    extensions: CPP, BangPatterns+                   deepseq >= 1.1,+                   ghc-prim+    extensions: CPP, BangPatterns, DeriveGeneric     ghc-options: -Wall -fwarn-tabs  Test-Suite test-pretty@@ -41,12 +43,15 @@                     src     build-depends: base >= 3 && < 5,                    deepseq >= 1.1,+                   ghc-prim,                    QuickCheck >= 2.5 && <3     main-is: Test.hs     other-modules:         TestGenerators         TestStructures-    extensions: CPP, BangPatterns+        UnitPP1+        UnitT3911+    extensions: CPP, BangPatterns, DeriveGeneric     include-dirs: src/Text/PrettyPrint  -- Executable Bench1

@@ -7,12 +7,13 @@ -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file LICENSE) -- --- Maintainer  :  David Terei <dave.terei@gmail.com>+-- Maintainer  :  David Terei <code@davidterei.com> -- Stability   :  stable -- Portability :  portable ----- The default interface to the pretty-printing library. Provides a collection--- of pretty printer combinators.+-- Provides a collection of pretty printer combinators, a set of API's+-- that provides a way to easily print out text in a consistent format+-- of your choosing. -- -- This module should be used as opposed to the "Text.PrettyPrint.HughesPJ" -- module. Both are equivalent though as this module simply re-exports the

@@ -2,6 +2,7 @@ {-# LANGUAGE BangPatterns #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Safe #-}+{-# LANGUAGE DeriveGeneric #-} #endif  -----------------------------------------------------------------------------@@ -10,7 +11,7 @@ -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file LICENSE) ----- Maintainer  :  David Terei <dave.terei@gmail.com>+-- Maintainer  :  David Terei <code@davidterei.com> -- Stability   :  stable -- Portability :  portable --@@ -41,6 +42,7 @@          -- ** Wrapping documents in delimiters         parens, brackets, braces, quotes, doubleQuotes,+        maybeParens, maybeBrackets, maybeBraces, maybeQuotes, maybeDoubleQuotes,          -- ** Combining documents         empty,@@ -77,9 +79,13 @@  import Control.DeepSeq ( NFData(rnf) ) import Data.Function   ( on )-import Data.Monoid     ( Monoid(mempty, mappend) )+#if __GLASGOW_HASKELL__ < 709+import Data.Monoid     ( Monoid(mempty, mappend)  )+#endif import Data.String     ( IsString(fromString) ) +import GHC.Generics+ -- --------------------------------------------------------------------------- -- The Doc calculus @@ -177,6 +183,9 @@   | NoDoc                                            -- The empty set of documents   | Beside Doc Bool Doc                              -- True <=> space between   | Above Doc Bool Doc                               -- True <=> never overlap+#if __GLASGOW_HASKELL__ >= 701+  deriving (Generic)+#endif  {- Here are the invariants:@@ -224,6 +233,9 @@                  | PStr String -- ^ Used to represent a Fast String fragment                                --   but now deprecated and identical to the                                --   Str constructor.+#if __GLASGOW_HASKELL__ >= 701+                 deriving (Show, Eq, Generic)+#endif  -- Combining @Doc@ values instance Monoid Doc where@@ -359,9 +371,9 @@ lbrace = char '{' rbrace = char '}' -space_text, nl_text :: TextDetails-space_text = Chr ' '-nl_text    = Chr '\n'+spaceText, nlText :: TextDetails+spaceText = Chr ' '+nlText    = Chr '\n'  int      :: Int      -> Doc -- ^ @int n = text (show n)@ integer  :: Integer  -> Doc -- ^ @integer n = text (show n)@@@ -385,7 +397,31 @@ brackets p     = char '[' <> p <> char ']' braces p       = char '{' <> p <> char '}' +-- | Apply 'parens' to 'Doc' if boolean is true.+maybeParens :: Bool -> Doc -> Doc+maybeParens False = id+maybeParens True = parens +-- | Apply 'brackets' to 'Doc' if boolean is true.+maybeBrackets :: Bool -> Doc -> Doc+maybeBrackets False = id+maybeBrackets True = brackets++-- | Apply 'braces' to 'Doc' if boolean is true.+maybeBraces :: Bool -> Doc -> Doc+maybeBraces False = id+maybeBraces True = braces++-- | Apply 'quotes' to 'Doc' if boolean is true.+maybeQuotes :: Bool -> Doc -> Doc+maybeQuotes False = id+maybeQuotes True = quotes++-- | Apply 'doubleQuotes' to 'Doc' if boolean is true.+maybeDoubleQuotes :: Bool -> Doc -> Doc+maybeDoubleQuotes False = id+maybeDoubleQuotes True = doubleQuotes+ -- --------------------------------------------------------------------------- -- Structural operations on GDocs @@ -466,17 +502,17 @@ reduceAB doc                = doc  nilAbove_ :: RDoc -> RDoc-nilAbove_ p = NilAbove p+nilAbove_ = NilAbove  -- Arg of a TextBeside is always an RDoc textBeside_ :: TextDetails -> Int -> RDoc -> RDoc-textBeside_ s sl p = TextBeside s sl p+textBeside_ = TextBeside  nest_ :: Int -> RDoc -> RDoc-nest_ k p = Nest k p+nest_ = Nest  union_ :: RDoc -> RDoc -> RDoc-union_ p q = Union p q+union_ = Union   -- ---------------------------------------------------------------------------@@ -516,7 +552,7 @@  above :: Doc -> Bool -> RDoc -> RDoc above (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)-above p@(Beside _ _ _) g  q  = aboveNest (reduceDoc p) g 0 (reduceDoc q)+above p@(Beside{})     g  q  = aboveNest (reduceDoc p) g 0 (reduceDoc q) above p g q                  = aboveNest p             g 0 (reduceDoc q)  -- Specfication: aboveNest p g k q = p $g$ (nest k q)@@ -584,7 +620,7 @@ beside p@(Beside p1 g1 q1) g2 q2          | g1 == g2              = beside p1 g1 $! beside q1 g2 q2          | otherwise             = beside (reduceDoc p) g2 q2-beside p@(Above _ _ _)     g q   = let !d = reduceDoc p in beside d g q+beside p@(Above{})         g q   = let !d = reduceDoc p in beside d g q beside (NilAbove p)        g q   = nilAbove_ $! beside p g q beside (TextBeside s sl p) g q   = textBeside_ s sl $! rest                                where@@ -597,7 +633,7 @@ nilBeside :: Bool -> RDoc -> RDoc nilBeside _ Empty         = Empty -- Hence the text "" in the spec nilBeside g (Nest _ p)    = nilBeside g p-nilBeside g p | g         = textBeside_ space_text 1 p+nilBeside g p | g         = textBeside_ spaceText 1 p               | otherwise = p  @@ -728,8 +764,7 @@      -> Int   -- Ribbon length      -> RDoc      -> RDoc  -- No unions in here!-best w0 r p0-  = get w0 p0+best w0 r = get w0   where     get w _ | w == 0 && False = undefined     get _ Empty               = Empty@@ -753,7 +788,7 @@     get1 _ _  (Beside {})         = error "best get1 Beside"  nicest :: Int -> Int -> Doc -> Doc -> Doc-nicest !w !r p q = nicest1 w r 0 p q+nicest !w !r = nicest1 w r 0  nicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc nicest1 !w !r !sl p q | fits ((w `min` r) - sl) p = p@@ -808,6 +843,9 @@           , lineLength     :: Int   -- ^ Length of line, in chars           , ribbonsPerLine :: Float -- ^ Ratio of line length to ribbon length           }+#if __GLASGOW_HASKELL__ >= 701+  deriving (Show, Eq, Generic)+#endif  -- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@). style :: Style@@ -818,16 +856,19 @@           | ZigZagMode   -- ^ With zig-zag cuts           | LeftMode     -- ^ No indentation, infinitely long lines           | OneLineMode  -- ^ All on one line+#if __GLASGOW_HASKELL__ >= 701+          deriving (Show, Eq, Generic)+#endif  -- | Render the @Doc@ to a String using the default @Style@. render :: Doc -> String-render doc = fullRender (mode style) (lineLength style) (ribbonsPerLine style)-                        txtPrinter "" doc+render = fullRender (mode style) (lineLength style) (ribbonsPerLine style)+                    txtPrinter ""  -- | Render the @Doc@ to a String using the given @Style@. renderStyle :: Style -> Doc -> String-renderStyle s doc = fullRender (mode s) (lineLength s) (ribbonsPerLine s)-                    txtPrinter "" doc+renderStyle s = fullRender (mode s) (lineLength s) (ribbonsPerLine s)+                txtPrinter ""  -- | Default TextDetails printer txtPrinter :: TextDetails -> String -> String@@ -844,9 +885,9 @@            -> Doc                      -- ^ The document            -> a                        -- ^ Result fullRender OneLineMode _ _ txt end doc-  = easy_display space_text (\_ y -> y) txt end (reduceDoc doc)+  = easyDisplay spaceText (\_ y -> y) txt end (reduceDoc doc) fullRender LeftMode    _ _ txt end doc-  = easy_display nl_text first txt end (reduceDoc doc)+  = easyDisplay nlText first txt end (reduceDoc doc)  fullRender m lineLen ribbons txt rest doc   = display m lineLen ribbonLen txt rest doc'@@ -859,23 +900,23 @@                       ZigZagMode -> maxBound                       _          -> lineLen -easy_display :: TextDetails+easyDisplay :: TextDetails              -> (Doc -> Doc -> Doc)              -> (TextDetails -> a -> a)              -> a              -> Doc              -> a-easy_display nl_space_text choose txt end doc-  = lay doc+easyDisplay nlSpaceText choose txt end+  = lay   where-    lay NoDoc              = error "easy_display: NoDoc"+    lay NoDoc              = error "easyDisplay: NoDoc"     lay (Union p q)        = lay (choose p q)     lay (Nest _ p)         = lay p     lay Empty              = end-    lay (NilAbove p)       = nl_space_text `txt` lay p+    lay (NilAbove p)       = nlSpaceText `txt` lay p     lay (TextBeside s _ p) = s `txt` lay p-    lay (Above {})         = error "easy_display Above"-    lay (Beside {})        = error "easy_display Beside"+    lay (Above {})         = error "easyDisplay Above"+    lay (Beside {})        = error "easyDisplay Beside"  display :: Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a display m !page_width !ribbon_width txt end doc@@ -885,19 +926,19 @@         lay k _            | k `seq` False = undefined         lay k (Nest k1 p)  = lay (k + k1) p         lay _ Empty        = end-        lay k (NilAbove p) = nl_text `txt` lay k p+        lay k (NilAbove p) = nlText `txt` lay k p         lay k (TextBeside s sl p)             = case m of                     ZigZagMode |  k >= gap_width-                               -> nl_text `txt` (+                               -> nlText `txt` (                                   Str (replicate shift '/') `txt` (-                                  nl_text `txt`+                                  nlText `txt`                                   lay1 (k - shift) s sl p ))                                 |  k < 0-                               -> nl_text `txt` (+                               -> nlText `txt` (                                   Str (replicate shift '\\') `txt` (-                                  nl_text `txt`+                                  nlText `txt`                                   lay1 (k + shift) s sl p ))                      _ -> lay1 k s sl p@@ -910,7 +951,7 @@                              in Str (indent k) `txt` (s `txt` lay2 r p)          lay2 k _ | k `seq` False   = undefined-        lay2 k (NilAbove p)        = nl_text `txt` lay k p+        lay2 k (NilAbove p)        = nlText `txt` lay k p         lay2 k (TextBeside s sl p) = s `txt` lay2 (k + sl) p         lay2 k (Nest _ p)          = lay2 k p         lay2 _ Empty               = end

@@ -0,0 +1,146 @@+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.PrettyPrint.HughesPJClass+-- Copyright   :  (c) Lennart Augustsson 2014+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  David Terei <code@davidterei.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Pretty printing class, simlar to 'Show' but nicer looking. +--+-- Note that the precedence level is a 'Rational' so there is an unlimited+-- number of levels. This module re-exports 'Text.PrettyPrint.HughesPJ'.+--+-----------------------------------------------------------------------------++module Text.PrettyPrint.HughesPJClass (+    -- * Pretty typeclass+    Pretty(..),++    PrettyLevel(..), prettyNormal,+    prettyShow, prettyParen,++    -- re-export HughesPJ+    module Text.PrettyPrint.HughesPJ+  ) where++import Text.PrettyPrint.HughesPJ++-- | Level of detail in the pretty printed output.+-- Level 0 is the least detail.+newtype PrettyLevel = PrettyLevel Int+  deriving (Eq, Ord, Show)++-- | The "normal" (Level 0) of detail.+prettyNormal :: PrettyLevel+prettyNormal = PrettyLevel 0++-- | Pretty printing class. The precedence level is used in a similar way as in+-- the 'Show' class. Minimal complete definition is either 'pPrintPrec' or+-- 'pPrint'.+class Pretty a where+  pPrintPrec :: PrettyLevel -> Rational -> a -> Doc+  pPrintPrec _ _ = pPrint++  pPrint :: a -> Doc+  pPrint = pPrintPrec prettyNormal 0++  pPrintList :: PrettyLevel -> [a] -> Doc+  pPrintList l = brackets . fsep . punctuate comma . map (pPrintPrec l 0)++#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL pPrintPrec | pPrint #-}+#endif++-- | Pretty print a value with the 'prettyNormal' level.+prettyShow :: (Pretty a) => a -> String+prettyShow = render . pPrint++pPrint0 :: (Pretty a) => PrettyLevel -> a -> Doc+pPrint0 l = pPrintPrec l 0++appPrec :: Rational+appPrec = 10++-- | Parenthesize an value if the boolean is true.+{-# DEPRECATED prettyParen "Please use 'maybeParens' instead" #-}+prettyParen :: Bool -> Doc -> Doc+prettyParen = maybeParens++-- Various Pretty instances+instance Pretty Int where pPrint = int++instance Pretty Integer where pPrint = integer++instance Pretty Float where pPrint = float++instance Pretty Double where pPrint = double++instance Pretty () where pPrint _ = text "()"++instance Pretty Bool where pPrint = text . show++instance Pretty Ordering where pPrint = text . show++instance Pretty Char where+  pPrint = char+  pPrintList _ = text . show++instance (Pretty a) => Pretty (Maybe a) where+  pPrintPrec _ _ Nothing = text "Nothing"+  pPrintPrec l p (Just x) =+    prettyParen (p > appPrec) $ text "Just" <+> pPrintPrec l (appPrec+1) x++instance (Pretty a, Pretty b) => Pretty (Either a b) where+  pPrintPrec l p (Left x) =+    prettyParen (p > appPrec) $ text "Left" <+> pPrintPrec l (appPrec+1) x+  pPrintPrec l p (Right x) =+    prettyParen (p > appPrec) $ text "Right" <+> pPrintPrec l (appPrec+1) x++instance (Pretty a) => Pretty [a] where+  pPrintPrec l _ = pPrintList l++instance (Pretty a, Pretty b) => Pretty (a, b) where+  pPrintPrec l _ (a, b) =+    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b]++instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where+  pPrintPrec l _ (a, b, c) =+    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c]++instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where+  pPrintPrec l _ (a, b, c, d) =+    parens $ fsep $ punctuate comma+      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where+  pPrintPrec l _ (a, b, c, d, e) =+    parens $ fsep $ punctuate comma+      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where+  pPrintPrec l _ (a, b, c, d, e, f) =+    parens $ fsep $ punctuate comma+      [pPrint0 l a, pPrint0 l b, pPrint0 l c,+        pPrint0 l d, pPrint0 l e, pPrint0 l f]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>+         Pretty (a, b, c, d, e, f, g) where+  pPrintPrec l _ (a, b, c, d, e, f, g) =+    parens $ fsep $ punctuate comma+      [pPrint0 l a, pPrint0 l b, pPrint0 l c,+        pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h) =>+         Pretty (a, b, c, d, e, f, g, h) where+  pPrintPrec l _ (a, b, c, d, e, f, g, h) =+    parens $ fsep $ punctuate comma+      [pPrint0 l a, pPrint0 l b, pPrint0 l c,+        pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g, pPrint0 l h]+

@@ -1,4 +1,3 @@-{-# OPTIONS -XStandaloneDeriving -XDeriveDataTypeable -XPackageImports #-} ----------------------------------------------------------------------------- -- Module      :  HughesPJQuickCheck -- Copyright   :  (c) 2008 Benedikt Huber@@ -16,6 +15,9 @@ import TestGenerators import TestStructures +import UnitPP1+import UnitT3911+ import Control.Monad import Data.Char (isSpace) import Data.List (intersperse)@@ -31,6 +33,8 @@     check_non_prims -- hpc full coverage     check_rendering     check_list_def+    testPP1+    testT3911  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Utility functions@@ -133,11 +137,6 @@ visibleSpace ' ' = '.' visibleSpace '.' = error "dot in visibleSpace (avoid confusion, please)" visibleSpace  c  = c---- shorthands debug functions-pd = (print.prettyDoc)-pds = mapM_ pd-rds = (map mergeTexts.flattenDoc)   -- (1) QuickCheck Properties: Laws

@@ -0,0 +1,76 @@+-- This code used to print an infinite string, by calling 'spaces'+-- with a negative argument.  There's a patch in the library now,+-- which makes 'spaces' do something sensible when called with a negative+-- argument, but it really should not happen at all.++module UnitPP1 where++import TestUtils++import Text.PrettyPrint.HughesPJ++ncat :: Doc -> Doc -> Doc+ncat x y = nest 4 $ cat [ x, y ]++d1, d2 :: Doc+d1 = foldl1 ncat $ take 50 $ repeat $ char 'a'+d2 = parens $  sep [ d1, text "+" , d1 ]++testPP1 :: IO ()+testPP1 = simpleMatch "PP1" expected out+  where out = show d2++expected :: String+expected =+  "(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\++                                                                                                                                                                                                   a\n\+ a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a\n\+a)"+

@@ -0,0 +1,25 @@+module UnitT3911 where++import Text.PrettyPrint.HughesPJ++import TestUtils++xs :: [Doc]+xs = [text "hello",+      nest 10 (text "world")]++d1, d2, d3 :: Doc+d1 = vcat xs+d2 = foldr ($$) empty xs+d3 = foldr ($+$) empty xs++testT3911 :: IO ()+testT3911 = simpleMatch "T3911" expected out+  where out = show d1 ++ "\n" ++ show d2 ++ "\n" ++ show d3++expected :: String+expected =+  "hello     world\n\+hello     world\n\+hello\n\+          world"