mainland-pretty 0.2.7.2 → 0.7.1.1
raw patch · 4 files changed
Files
- LICENSE +1/−1
- Text/PrettyPrint/Mainland.hs +482/−505
- Text/PrettyPrint/Mainland/Class.hs +279/−0
- mainland-pretty.cabal +31/−14
LICENSE view
@@ -48,7 +48,7 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -Copyright (c) 2015+Copyright (c) 2015-2024 Drexel University. Redistribution and use in source and binary forms, with or without
Text/PrettyPrint/Mainland.hs view
@@ -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-2017 Drexel University -- License : BSD-style--- Maintainer : mainland@eecs.harvard.edu+-- Maintainer : mainland@drexel.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,51 +28,53 @@ -- * 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, flatten, - -- * 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(..), -- * Document rendering render, renderCompact,- displayS, prettyS, pretty,+ displayS, prettyS, pretty, prettyCompactS, prettyCompact, displayPragmaS, prettyPragmaS, prettyPragma, displayLazyText, prettyLazyText, displayPragmaLazyText, prettyPragmaLazyText, -- * Document output- putDoc, hPutDoc,-- -- * The 'Pretty' type class for pretty printing- Pretty(..),-- faildoc, errordoc+ putDoc, putDocLn, hPutDoc, hPutDocLn ) where -import Data.Int import Data.Loc (L(..), Loc(..), Located(..),@@ -79,44 +82,70 @@ posFile, posLine) import qualified Data.Map as Map+#if !(MIN_VERSION_base(4,9,0)) import Data.Monoid (Monoid(..), (<>))+#endif /* !(MIN_VERSION_base(4,9,0)) */+#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif 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 import qualified Data.Text.Lazy.Builder as B-import Data.Word-import GHC.Real (Ratio(..)) import System.IO (Handle) -infixr 5 </>, <+/>, <//>-infixr 6 <+>+-- | 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) -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. Invariants: all- -- layouts of the two arguments flatten to the- -- same layout- | Column (Int -> Doc) -- ^ Calculate document based on current column- | Nesting (Int -> Doc) -- ^ Calculate document based on current nesting+#if MIN_VERSION_base(4,9,0)+instance Semigroup Doc where+ (<>) = Cat+#endif --- | The empty document.-empty :: Doc-empty = Empty+instance Monoid Doc where+ mempty = empty+#if !(MIN_VERSION_base(4,11,0))+ mappend = Cat+#endif +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,100 +159,62 @@ 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@ adds the.-srcloc :: Located a => a -> Doc-srcloc x = SrcLoc (locOf x)--column :: (Int -> Doc) -> Doc-column = Column--nesting :: (Int -> Doc) -> Doc-nesting = Nesting--softline :: Doc-softline = space `Alt` line--softbreak :: Doc-softbreak = empty `Alt` line+-- | The document @int i@ is equivalent to @text (show i)@.+int :: Int -> Doc+int i = text (show i) -group :: Doc -> Doc-group d = flatten d `Alt` d+-- | The document @integer i@ is equivalent to @text (show i)@.+-- 'text'.+integer :: Integer -> Doc+integer i = text (show i) -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 @float f@ is equivalent to @text (show f)@.+float :: Float -> Doc+float f = text (show f) -(<+>) :: Doc -> Doc -> Doc-x <+> y = x <> space <> y+-- | The document @double d@ is equivalent to @text (show d)@.+double :: Double -> Doc+double d = text (show d) -(</>) :: Doc -> Doc -> Doc-x </> y = x <> line <> y+-- | The document @rational r@ is equivalent to @text (show r)@.+rational :: Rational -> Doc+rational r = text (show r) -(<+/>) :: Doc -> Doc -> Doc-x <+/> y = x <> softline <> y+-- | The document @'strictText' s@ consists of the 'T.Text' @s@, which should+-- not contain any newlines.+strictText :: T.Text -> Doc+strictText = Text -(<//>) :: Doc -> Doc -> Doc-x <//> y = x <> softbreak <> 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, \":\".+-- | The document @colon@ consists of a colon, @\":\"@. colon :: Doc colon = char ':' --- | The document @comma@ consists of a comma, \",\".+-- | The document @comma@ consists of a comma, @\",\"@. comma :: Doc comma = char ',' --- | The document @dot@ consists of a period, \".\".+-- | The document @dot@ consists of a period, @\".\"@. dot :: Doc dot = char '.' --- | The document @dquote@ consists of a double quote, \"\\\"\".-dquote :: Doc-dquote = char '"'---- | The document @equals@ consists of an equals sign, \"=\".+-- | The document @equals@ consists of an equals sign, @\"=\"@. equals :: Doc equals = char '=' --- | The document @semi@ consists of a semicolon, \";\".+-- | The document @semi@ consists of a semicolon, @\";\"@. semi :: Doc semi = char ';' --- | The document @space@ consists of a space, \" \".+-- | The document @space@ consists of a space, @\" \"@. space :: Doc space = char ' ' @@ -231,72 +222,169 @@ spaces :: Int -> Doc spaces n = text (replicate n ' ') --- | The document @squote@ consists of a single quote, \"\\'\".+-- | 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, \"<\".+-- | The document @langle@ consists of a less-than sign, @\"<\"@. langle :: Doc langle = char '<' --- | The document @rangle@ consists of a greater-than sign, \">\".+-- | The document @rangle@ consists of a greater-than sign, @\">\"@. rangle :: Doc rangle = char '>' --- | The document @lbrace@ consists of a left brace, \"{\".+-- | The document @lbrace@ consists of a left brace, @\"{\"@. lbrace :: Doc lbrace = char '{' --- | The document @rbrace@ consists of a right brace, \"}\".+-- | The document @rbrace@ consists of a right brace, @\"}\"@. rbrace :: Doc rbrace = char '}' --- | The document @lbracket@ consists of a right brace, \"[\".+-- | The document @lbracket@ consists of a right brace, @\"[\"@. lbracket :: Doc lbracket = char '[' --- | The document @rbracket@ consists of a right brace, \"]\".+-- | The document @rbracket@ consists of a right brace, @\"]\"@. rbracket :: Doc rbracket = char ']' --- | The document @lparen@ consists of a right brace, \"(\".+-- | The document @lparen@ consists of a right brace, @\"(\"@. lparen :: Doc lparen = char '(' --- | The document @rparen@ consists of a right brace, \")\".+-- | The document @rparen@ consists of a right brace, @\")\"@. rparen :: Doc rparen = char ')' --- | The document @'enclose' l r d)@ encloses the document @d@ between the+-- | 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, with identity 'empty'.+(</>) :: Doc -> Doc -> Doc+Empty </> y = y+x </> Empty = x+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 Empty = Empty+group d = flatten d `Alt` d++-- | The document @'flatten' d@ will flatten @d@ to /one/ line.+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 -- -- @'enclose' l r d = l <> d <> r@ enclose :: Doc -> Doc -> Doc -> Doc enclose left right d = left <> d <> right --- | The document @'angles' d@ encloses the aligned document @d@ in <...>.+-- | 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 --- | The document @'backquotes' d@ encloses the aligned document @d@ in `...`.+-- | The document @'backquotes' d@ encloses the aligned document @d@ in \`...\`. 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@@ -308,28 +396,6 @@ parensIf True doc = parens doc parensIf False doc = doc --- | The document @'parens' d@ encloses the 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@. This differs from 'indent' in that the first line of--- @d@ /is not/ indented.-hang :: Int -> Doc -> Doc-hang i d = align (nest i d)---- | The document @'indent' i d@ indents @d@ @i@ spaces relative to the current--- column. This differs from 'hang' in that the first line of @d@ /is/ indented.-indent :: Int -> Doc -> Doc-indent i d = align (nest i (spaces i <> d))- -- | The document @'folddoc' f ds@ obeys the laws: -- -- * @'folddoc' f [] = 'empty'@@@ -339,21 +405,21 @@ folddoc _ [x] = x folddoc f (x:xs) = f x (folddoc f xs) --- | The document @'spread' ds@ concatenates the documents @ds@ using @<+>@.+-- | The document @'spread' ds@ concatenates the documents @ds@ with 'space'. spread :: [Doc] -> Doc spread = folddoc (<+>) --- | The document @'stack' ds@ concatenates the documents @ds@ using @</>@.+-- | The document @'stack' ds@ concatenates the documents @ds@ with 'line'. stack :: [Doc] -> Doc stack = folddoc (</>) --- | The document @'cat' ds@ separates the documents @ds@ with the empty--- document as long as there is room, and uses newlines when there isn't.+-- | The document @'cat' ds@ concatenates the documents @ds@ with the 'empty'+-- document as long as there is room, and uses 'line' when there isn't. cat :: [Doc] -> Doc cat = group . folddoc (<//>) --- | The document @'sep' ds@ separates the documents @ds@ with the empty--- document as long as there is room, and uses spaces when there isn't.+-- | The document @'sep' ds@ concatenates the documents @ds@ with the 'space'+-- document as long as there is room, and uses 'line' when there isn't. sep :: [Doc] -> Doc sep = group . folddoc (<+/>) @@ -375,14 +441,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:@@ -394,8 +460,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@@ -404,25 +470,186 @@ -- | 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 @'tuple' ds@ separates @ds@ with commas and encloses them with+-- | 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 Empty = Empty+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.+#if MIN_VERSION_base(4,13,0)+faildoc :: MonadFail m => Doc -> m a+#else faildoc :: Monad m => Doc -> m a-faildoc = fail . show+#endif+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. If this is+ -- followed by a 'RPos', output an appropriate #line pragma /before/+ -- the newline.+ | 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 True Nothing Nothing k id (Cons 0 x Nil)+ where+ be :: Bool -- ^ Did a newline just occur?+ -> Maybe Pos -- ^ Previous source position+ -> Maybe Pos -- ^ Current source position+ -> Int -- ^ Current column+ -> RDocS -- ^ Our continuation+ -> Docs -- ^ 'Docs' to layout+ -> RDoc+ be _ _ _ !_ f Nil = f REmpty+ be nl p p' !k f (Cons i d ds) =+ case d of+ Empty -> be nl p p' k f ds+ Char c -> be False p p' (k+1) (f . prag . RChar c) ds+ String l s -> be False p p' (k+l) (f . prag . RString l s) ds+ Text s -> be False p p' (k+T.length s) (f . prag . RText s) ds+ LazyText s -> be False p p' (k+fromIntegral (L.length s)) (f . prag . RLazyText s) ds+ Line -> (f . RLine i) (be True p'' Nothing i id ds)+ x `Cat` y -> be nl p p' k f (Cons i x (Cons i y ds))+ Nest j x -> be nl p p' k f (Cons (i+j) x ds)+ x `Alt` y -> better k f (be nl p p' k id (Cons i x ds))+ (be nl p p' k id (Cons i y ds))+ SrcLoc loc -> be nl p (updatePos p' loc) k f ds+ Column g -> be nl p p' k f (Cons i (g k) ds)+ Nesting g -> be nl p p' k f (Cons i (g i) ds)+ where+ p'' :: Maybe Pos+ prag :: RDocS+ (p'', prag) = lineLoc p p'++ -- | Given the previous and current position, figure out the actual+ -- current position and return a 'RDocS' that will add a #line pragma+ -- (in the form of an 'RPos') if necessary.+ lineLoc :: Maybe Pos -- ^ Previous source position+ -> Maybe Pos -- ^ Current source position+ -> (Maybe Pos, RDocS) -- ^ Current source position and position+ -- pragma+ lineLoc Nothing Nothing = (Nothing, noPragma)+ lineLoc Nothing (Just p) = (Just p, pragma p)+ lineLoc (Just p1) (Just p2)+ | posFile p2 == posFile p1 &&+ posLine p2 == posLine p1 + 1 = (Just p2, noPragma)+ | otherwise = (Just p2, pragma p2)+ lineLoc (Just p1) Nothing = (Just (advance p1), noPragma)+ where+ advance :: Pos -> Pos+ advance (Pos f l c coff) = Pos f (l+1) c coff++ noPragma :: RDocS+ noPragma = id++ -- We only insert a pragma if a newline was just output.+ pragma :: Pos -> RDocS+ pragma p | nl = RPos p+ | otherwise = id++ 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++ updatePos :: Maybe Pos -> Loc -> Maybe Pos+ updatePos Nothing NoLoc = Nothing+ updatePos _ (Loc p _) = Just p+ updatePos (Just p) NoLoc = Just p+ -- | 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.@@ -467,6 +694,14 @@ pretty :: Int -> Doc -> String pretty w x = prettyS w x "" +-- | Render and display a document compactly.+prettyCompactS :: Doc -> ShowS+prettyCompactS x = displayS (renderCompact x)++-- | Render and convert a document to a 'String' compactly.+prettyCompact :: Doc -> String+prettyCompact x = prettyCompactS x ""+ -- | Display a rendered document with #line pragmas. displayPragmaS :: RDoc -> ShowS displayPragmaS = go@@ -477,20 +712,43 @@ go (RString _ s x) = showString s . go x go (RText s x) = showString (T.unpack s) . go x go (RLazyText s x) = showString (L.unpack s) . go x- go (RPos p x) = showChar '\n' .- showString "#line " .- shows (posLine p) .- showChar ' ' .- shows (posFile p) .- go x- go (RLine i x) = showString ('\n' : replicate i ' ') .+ go (RPos p x) = showPos p .+ showChar '\n' . go x+ go (RLine i x) = case x of+ RPos p x' -> showChar '\n' .+ showPos p .+ showString ('\n' : replicate i ' ') .+ go x'+ _ -> showString ('\n' : replicate i ' ') .+ go x + showPos :: Pos -> ShowS+ showPos p =+ showString "#line " .+ shows (posLine p) .+ showChar ' ' .+ showChar '"' .+ showString (posFile p) .+ showChar '"'+ -- | Render and display a document with #line pragmas. prettyPragmaS :: Int -> Doc -> ShowS prettyPragmaS w x = displayPragmaS (render w x) -- | Render and convert a document to a 'String' with #line pragmas.+--+-- > > let loc = Loc (Pos "filename" 3 5 7) (Pos "filename" 5 7 9)+-- > > in putStrLn $ prettyPragma 80 $ srcloc loc <> text "foo" </> text "bar" </> text "baz"+--+-- will be printed as+--+-- @+-- foo+-- #line 3 "filename"+-- bar+-- baz+-- @ prettyPragma :: Int -> Doc -> String prettyPragma w x = prettyPragmaS w x "" @@ -521,329 +779,48 @@ go (RText s x) = B.fromText s `mappend` go x go (RLazyText s x) = B.fromLazyText s `mappend` go x go (RString _ s x) = B.fromString s `mappend` go x- go (RPos p x) = B.singleton '\n' `mappend`- B.fromString "#line " `mappend`- (go . renderCompact . ppr) (posLine p) `mappend`- B.singleton ' ' `mappend`- (go . renderCompact . ppr) (posFile p) `mappend`- go x- go (RLine i x) = B.fromString ('\n':replicate i ' ') `mappend`+ go (RPos p x) = displayPos p `mappend`+ B.singleton '\n' `mappend` go x---- | Render and convert a document to 'L.Text' with #line pragmas. Uses a builder.-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+ go (RLine i x) = case x of+ RPos p x' -> B.singleton '\n' `mappend`+ displayPos p `mappend`+ B.fromString ('\n':replicate i ' ') `mappend`+ go x'+ _ -> B.fromString ('\n':replicate i ' ') `mappend`+ go x -data Docs = Nil -- ^ No document.- | Cons !Int Doc Docs -- ^ Indentation, document and tail+ displayPos :: Pos -> B.Builder+ displayPos p =+ B.fromString "#line " `mappend`+ renderPosLine p `mappend`+ B.singleton ' ' `mappend`+ renderPosFile p -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'+ renderPosLine :: Pos -> B.Builder+ renderPosLine = go . renderCompact . int . posLine - better :: Int -> RDocS -> RDoc -> RDoc -> RDoc- better !k f x y | fits (w - k) x = f x- | otherwise = f y+ renderPosFile :: Pos -> B.Builder+ renderPosFile = go . renderCompact . enclose dquote dquote . string . posFile - 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 and convert a document to 'L.Text' with #line pragmas. Uses a builder.+prettyPragmaLazyText :: Int -> Doc -> L.Text+prettyPragmaLazyText w x = displayPragmaLazyText (render w x) -- | 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 -#if !MIN_VERSION_base(4,5,0)-infixr 6 <>--(<>) :: Doc -> Doc -> Doc-x <> y = x `Cat` y-#endif /* !MIN_VERSION_base(4,5,0) */--instance Monoid Doc where- mempty = empty- mappend = Cat--instance Show Doc where- showsPrec _ = prettyS 80--class Pretty a where- ppr :: a -> Doc- pprPrec :: Int -> a -> Doc- pprList :: [a] -> Doc-- ppr = pprPrec 0- pprPrec _ = ppr- pprList xs = list (map ppr xs)--instance Pretty Int where- ppr = text . show--instance Pretty Integer where- ppr = text . show--instance Pretty Float where- ppr = text . show--instance Pretty Double where- ppr = text . show--ratioPrec, ratioPrec1 :: Int-ratioPrec = 7 -- Precedence of ':%' constructor-ratioPrec1 = ratioPrec + 1--instance (Integral a, Pretty a) => Pretty (Ratio a) where- {-# SPECIALIZE instance Pretty Rational #-}- pprPrec p (x:%y) =- parensIf (p > ratioPrec) $- pprPrec ratioPrec1 x <+> char '%' <+> pprPrec ratioPrec1 y--instance Pretty Bool where- ppr = text . show--instance Pretty Char where- ppr = text . show- pprList = text . show--instance Pretty T.Text where- ppr = text . show--instance Pretty L.Text where- ppr = text . show--instance Pretty a => Pretty [a] where- ppr = pprList--instance Pretty () where- ppr () =- tuple []--instance (Pretty a, Pretty b)- => Pretty (a, b) where- ppr (a, b) =- tuple [ppr a, ppr b]--instance (Pretty a, Pretty b, Pretty c)- => Pretty (a, b, c) where- ppr (a, b, c) =- tuple [ppr a, ppr b, ppr c]--instance (Pretty a, Pretty b, Pretty c, Pretty d)- => Pretty (a, b, c, d) where- ppr (a, b, c, d) =- tuple [ppr a, ppr b, ppr c, ppr d]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e)- => Pretty (a, b, c, d, e) where- ppr (a, b, c, d, e) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f)- => Pretty (a, b, c, d, e, f) where- ppr (a, b, c, d, e, f) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr 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- ppr (a, b, c, d, e, f, g) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr f, ppr 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- ppr (a, b, c, d, e, f, g, h) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr f, ppr g, ppr h]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i)- => Pretty (a, b, c, d, e, f, g, h, i) where- ppr (a, b, c, d, e, f, g, h, i) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr f, ppr g, ppr h, ppr i]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j)- => Pretty (a, b, c, d, e, f, g, h, i, j) where- ppr (a, b, c, d, e, f, g, h, i, j) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr f, ppr g, ppr h, ppr i, ppr j]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,- Pretty k)- => Pretty (a, b, c, d, e, f, g, h, i, j, k) where- ppr (a, b, c, d, e, f, g, h, i, j, k) =- tuple [ppr a, ppr b, ppr c, ppr d, ppr e,- ppr f, ppr g, ppr h, ppr i, ppr j,- ppr k]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,- Pretty k, Pretty l)- => Pretty (a, b, c, d, e, f, g, h, i, j, k, l) where- ppr (a, b, c, d, e, f, g, h, i, j, k, l) =- 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]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,- Pretty k, Pretty l, Pretty m)- => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m) where- ppr (a, b, c, d, e, f, g, h, i, j, k, l, m) =- 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]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,- Pretty k, Pretty l, Pretty m, Pretty n)- => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where- ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n) =- 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]--instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,- Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,- Pretty k, Pretty l, Pretty m, Pretty n, Pretty o)- => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where- ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) =- 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+-- | 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
+ Text/PrettyPrint/Mainland/Class.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE CPP #-}++-- |+-- Module : Text.PrettyPrint.Mainland+-- Copyright : (c) 2006-2011 Harvard University+-- (c) 2011-2012 Geoffrey Mainland+-- (c) 2015-2017 Drexel University+-- License : BSD-style+-- Maintainer : mainland@drexel.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)+-- <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 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.++module Text.PrettyPrint.Mainland.Class (+ -- * The 'Pretty' type class for pretty printing+ Pretty(..),++ pprint+ ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Complex (Complex, realPart, imagPart)+import Data.Int+import Data.Loc (L(..),+ Loc(..),+ Pos(..),+ posFile)+import qualified Data.Map as Map+#if !(MIN_VERSION_base(4,9,0))+import Data.Monoid (Monoid(..), (<>))+#endif /* !(MIN_VERSION_base(4,9,0)) */+#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import Data.Word+import Data.Ratio (Ratio(..), denominator, numerator)++import Text.PrettyPrint.Mainland++-- | The 'pprint' function outputs a value of any type that is an instance of+-- 'Pretty' to the standard output device by calling 'ppr' and adding a newline.+pprint :: (Pretty a, MonadIO m) => a -> m ()+pprint = liftIO . putDocLn . ppr++class Pretty a where+#if __GLASGOW_HASKELL__ >= 708+ {-# MINIMAL pprPrec | ppr #-}+#endif+ ppr :: a -> Doc+ pprPrec :: Int -> a -> Doc+ pprList :: [a] -> Doc++ ppr = pprPrec 0+ 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+ pprPrec p x = text (showsPrec p x "")++instance Pretty Integer where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Float where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Double where+ pprPrec p x = text (showsPrec p x "")++ratioPrec, ratioPrec1 :: Int+ratioPrec = 7 -- Precedence of ':%' constructor+ratioPrec1 = ratioPrec + 1++instance (Integral a, Pretty a) => Pretty (Ratio a) where+ pprPrec p x =+ parensIf (p > ratioPrec) $+ pprPrec ratioPrec1 (numerator x) <+> char '%' <+> pprPrec ratioPrec1 (denominator x)++addPrec :: Int+addPrec = 6 -- Precedence of '+'++instance (RealFloat a, Pretty a) => Pretty (Complex a) where+ pprPrec p x =+ parensIf (p > addPrec) $+ pprPrec addPrec (realPart x) <+> text ":+" <+> pprPrec addPrec (imagPart x)++instance Pretty Word8 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Word16 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Word32 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Word64 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Int8 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Int16 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Int32 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty Int64 where+ pprPrec p x = text (showsPrec p x "")++instance Pretty T.Text where+ ppr = strictText++instance Pretty L.Text where+ ppr = lazyText++instance Pretty Doc where+ ppr doc = doc++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 []++instance (Pretty a, Pretty b)+ => Pretty (a, b) where+ ppr (a, b) =+ tuple [ppr a, ppr b]++instance (Pretty a, Pretty b, Pretty c)+ => Pretty (a, b, c) where+ ppr (a, b, c) =+ tuple [ppr a, ppr b, ppr c]++instance (Pretty a, Pretty b, Pretty c, Pretty d)+ => Pretty (a, b, c, d) where+ ppr (a, b, c, d) =+ tuple [ppr a, ppr b, ppr c, ppr d]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e)+ => Pretty (a, b, c, d, e) where+ ppr (a, b, c, d, e) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f)+ => Pretty (a, b, c, d, e, f) where+ ppr (a, b, c, d, e, f) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr 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+ ppr (a, b, c, d, e, f, g) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr f, ppr 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+ ppr (a, b, c, d, e, f, g, h) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr f, ppr g, ppr h]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i)+ => Pretty (a, b, c, d, e, f, g, h, i) where+ ppr (a, b, c, d, e, f, g, h, i) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr f, ppr g, ppr h, ppr i]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j)+ => Pretty (a, b, c, d, e, f, g, h, i, j) where+ ppr (a, b, c, d, e, f, g, h, i, j) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr f, ppr g, ppr h, ppr i, ppr j]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,+ Pretty k)+ => Pretty (a, b, c, d, e, f, g, h, i, j, k) where+ ppr (a, b, c, d, e, f, g, h, i, j, k) =+ tuple [ppr a, ppr b, ppr c, ppr d, ppr e,+ ppr f, ppr g, ppr h, ppr i, ppr j,+ ppr k]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,+ Pretty k, Pretty l)+ => Pretty (a, b, c, d, e, f, g, h, i, j, k, l) where+ ppr (a, b, c, d, e, f, g, h, i, j, k, l) =+ 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]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,+ Pretty k, Pretty l, Pretty m)+ => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m) where+ ppr (a, b, c, d, e, f, g, h, i, j, k, l, m) =+ 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]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,+ Pretty k, Pretty l, Pretty m, Pretty n)+ => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where+ ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n) =+ 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]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e,+ Pretty f, Pretty g, Pretty h, Pretty i, Pretty j,+ Pretty k, Pretty l, Pretty m, Pretty n, Pretty o)+ => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where+ ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) =+ 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]
mainland-pretty.cabal view
@@ -1,35 +1,52 @@ name: mainland-pretty-version: 0.2.7.2-cabal-version: >= 1.6+version: 0.7.1.1+cabal-version: >= 1.10 license: BSD3 license-file: LICENSE copyright: (c) 2006-2011 Harvard University (c) 2011-2012 Geoffrey Mainland- (c) 2015 Drexel University-author: Geoffrey Mainland <mainland@cs.drexel.edu>-maintainer: Geoffrey Mainland <mainland@cs.drexel.edu>+ (c) 2015-2024 Drexel University+author: Geoffrey Mainland <mainland@drexel.edu>+maintainer: Geoffrey Mainland <mainland@drexel.edu> stability: alpha-homepage: http://www.cs.drexel.edu/~mainland/+homepage: https://github.com/mainland/mainland-pretty+bug-reports: https://github.com/mainland/mainland-pretty/issues category: Text synopsis: Pretty printing designed for printing source code. description: Pretty printing designed for printing source code based on- Wadler's paper /A Prettier Printer/. The main advantage of this- library is its ability to automatically track the source- locations associated with pretty printed values and output- appropriate #line pragmas and its ability to produce output+ Wadler's paper /A Prettier Printer/. The main advantage of this+ library is its ability to automatically track the source+ locations associated with pretty printed values and output+ appropriate #line pragmas and its ability to produce output in the form of lazy text using a builder.+tested-with: GHC==8.0.2,+ GHC==8.2.2,+ GHC==8.4.3,+ GHC==8.6.5,+ GHC==8.8.4,+ GHC==8.10.7,+ GHC==9.0.2,+ GHC==9.2.2,+ GHC==9.4.8,+ GHC==9.6.4,+ GHC==9.8.2,+ GHC==9.10.1 build-type: Simple library+ default-language: Haskell2010+ exposed-modules: Text.PrettyPrint.Mainland+ Text.PrettyPrint.Mainland.Class build-depends:- base >= 4 && < 5,- containers >= 0.2 && < 0.6,- srcloc >= 0.2 && < 0.6,- text > 0.11 && < 1.3+ base >= 4.5 && < 5,+ containers >= 0.2 && < 0.8,+ srcloc >= 0.2 && < 0.7,+ text > 0.11 && < 2.2,+ transformers > 0.3 && < 0.7 source-repository head type: git