mainland-pretty 0.3.0.0 → 0.4.0.0

raw patch · 2 files changed

+439/−345 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/PrettyPrint/Mainland.hs +438/−344
• mainland-pretty.cabal +1/−1

@@ -1,24 +1,25 @@ -- | -- Module      :  Text.PrettyPrint.Mainland--- Copyright   :  (c) Harvard University 2006-2011---                (c) Geoffrey Mainland 2011-2012+-- Copyright   :  (c) 2006-2011 Harvard University+--                (c) 2011-2012 Geoffrey Mainland+--                (c) 2015 Drexel University -- License     :  BSD-style -- Maintainer  :  mainland@eecs.harvard.edu -- -- Stability   :  provisional -- Portability :  portable ----- This module is based on /A Prettier Printer/ by Phil Wadler in /The Fun of--- Programming/, Jeremy Gibbons and Oege de Moor (eds)+-- This module is based on /A Prettier Printer/ by Phil Wadler in+-- /The Fun of Programming/, Jeremy Gibbons and Oege de Moor (eds) -- <http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf> -- -- At the time it was originally written I didn't know about Daan Leijen's -- pretty printing module based on the same paper. I have since incorporated -- many of his improvements. This module is geared towards pretty printing--- source code; its main advantages over other libraries are a 'Pretty' class--- that handles precedence and the ability to automatically track the source--- locations associated with pretty printed values and output appropriate--- #line pragmas.+-- source code; its main advantages over other libraries are the ability to+-- automatically track the source locations associated with pretty printed+-- values and output appropriate #line pragmas and the use of+-- 'Data.Text.Lazy.Text' for output.  {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}@@ -27,31 +28,39 @@     -- * The document type     Doc, -    -- * Basic combinators-    empty, text, char, string, fromText, fromLazyText,-    line, nest, srcloc, column, nesting,-    softline, softbreak, group,--    -- * Operators-    (<>), (<|>), (<+>), (</>), (<+/>), (<//>),+    -- * Constructing documents+    -- ** Converting values into documents+    text, bool, char, string, int, integer, float, double, rational,+    strictText, lazyText, -    -- * Character documents-    backquote, colon, comma, dot, dquote, equals, semi, space, spaces, squote,-    star, langle, rangle, lbrace, rbrace, lbracket, rbracket, lparen, rparen,+    -- ** Simple documents documents+    star, colon, comma, dot, equals, semi, space, spaces,+    backquote, squote, dquote,+    langle, rangle, lbrace, rbrace, lbracket, rbracket, lparen, rparen, -    -- * Bracketing combinators-    enclose,-    angles, backquotes, braces, brackets, dquotes, parens, parensIf, squotes,+    -- ** Basic document combinators+    empty,+    srcloc, line, softline, softbreak,+    (<>), (<|>), (<+>), (</>), (<+/>), (<//>),+    group, -    -- * Alignment and indentation-    align, hang, indent,+    -- ** Wrapping documents in delimiters+    enclose, squotes, dquotes, angles, backquotes, braces, brackets, parens,+    parensIf,      -- * Combining lists of documents     folddoc, spread, stack, cat, sep,     punctuate, commasep, semisep,-    encloseSep,-    tuple, list,+    enclosesep, tuple, list, +    -- ** Alignment and indentation+    align, hang, indent,+    nest, column, nesting,+    width, fill, fillbreak,++    -- ** Utilities+    faildoc, errordoc,+     -- * The rendered document type     RDoc(..), @@ -63,12 +72,10 @@     displayPragmaLazyText, prettyPragmaLazyText,      -- * Document output-    putDoc, hPutDoc,+    putDoc, putDocLn, hPutDoc, hPutDocLn,      -- * The 'Pretty' type class for pretty printing-    Pretty(..),--    faildoc, errordoc+    Pretty(..)   ) where  import Data.Int@@ -85,6 +92,7 @@ import Data.Monoid (Monoid(..)) #endif /* !MIN_VERSION_base(4,5,0) */ import qualified Data.Set as Set+import Data.String (IsString(..)) import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TIO import qualified Data.Text.Lazy as L@@ -93,30 +101,49 @@ import GHC.Real (Ratio(..)) import System.IO (Handle) -data Doc = Empty                -- ^ The empty document-         | Char Char            -- ^ A single character-         | String !Int String   -- ^ 'String' with associated length (to avoid-                                -- recomputation)-         | Text T.Text          -- ^ 'T.Text'-         | LazyText L.Text      -- ^ 'L.Text'-         | Line                 -- ^ Newline-         | Nest !Int Doc        -- ^ Indented document-         | SrcLoc Loc           -- ^ Tag output with source location-         | Doc `Cat` Doc        -- ^ Document concatenation-         | Doc `Alt` Doc        -- ^ Provide alternatives. Invariant: both-                                -- arguments must flatten to the same document.-         | Column  (Int -> Doc) -- ^ Calculate document based on current column-         | Nesting (Int -> Doc) -- ^ Calculate document based on current nesting+-- | The abstract type of documents.+data Doc -- | The empty document+         =  Empty+         -- | A single character+         | Char {-# UNPACK #-} !Char+         -- | 'String' with associated length (to avoid recomputation)+         | String {-# UNPACK #-} !Int String+         -- | 'T.Text'+         | Text T.Text+         -- | 'L.Text'+         | LazyText L.Text+         -- | Newline+         | Line+         -- | Indented document+         | Nest {-# UNPACK #-} !Int Doc+         -- | Tag output with source location+         | SrcLoc Loc+         -- | Document concatenation+         | Doc `Cat` Doc+         -- | Provide alternatives. Invariant: both arguments must flatten to+         -- the same document.+         | Doc `Alt` Doc+         -- | Calculate document based on current column+         | Column  (Int -> Doc)+         -- | Calculate document based on current nesting+         | Nesting (Int -> Doc) --- | The empty document.-empty :: Doc-empty = Empty+instance Monoid Doc where+    mempty  = empty+    mappend = Cat +instance IsString Doc where+    fromString s = string s+ -- | The document @'text' s@ consists of the string @s@, which should not -- contain any newlines. For a string that may include newlines, use 'string'. text :: String -> Doc text s = String (length s) s +-- | The document @bool b@ is equivalent to @text (show b)@.+bool :: Bool -> Doc+bool b = text (show b)+ -- | The document @'char' c@ consists the single character @c@. char :: Char -> Doc char '\n' = line@@ -130,108 +157,40 @@ string s          = case span (/= '\n') s of                       (xs, ys) -> text xs <> string ys --- | The document @'fromText' s@ consists of the 'T.Text' @s@, which should not--- contain any newlines.-fromText :: T.Text -> Doc-fromText = Text---- | The document @'fromLazyText' s@ consists of the 'L.Text' @s@, which should--- not contain any newlines.-fromLazyText :: L.Text -> Doc-fromLazyText = LazyText---- | The document @'line'@ advances to the next line and indents to the current--- indentation level. When undone by 'group', it behaves like 'space'.-line :: Doc-line = Line---- | The document @'nest' i d@ renders the document @d@ with the current--- indentation level increased by @i@.-nest :: Int -> Doc -> Doc-nest i d = Nest i d---- | The document @'srcloc' x@ tags the current line with @'locOf' x@. Only--- shown when running 'prettyPragma' and friends.-srcloc :: Located a => a -> Doc-srcloc x = SrcLoc (locOf x)---- | The document @'column' f@ is produced by calling @f@ with the current colum.-column :: (Int -> Doc) -> Doc-column = Column---- | The document @'column' f@ is produced by calling @f@ with the--- current nesting level.-nesting :: (Int -> Doc) -> Doc-nesting = Nesting---- | Becomes 'space' if there is room, otherwise 'line'.------ > pretty 11 $ text "foo" <+/> text "bar" <+/> text "baz" =="foo bar baz"--- > pretty  7 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo bar\nbaz"--- > pretty  6 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo\nbar\nbaz"-softline :: Doc-softline = space `Alt` line---- | Becomes 'empty' if there is room, otherwise 'line'.-softbreak :: Doc-softbreak = empty `Alt` line---- | The document @'group' d@ will flatten @d@ to /one/ line if there is--- room for it, otherwise the original @d@.-group :: Doc -> Doc-group d = flatten d `Alt` d--flatten :: Doc -> Doc-flatten Empty        = Empty-flatten (Char c)     = Char c-flatten (String l s) = String l s-flatten (Text s)     = Text s-flatten (LazyText s) = LazyText s-flatten Line         = Char ' '-flatten (x `Cat` y)  = flatten x `Cat` flatten y-flatten (Nest i x)   = Nest i (flatten x)-flatten (x `Alt` _)  = flatten x-flatten (SrcLoc loc) = SrcLoc loc-flatten (Column f)   = Column (flatten . f)-flatten (Nesting f)  = Nesting (flatten . f)--#if !MIN_VERSION_base(4,5,0)-infixr 6 <>-#endif /* !MIN_VERSION_base(4,5,0) */-infixr 6 <+>-infixr 5 </>, <+/>, <//>-infixl 3 <|>+-- | The document @int i@ is equivalent to @text (show i)@.+int :: Int -> Doc+int i = text (show i) -#if !MIN_VERSION_base(4,5,0)--- | Concatenates two documents.-(<>) :: Doc -> Doc -> Doc-x <> y = x `Cat` y-#endif /* !MIN_VERSION_base(4,5,0) */+-- | The document @integer i@ is equivalent to @text (show i)@.+-- 'text'.+integer :: Integer -> Doc+integer i = text (show i) --- | Concatenates two documents with a 'space' in between.-(<+>) :: Doc -> Doc -> Doc-x <+> y = x <> space <> y+-- | The document @float f@ is equivalent to @text (show f)@.+float :: Float -> Doc+float f = text (show f) --- | Concatenates two documents with a 'line' in between.-(</>) :: Doc -> Doc -> Doc-x </> y = x <> line <> y+-- | The document @double d@ is equivalent to @text (show d)@.+double :: Double -> Doc+double d = text (show d) --- | Concatenates two documents with a 'softline' in between.-(<+/>) :: Doc -> Doc -> Doc-x <+/> y = x <> softline <> y+-- | The document @rational r@ is equivalent to @text (show r)@.+rational :: Rational -> Doc+rational r = text (show r) --- | Concatenates two documents with a 'softbreak' in between.-(<//>) :: Doc -> Doc -> Doc-x <//> y = x <> softbreak <> y+-- | The document @'strictText' s@ consists of the 'T.Text' @s@, which should+-- not contain any newlines.+strictText :: T.Text -> Doc+strictText = Text --- | Provide alternative layouts of the same content. Invariant: both arguments must--- flatten to the same document.-(<|>) :: Doc -> Doc -> Doc-x <|> y = x `Alt` y+-- | The document @'lazyText' s@ consists of the 'L.Text' @s@, which should+-- not contain any newlines.+lazyText :: L.Text -> Doc+lazyText = LazyText --- | The document @backquote@ consists of a backquote, @\"`\"@.-backquote :: Doc-backquote = char '`'+-- | The document @star@ consists of an asterisk, @\"*\"@.+star :: Doc+star = char '*'  -- | The document @colon@ consists of a colon, @\":\"@. colon :: Doc@@ -245,10 +204,6 @@ dot :: Doc dot = char '.' --- | The document @dquote@ consists of a double quote, @\"\\\"\"@.-dquote :: Doc-dquote = char '"'- -- | The document @equals@ consists of an equals sign, @\"=\"@. equals :: Doc equals = char '='@@ -265,13 +220,17 @@ spaces :: Int -> Doc spaces n = text (replicate n ' ') +-- | The document @backquote@ consists of a backquote, @\"`\"@.+backquote :: Doc+backquote = char '`'+ -- | The document @squote@ consists of a single quote, @\"\\'\"@. squote :: Doc squote = char '\'' --- | The document @star@ consists of an asterisk, @\"*\"@.-star :: Doc-star = char '*'+-- | The document @dquote@ consists of a double quote, @\"\\\"\"@.+dquote :: Doc+dquote = char '"'  -- | The document @langle@ consists of a less-than sign, @\"<\"@. langle :: Doc@@ -305,6 +264,91 @@ rparen :: Doc rparen = char ')' +-- | The empty document.+empty :: Doc+empty = Empty++-- | The document @'srcloc' x@ tags the current line with @'locOf' x@. Only+-- shown when running 'prettyPragma' and friends.+srcloc :: Located a => a -> Doc+srcloc x = SrcLoc (locOf x)++-- | The document @'line'@ advances to the next line and indents to the current+-- indentation level. When undone by 'group', it behaves like 'space'.+line :: Doc+line = Line++-- | Becomes 'space' if there is room, otherwise 'line'.+--+-- > pretty 11 $ text "foo" <+/> text "bar" <+/> text "baz" =="foo bar baz"+-- > pretty  7 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo bar\nbaz"+-- > pretty  6 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo\nbar\nbaz"+softline :: Doc+softline = space `Alt` line++-- | Becomes 'empty' if there is room, otherwise 'line'.+softbreak :: Doc+softbreak = empty `Alt` line++#if !MIN_VERSION_base(4,5,0)+infixr 6 <>+#endif /* !MIN_VERSION_base(4,5,0) */+infixr 6 <+>+infixr 5 </>, <+/>, <//>+infixl 3 <|>++#if !MIN_VERSION_base(4,5,0)+-- | Concatenates two documents.+(<>) :: Doc -> Doc -> Doc+x <> y = x `Cat` y+#endif /* !MIN_VERSION_base(4,5,0) */++-- | Concatenates two documents with a 'space' in between, with identity+-- 'empty'.+(<+>) :: Doc -> Doc -> Doc+Empty <+> y     = y+x     <+> Empty = x+x     <+> y     = x <> space <> y++-- | Concatenates two documents with a 'line' in between.+(</>) :: Doc -> Doc -> Doc+x </> y = x <> line <> y++-- | Concatenates two documents with a 'softline' in between, with identity+-- 'empty'.+(<+/>) :: Doc -> Doc -> Doc+Empty <+/> y     = y+x     <+/> Empty = x+x     <+/> y     = x <> softline <> y++-- | Concatenates two documents with a 'softbreak' in between.+(<//>) :: Doc -> Doc -> Doc+x <//> y = x <> softbreak <> y++-- | Provide alternative layouts of the same content. Invariant: both arguments+-- must flatten to the same document.+(<|>) :: Doc -> Doc -> Doc+x <|> y = x `Alt` y++-- | The document @'group' d@ will flatten @d@ to /one/ line if there is+-- room for it, otherwise the original @d@.+group :: Doc -> Doc+group d = flatten d `Alt` d++flatten :: Doc -> Doc+flatten Empty        = Empty+flatten (Char c)     = Char c+flatten (String l s) = String l s+flatten (Text s)     = Text s+flatten (LazyText s) = LazyText s+flatten Line         = Char ' '+flatten (x `Cat` y)  = flatten x `Cat` flatten y+flatten (Nest i x)   = Nest i (flatten x)+flatten (x `Alt` _)  = flatten x+flatten (SrcLoc loc) = SrcLoc loc+flatten (Column f)   = Column (flatten . f)+flatten (Nesting f)  = Nesting (flatten . f)+ -- | The document @'enclose' l r d@ encloses the document @d@ between the -- documents @l@ and @r@ using @<>@. It obeys the law --@@ -312,6 +356,14 @@ enclose :: Doc -> Doc -> Doc -> Doc enclose left right d = left <> d <> right +-- | The document @'squotes' d@ encloses the alinged document @d@ in \'...\'.+squotes :: Doc -> Doc+squotes = enclose squote squote . align++-- | The document @'dquotes' d@ encloses the aligned document @d@ in "...".+dquotes :: Doc -> Doc+dquotes = enclose dquote dquote . align+ -- | The document @'angles' d@ encloses the aligned document @d@ in \<...\>. angles :: Doc -> Doc angles = enclose langle rangle . align@@ -320,17 +372,13 @@ backquotes :: Doc -> Doc backquotes = enclose backquote backquote . align --- | The document @'brackets' d@ encloses the aligned document @d@ in [...].-brackets :: Doc -> Doc-brackets = enclose lbracket rbracket . align- -- | The document @'braces' d@ encloses the aligned document @d@ in {...}. braces :: Doc -> Doc braces = enclose lbrace rbrace . align --- | The document @'dquotes' d@ encloses the aligned document @d@ in "...".-dquotes :: Doc -> Doc-dquotes = enclose dquote dquote . align+-- | The document @'brackets' d@ encloses the aligned document @d@ in [...].+brackets :: Doc -> Doc+brackets = enclose lbracket rbracket . align  -- | The document @'parens' d@ encloses the aligned document @d@ in (...). parens :: Doc -> Doc@@ -341,28 +389,6 @@ parensIf :: Bool -> Doc -> Doc parensIf True doc  = parens doc parensIf False doc = doc---- | The document @'squotes' d@ encloses the alinged document @d@ in \'...\'.-squotes :: Doc -> Doc-squotes = enclose squote squote . align---- | The document @'align' d@ renders @d@ with a nesting level set to the current--- column.-align :: Doc -> Doc-align d = column  $ \k ->-          nesting $ \i ->-          nest (k - i) d---- | The document @'hang' i d@ renders @d@ with a nesting level set to the--- current column plus @i@, /not including/ the first line.-hang :: Int -> Doc -> Doc-hang i d = align (nest i d)---- | The document @'indent' i d@ renders @d@ with a nesting level set to the--- current column plus @i@, /including/ the first line.-indent :: Int -> Doc -> Doc-indent i d = align (nest i (spaces i <> d))- -- | The document @'folddoc' f ds@ obeys the laws: -- -- * @'folddoc' f [] = 'empty'@@@ -408,14 +434,14 @@ semisep :: [Doc] -> Doc semisep = align . sep . punctuate semi --- | The document @'encloseSep' l r p ds@ separates @ds@ with the punctuation @p@+-- | The document @'enclosesep' l r p ds@ separates @ds@ with the punctuation @p@ -- and encloses the result using @l@ and @r@. When wrapped, punctuation appears -- at the end of the line. The enclosed portion of the document is aligned one -- column to the right of the opening document. -- -- @ -- \> ws = map text (words \"The quick brown fox jumps over the lazy dog\")--- \> test = pretty 15 (encloseSep lparen rparen comma ws)+-- \> test = pretty 15 (enclosesep lparen rparen comma ws) -- @ -- -- will be layed out as:@@ -427,8 +453,8 @@ --  the, lazy, --  dog) -- @-encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc-encloseSep left right p ds =+enclosesep :: Doc -> Doc -> Doc -> [Doc] -> Doc+enclosesep left right p ds =     case ds of       [] ->  left <> right       [d] -> left <> d <> right@@ -437,25 +463,171 @@ -- | The document @'tuple' ds@ separates @ds@ with commas and encloses them with -- parentheses. tuple :: [Doc] -> Doc-tuple = encloseSep lparen rparen comma+tuple = enclosesep lparen rparen comma  -- | The document @'list' ds@ separates @ds@ with commas and encloses them with -- brackets. list :: [Doc] -> Doc-list = encloseSep lbracket rbracket comma+list = enclosesep lbracket rbracket comma +-- | The document @'align' d@ renders @d@ with a nesting level set to the current+-- column.+align :: Doc -> Doc+align d = column  $ \k ->+          nesting $ \i ->+          nest (k - i) d++-- | The document @'hang' i d@ renders @d@ with a nesting level set to the+-- current column plus @i@, /not including/ the first line.+hang :: Int -> Doc -> Doc+hang i d = align (nest i d)++-- | The document @'indent' i d@ renders @d@ with a nesting level set to the+-- current column plus @i@, /including/ the first line.+indent :: Int -> Doc -> Doc+indent i d = align (nest i (spaces i <> d))++-- | The document @'nest' i d@ renders the document @d@ with the current+-- indentation level increased by @i@.+nest :: Int -> Doc -> Doc+nest i d = Nest i d++-- | The document @'column' f@ is produced by calling @f@ with the current+-- column.+column :: (Int -> Doc) -> Doc+column = Column++-- | The document @'column' f@ is produced by calling @f@ with the+-- current nesting level.+nesting :: (Int -> Doc) -> Doc+nesting = Nesting++-- | The document @'width' d f@ is produced by concatenating @d@ with the result+-- of calling @f@ with the width of the document @d@.+width :: Doc -> (Int -> Doc) -> Doc+width d f = column $ \k1 -> d <> (column $ \k2 -> f (k2 - k1))++-- | The document @'fill' i d@ renders document @x@, appending+-- @space@s until the width is equal to @i@. If the width of @d@ is already+-- greater than @i@, nothing is appended.+fill :: Int -> Doc -> Doc+fill f d = width d $ \w ->+           if w >= f+           then empty+           else spaces (f - w)++-- | The document @'fillbreak' i d@ renders document @d@, appending @'space'@s+-- until the width is equal to @i@. If the width of @d@ is already greater than+-- @i@, the nesting level is increased by @i@ and a @line@ is appended.+fillbreak :: Int -> Doc -> Doc+fillbreak f d = width d $ \w ->+                if (w > f)+                then nest f line+                else spaces (f - w)+ -- | Equivalent of 'fail', but with a document instead of a string. faildoc :: Monad m => Doc -> m a-faildoc = fail . show+faildoc = fail . pretty 80  -- | Equivalent of 'error', but with a document instead of a string. errordoc :: Doc -> a-errordoc = error . show+errordoc = error . pretty 80 +-- | A rendered document.+data RDoc -- | The empty document+          = REmpty+          -- | A single character+          | RChar {-# UNPACK #-} !Char RDoc+          -- | 'String' with associated length (to avoid recomputation)+          | RString {-# UNPACK #-} !Int String RDoc+          -- | 'T.Text'+          | RText T.Text RDoc+          -- | 'L.Text'+          | RLazyText L.Text RDoc+          -- | Tag output with source location+          | RPos Pos RDoc+          -- | A newline with the indentation of the subsequent line+          | RLine {-# UNPACK #-} !Int RDoc+ -- | Render a document given a maximum width. render :: Int -> Doc -> RDoc render w x = best w 0 x +type RDocS = RDoc -> RDoc++data Docs -- | No document.+          = Nil+          -- | Indentation, document and tail+          | Cons {-# UNPACK #-} !Int Doc Docs++best :: Int -> Int -> Doc -> RDoc+best !w k x = be Nothing Nothing k id (Cons 0 x Nil)+  where+    be :: Maybe Pos -- ^ Previous source position+       -> Maybe Pos -- ^ Current source position+       -> Int       -- ^ Current column+       -> RDocS+       -> Docs+       -> RDoc+    be  _ _  !_  f Nil           = f REmpty+    be  p p' !k  f (Cons i d ds) =+        case d of+          Empty      -> be p p' k f ds+          Char c     -> be p p' (k+1) (f . RChar c) ds+          String l s -> be p p' (k+l) (f . RString l s) ds+          Text s     -> be p p' (k+T.length s) (f . RText s) ds+          LazyText s -> be p p' (k+fromIntegral (L.length s)) (f . RLazyText s) ds+          Line       -> (f . pragma . RLine i) (be p'' Nothing i id ds)+          x `Cat` y  -> be p p' k f (Cons i x (Cons i y ds))+          Nest j x   -> be p p' k f (Cons (i+j) x ds)+          x `Alt` y  -> better k f (be p p' k id (Cons i x ds))+                                   (be p p' k id (Cons i y ds))+          SrcLoc loc -> be p (merge p' loc) k f ds+          Column g   -> be p p' k f (Cons i (g k) ds)+          Nesting g  -> be p p' k f (Cons i (g i) ds)+      where+        (p'', pragma) = lineloc p p'++    better :: Int -> RDocS -> RDoc -> RDoc -> RDoc+    better !k f x y | fits (w - k) x = f x+                    | otherwise      = f y++    fits :: Int -> RDoc -> Bool+    fits  !w  _        | w < 0 = False+    fits  !_  REmpty           = True+    fits  !w  (RChar _ x)      = fits (w - 1) x+    fits  !w  (RString l _ x)  = fits (w - l) x+    fits  !w  (RText s x)      = fits (w - T.length s) x+    fits  !w  (RLazyText s x)  = fits (w - fromIntegral (L.length s)) x+    fits  !w  (RPos _ x)       = fits w x+    fits  !_  (RLine _ _)      = True++    merge :: Maybe Pos -> Loc -> Maybe Pos+    merge  Nothing   NoLoc       = Nothing+    merge  Nothing   (Loc p _)   = Just p+    merge  (Just p)  NoLoc       = Just p+    merge  (Just p1) (Loc p2 _)  = let p = min p1 p2 in p `seq` Just p++    lineloc :: Maybe Pos          -- ^ Previous source position+            -> Maybe Pos          -- ^ Current source position+            -> (Maybe Pos, RDocS) -- ^ Current source position and position to+                                  -- output+    lineloc Nothing   Nothing          = (Nothing, id)+    lineloc Nothing   (Just p)         = (Just p, RPos p)+    lineloc (Just p1) (Just p2)+        | posFile p2 == posFile p1 &&+          posLine p2 == posLine p1 + 1 = (Just p2, id)+        | otherwise                    = (Just p2, RPos p2)+    lineloc (Just p1)  Nothing+        | posFile p2 == posFile p1 &&+          posLine p2 == posLine p1 + 1 = (Just p2, id)+        | otherwise                    = (Just p2, RPos p2)+      where+        p2 = advance p1++        advance :: Pos -> Pos+        advance (Pos f l c coff) = Pos f (l+1) c coff+ -- | Render a document without indentation on infinitely long lines. Since no -- \'pretty\' printing is involved, this renderer is fast. The resulting output -- contains fewer characters.@@ -579,106 +751,28 @@ prettyPragmaLazyText :: Int -> Doc -> L.Text prettyPragmaLazyText w x = displayPragmaLazyText (render w x) -merge :: Maybe Pos -> Loc -> Maybe Pos-merge  Nothing   NoLoc       = Nothing-merge  Nothing   (Loc p _)   = Just p-merge  (Just p)  NoLoc       = Just p-merge  (Just p1) (Loc p2 _)  = let p = min p1 p2 in p `seq` Just p--lineloc :: Maybe Pos          -- ^ Previous source position-        -> Maybe Pos          -- ^ Current source position-        -> (Maybe Pos, RDocS) -- ^ Current source position and position to-                              -- output-lineloc Nothing   Nothing          = (Nothing, id)-lineloc Nothing   (Just p)         = (Just p, RPos p)-lineloc (Just p1) (Just p2)-    | posFile p2 == posFile p1 &&-      posLine p2 == posLine p1 + 1 = (Just p2, id)-    | otherwise                    = (Just p2, RPos p2)-lineloc (Just p1)  Nothing-    | posFile p2 == posFile p1 &&-      posLine p2 == posLine p1 + 1 = (Just p2, id)-    | otherwise                    = (Just p2, RPos p2)-  where-    p2 = advance p1--    advance :: Pos -> Pos-    advance (Pos f l c coff) = Pos f (l+1) c coff---- | A rendered document.-data RDoc = REmpty                   -- ^ The empty document-          | RChar Char RDoc          -- ^ A single character-          | RString !Int String RDoc -- ^ 'String' with associated length (to-                                     -- avoid recomputation)-          | RText T.Text RDoc        -- ^ 'T.Text'-          | RLazyText L.Text RDoc    -- ^ 'L.Text'-          | RPos Pos RDoc            -- ^ Tag output with source location-          | RLine !Int RDoc          -- ^ A newline with the indentation of the-                                     -- subsequent line--type RDocS = RDoc -> RDoc--data Docs = Nil                -- ^ No document.-          | Cons !Int Doc Docs -- ^ Indentation, document and tail--best :: Int -> Int -> Doc -> RDoc-best !w k x = be Nothing Nothing k id (Cons 0 x Nil)-  where-    be :: Maybe Pos -- ^ Previous source position-       -> Maybe Pos -- ^ Current source position-       -> Int       -- ^ Current column-       -> RDocS-       -> Docs-       -> RDoc-    be  _ _  !_  f Nil           = f REmpty-    be  p p' !k  f (Cons i d ds) =-        case d of-          Empty      -> be p p' k f ds-          Char c     -> be p p' (k+1) (f . RChar c) ds-          String l s -> be p p' (k+l) (f . RString l s) ds-          Text s     -> be p p' (k+T.length s) (f . RText s) ds-          LazyText s -> be p p' (k+fromIntegral (L.length s)) (f . RLazyText s) ds-          Line       -> (f . pragma . RLine i) (be p'' Nothing i id ds)-          x `Cat` y  -> be p p' k f (Cons i x (Cons i y ds))-          Nest j x   -> be p p' k f (Cons (i+j) x ds)-          x `Alt` y  -> better k f (be p p' k id (Cons i x ds))-                                   (be p p' k id (Cons i y ds))-          SrcLoc loc -> be p (merge p' loc) k f ds-          Column g   -> be p p' k f (Cons i (g k) ds)-          Nesting g  -> be p p' k f (Cons i (g i) ds)-      where-        (p'', pragma) = lineloc p p'--    better :: Int -> RDocS -> RDoc -> RDoc -> RDoc-    better !k f x y | fits (w - k) x = f x-                    | otherwise      = f y--    fits :: Int -> RDoc -> Bool-    fits  !w  _        | w < 0 = False-    fits  !_  REmpty           = True-    fits  !w  (RChar _ x)      = fits (w - 1) x-    fits  !w  (RString l _ x)  = fits (w - l) x-    fits  !w  (RText s x)      = fits (w - T.length s) x-    fits  !w  (RLazyText s x)  = fits (w - fromIntegral (L.length s)) x-    fits  !w  (RPos _ x)       = fits w x-    fits  !_  (RLine _ _)      = True- -- | Render a document with a width of 80 and print it to standard output. putDoc :: Doc -> IO () putDoc = TIO.putStr . prettyLazyText 80 +-- | Render a document with a width of 80 and print it to standard output,+-- followed by a newline.+putDocLn :: Doc -> IO ()+putDocLn = TIO.putStrLn . prettyLazyText 80+ -- | Render a document with a width of 80 and print it to the specified handle. hPutDoc :: Handle -> Doc -> IO () hPutDoc h = TIO.hPutStr h . prettyLazyText 80 -instance Monoid Doc where-    mempty  = empty-    mappend = Cat--instance Show Doc where-    showsPrec _ = prettyS 80+-- | Render a document with a width of 80 and print it to the specified handle,+-- followed by a newline.+hPutDocLn :: Handle -> Doc -> IO ()+hPutDocLn h = TIO.hPutStrLn h . prettyLazyText 80  class Pretty a where+#if __GLASGOW_HASKELL__ >= 708+    {-# MINIMAL pprPrec | ppr #-}+#endif     ppr     :: a -> Doc     pprPrec :: Int -> a -> Doc     pprList :: [a] -> Doc@@ -687,17 +781,31 @@     pprPrec _  = ppr     pprList xs = list (map ppr xs) +instance Pretty a => Pretty [a] where+    ppr = pprList++instance Pretty a => Pretty (Maybe a) where+    pprPrec _ Nothing  = empty+    pprPrec p (Just a) = pprPrec p a++instance Pretty Bool where+    ppr = bool++instance Pretty Char where+    ppr     = char+    pprList = string+ instance Pretty Int where-    ppr = text . show+    ppr = int  instance Pretty Integer where-    ppr = text . show+    ppr = integer  instance Pretty Float where-    ppr = text . show+    ppr = float  instance Pretty Double where-    ppr = text . show+    ppr = double  ratioPrec, ratioPrec1 :: Int ratioPrec  = 7  -- Precedence of ':%' constructor@@ -709,22 +817,65 @@         parensIf (p > ratioPrec) $         pprPrec ratioPrec1 x <+> char '%' <+> pprPrec ratioPrec1 y -instance Pretty Bool where+instance Pretty Word8 where     ppr = text . show -instance Pretty Char where-    ppr     = text . show-    pprList = text . show+instance Pretty Word16 where+    ppr = text . show -instance Pretty T.Text where+instance Pretty Word32 where     ppr = text . show -instance Pretty L.Text where+instance Pretty Word64 where     ppr = text . show -instance Pretty a => Pretty [a] where-    ppr = pprList+instance Pretty Int8 where+    ppr = text . show +instance Pretty Int16 where+    ppr = text . show++instance Pretty Int32 where+    ppr = text . show++instance Pretty Int64 where+    ppr = text . show++instance Pretty T.Text where+    ppr = strictText++instance Pretty L.Text where+    ppr = lazyText++instance Pretty Pos where+    ppr p@(Pos _ l c _) =+        text (posFile p) <> colon <> ppr l <> colon <> ppr c++instance Pretty Loc where+    ppr NoLoc = text "<no location info>"++    ppr (Loc p1@(Pos f1 l1 c1 _) p2@(Pos f2 l2 c2 _))+        | f1 == f2   = text (posFile p1) <> colon <//> pprLineCol l1 c1 l2 c2+        | otherwise  = ppr p1 <> text "-" <> ppr p2+      where+        pprLineCol :: Int -> Int -> Int -> Int -> Doc+        pprLineCol l1 c1 l2 c2+            | l1 == l2 && c1 == c2  =  ppr l1 <//> colon <//> ppr c1+            | l1 == l2 && c1 /= c2  =  ppr l1 <//> colon <//>+                                       ppr c1 <> text "-" <> ppr c2+            | otherwise             =  ppr l1 <//> colon <//> ppr c1+                                       <> text "-" <>+                                       ppr l2 <//> colon <//> ppr c2++instance Pretty x => Pretty (L x) where+    pprPrec p (L _ x) = pprPrec p x++instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where+    ppr = pprList . Map.toList++instance Pretty a => Pretty (Set.Set a) where+    ppr = pprList . Set.toList+ instance Pretty () where     ppr () =         tuple []@@ -828,60 +979,3 @@         tuple [ppr a, ppr b, ppr c, ppr d, ppr e,                ppr f, ppr g, ppr h, ppr i, ppr j,                ppr k, ppr l, ppr m, ppr n, ppr o]--instance Pretty a => Pretty (Maybe a) where-    pprPrec _ Nothing  = empty-    pprPrec p (Just a) = pprPrec p a--instance Pretty Pos where-    ppr p@(Pos _ l c _) =-        text (posFile p) <> colon <> ppr l <> colon <> ppr c--instance Pretty Loc where-    ppr NoLoc = text "<no location info>"--    ppr (Loc p1@(Pos f1 l1 c1 _) p2@(Pos f2 l2 c2 _))-        | f1 == f2   = text (posFile p1) <> colon <//> pprLineCol l1 c1 l2 c2-        | otherwise  = ppr p1 <> text "-" <> ppr p2-      where-        pprLineCol :: Int -> Int -> Int -> Int -> Doc-        pprLineCol l1 c1 l2 c2-            | l1 == l2 && c1 == c2  =  ppr l1 <//> colon <//> ppr c1-            | l1 == l2 && c1 /= c2  =  ppr l1 <//> colon <//>-                                       ppr c1 <> text "-" <> ppr c2-            | otherwise             =  ppr l1 <//> colon <//> ppr c1-                                       <> text "-" <>-                                       ppr l2 <//> colon <//> ppr c2--instance Pretty x => Pretty (L x) where-    pprPrec p (L _ x) = pprPrec p x--instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where-    ppr = pprList . Map.toList--instance Pretty a => Pretty (Set.Set a) where-    ppr = pprList . Set.toList--instance Pretty Word8 where-    ppr = text . show--instance Pretty Word16 where-    ppr = text . show--instance Pretty Word32 where-    ppr = text . show--instance Pretty Word64 where-    ppr = text . show--instance Pretty Int8 where-    ppr = text . show--instance Pretty Int16 where-    ppr = text . show--instance Pretty Int32 where-    ppr = text . show--instance Pretty Int64 where-    ppr = text . show

@@ -1,5 +1,5 @@ name:           mainland-pretty-version:        0.3.0.0+version:        0.4.0.0 cabal-version:  >= 1.6 license:        BSD3 license-file:   LICENSE