remove conflicting import for nhc98
[haskell-directory.git] / Text / PrettyPrint / HughesPJ.hs
index 6a95b4d..54ce7e1 100644 (file)
@@ -127,7 +127,7 @@ Relative to John's original paper, there are the following new features:
     last line of the top argument stops before the first line of the
     second begins.
 
-        For example:  text "hi" $$ nest 5 "there"
+        For example:  text "hi" $$ nest 5 (text "there")
         lays out as
                         hi   there
         rather than
@@ -172,19 +172,20 @@ module Text.PrettyPrint.HughesPJ (
        -- * The document type
         Doc,            -- Abstract
 
-       -- * Primitive Documents
-        empty,
+       -- * Constructing documents
+       -- ** Converting values into documents
+        char, text, ptext,
+        int, integer, float, double, rational,
+
+       -- ** Simple derived documents
         semi, comma, colon, space, equals,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace,
 
-       -- * Converting values into documents
-        text, char, ptext,
-        int, integer, float, double, rational,
-
-       -- * Wrapping documents in delimiters
+       -- ** Wrapping documents in delimiters
         parens, brackets, braces, quotes, doubleQuotes,
 
-       -- * Combining documents
+       -- ** Combining documents
+        empty,
         (<>), (<+>), hcat, hsep, 
         ($$), ($+$), vcat, 
         sep, cat, 
@@ -225,7 +226,11 @@ infixl 5 $$, $+$
 
 isEmpty :: Doc    -> Bool;  -- ^ Returns 'True' if the document is empty
 
-empty   :: Doc;                        -- ^ An empty document
+-- | The empty document, with no height and no width.
+-- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere
+-- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
+empty   :: Doc
+
 semi   :: Doc;                 -- ^ A ';' character
 comma  :: Doc;                 -- ^ A ',' character
 colon  :: Doc;                 -- ^ A ':' character
@@ -238,45 +243,105 @@ rbrack   :: Doc;                 -- ^ A ']' character
 lbrace :: Doc;                 -- ^ A '{' character
 rbrace :: Doc;                 -- ^ A '}' character
 
+-- | A document of height and width 1, containing a literal character.
+char    :: Char     -> Doc
+
+-- | A document of height 1 containing a literal string.
+-- 'text' satisfies the following laws:
+--
+-- * @'text' s '<>' 'text' t = 'text' (s'++'t)@
+--
+-- * @'text' \"\" '<>' x = x@, if @x@ non-empty
+--
+-- The side condition on the last law is necessary because @'text' \"\"@
+-- has height 1, while 'empty' has no height.
 text    :: String   -> Doc
+
+-- | An obsolete function, now identical to 'text'.
 ptext   :: String   -> Doc
-char    :: Char     -> Doc
-int      :: Int      -> Doc
-integer  :: Integer  -> Doc
-float    :: Float    -> Doc
-double   :: Double   -> Doc
-rational :: Rational -> Doc
 
+int      :: Int      -> Doc;   -- ^ @int n = text (show n)@
+integer  :: Integer  -> Doc;   -- ^ @integer n = text (show n)@
+float    :: Float    -> Doc;   -- ^ @float n = text (show n)@
+double   :: Double   -> Doc;   -- ^ @double n = text (show n)@
+rational :: Rational -> Doc;   -- ^ @rational n = text (show n)@
 
 parens       :: Doc -> Doc;    -- ^ Wrap document in @(...)@
 brackets     :: Doc -> Doc;    -- ^ Wrap document in @[...]@
 braces      :: Doc -> Doc;     -- ^ Wrap document in @{...}@
-quotes      :: Doc -> Doc;     -- ^ Wrap document in @'...'@
+quotes      :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@
 doubleQuotes :: Doc -> Doc;    -- ^ Wrap document in @\"...\"@
 
 -- Combining @Doc@ values
 
-(<>)   :: Doc -> Doc -> Doc;     -- ^Beside
-hcat   :: [Doc] -> Doc;          -- ^List version of '<>'
-(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space
-hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'
+-- | Beside.
+-- '<>' is associative, with identity 'empty'.
+(<>)   :: Doc -> Doc -> Doc
 
-($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no
-                                -- overlap it \"dovetails\" the two
-vcat   :: [Doc] -> Doc;          -- ^List version of '$$'
+-- | Beside, separated by space, unless one of the arguments is 'empty'.
+-- '<+>' is associative, with identity 'empty'.
+(<+>)  :: Doc -> Doc -> Doc
 
-cat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat
-sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat
-fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat
-fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep
+-- | Above, except that if the last line of the first argument stops
+-- at least one position before the first line of the second begins,
+-- these two lines are overlapped.  For example:
+--
+-- >    text "hi" $$ nest 5 (text "there")
+--
+-- lays out as
+--
+-- >    hi   there
+--
+-- rather than
+--
+-- >    hi
+-- >         there
+--
+-- '$$' is associative, with identity 'empty', and also satisfies
+--
+-- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
+--
+($$)   :: Doc -> Doc -> Doc
+
+-- | Above, with no overlapping.
+-- '$+$' is associative, with identity 'empty'.
+($+$)   :: Doc -> Doc -> Doc
 
-nest   :: Int -> Doc -> Doc;     -- ^ Nested
+hcat   :: [Doc] -> Doc;          -- ^List version of '<>'.
+hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'.
+vcat   :: [Doc] -> Doc;          -- ^List version of '$$'.
 
+cat    :: [Doc] -> Doc;          -- ^ Either 'hcat' or 'vcat'.
+sep    :: [Doc] -> Doc;          -- ^ Either 'hsep' or 'vcat'.
+fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of 'cat'.
+fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of 'sep'.
+
+-- | Nest (or indent) a document by a given number of positions
+-- (which may also be negative).  'nest' satisfies the laws:
+--
+-- * @'nest' 0 x = x@
+--
+-- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@
+--
+-- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@
+--
+-- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@
+--
+-- * @'nest' k 'empty' = 'empty'@
+--
+-- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty
+--
+-- The side condition on the last law is needed because
+-- 'empty' is a left identity for '<>'.
+nest   :: Int -> Doc -> Doc
 
 -- GHC-specific ones.
 
-hang :: Doc -> Int -> Doc -> Doc;      -- ^ @hang d1 n d2 = sep [d1, nest n d2]@
-punctuate :: Doc -> [Doc] -> [Doc];      -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
+-- | @hang d1 n d2 = sep [d1, nest n d2]@
+hang :: Doc -> Int -> Doc -> Doc
+
+-- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
+punctuate :: Doc -> [Doc] -> [Doc]
 
 
 -- Displaying @Doc@ values. 
@@ -284,10 +349,10 @@ punctuate :: Doc -> [Doc] -> [Doc];      -- ^ @punctuate p [d1, ... dn] = [d1 \<
 instance Show Doc where
   showsPrec prec doc cont = showDoc doc cont
 
--- | Renders the document as a string using the default style
+-- | Renders the document as a string using the default 'style'.
 render     :: Doc -> String
 
--- | The general rendering interface
+-- | The general rendering interface.
 fullRender :: Mode                     -- ^Rendering mode
            -> Int                       -- ^Line length
            -> Float                     -- ^Ribbons per line
@@ -296,21 +361,21 @@ fullRender :: Mode                        -- ^Rendering mode
            -> Doc                      -- ^The document
            -> a                         -- ^Result
 
--- | Render the document as a string using a specified style
+-- | Render the document as a string using a specified style.
 renderStyle  :: Style -> Doc -> String
 
--- | A rendering style
+-- | A rendering style.
 data Style
  = Style { mode           :: Mode     -- ^ The rendering mode
         , lineLength     :: Int      -- ^ Length of line, in chars
          , ribbonsPerLine :: Float    -- ^ Ratio of ribbon length to line length
          }
 
--- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@)
+-- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@).
 style :: Style
 style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode }
 
--- | Rendering mode
+-- | Rendering mode.
 data Mode = PageMode            -- ^Normal 
           | ZigZagMode          -- ^With zig-zag cuts
           | LeftMode            -- ^No indentation, infinitely long lines
@@ -412,7 +477,7 @@ rational n = text (show n)
 -- SIGBJORN wrote instead:
 -- rational n = text (show (fromRationalX n))
 
-quotes p        = char '`' <> p <> char '\''
+quotes p        = char '\'' <> p <> char '\''
 doubleQuotes p  = char '"' <> p <> char '"'
 parens p        = char '(' <> p <> char ')'
 brackets p      = char '[' <> p <> char ']'
@@ -437,7 +502,8 @@ punctuate p (d:ds) = go d ds
 -- A Doc represents a *set* of layouts.  A Doc with
 -- no occurrences of Union or NoDoc represents just one layout.
 
--- | The abstract type of documents
+-- | The abstract type of documents.
+-- The 'Show' instance is equivalent to using 'render'.
 data Doc
  = Empty                                -- empty
  | NilAbove Doc                         -- text "" $$ x
@@ -520,7 +586,7 @@ isEmpty Empty = True
 isEmpty _     = False
 
 char  c = textBeside_ (Chr c) 1 Empty
-text  s = case length   s of {sl -> textBeside_ (Str s)  sl Empty}
+text  s = case length s of {sl -> textBeside_ (Str s)  sl Empty}
 ptext s = case length s of {sl -> textBeside_ (PStr s) sl Empty}
 
 nest k  p = mkNest k (reduceDoc p)        -- Externally callable version
@@ -540,8 +606,13 @@ mkUnion p q     = p `union_` q
 -- ---------------------------------------------------------------------------
 -- Vertical composition @$$@
 
-p $$  q = Above p False q
-p $+$ q = Above p True q
+above_ :: Doc -> Bool -> Doc -> Doc
+above_ p _ Empty = p
+above_ Empty _ q = q
+above_ p g q = Above p g q
+
+p $$  q = above_ p False q
+p $+$ q = above_ p True q
 
 above :: Doc -> Bool -> RDoc -> RDoc
 above (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)
@@ -585,8 +656,13 @@ nilAboveNest g k q           | (not g) && (k > 0)        -- No newline if no ove
 -- ---------------------------------------------------------------------------
 -- Horizontal composition @<>@
 
-p <>  q = Beside p False q
-p <+> q = Beside p True  q
+beside_ :: Doc -> Bool -> Doc -> Doc
+beside_ p _ Empty = p
+beside_ Empty _ q = q
+beside_ p g q = Beside p g q
+
+p <>  q = beside_ p False q
+p <+> q = beside_ p True  q
 
 beside :: Doc -> Bool -> RDoc -> RDoc
 -- Specification: beside g p q = p <g> q
@@ -875,8 +951,10 @@ easy_display nl_text txt end doc
     lay (NilAbove p)        no_doc = nl_text `txt` lay p cant_fail      -- NoDoc always on first line
     lay (TextBeside s sl p) no_doc = s `txt` lay p no_doc
 
-indent n | n >= 8 = '\t' : indent (n - 8)
-         | otherwise      = spaces n
+-- OLD version: we shouldn't rely on tabs being 8 columns apart in the output.
+-- indent n | n >= 8 = '\t' : indent (n - 8)
+--          | otherwise      = spaces n
+indent n = spaces n
 
 multi_ch 0 ch = ""
 multi_ch n       ch = ch : multi_ch (n - 1) ch
@@ -893,3 +971,21 @@ multi_ch n       ch = ch : multi_ch (n - 1) ch
 spaces n | n <= 0    = ""
         | otherwise = ' ' : spaces (n - 1)
 
+{- Comments from Johannes Waldmann about what the problem might be:
+
+   In the example above, d2 and d1 are deeply nested, but `text "+"' is not, 
+   so the layout function tries to "out-dent" it.
+   
+   when I look at the Doc values that are generated, there are lots of
+   Nest constructors with negative arguments.  see this sample output of
+   d1 (obtained with hugs, :s -u)
+   
+   tBeside (TextDetails_Chr 'a') 1 Doc_Empty) (Doc_NilAbove (Doc_Nest
+   (-241) (Doc_TextBeside (TextDetails_Chr 'a') 1 Doc_Empty)))))
+   (Doc_NilAbove (Doc_Nest (-236) (Doc_TextBeside (TextDetails_Chr 'a') 1
+   (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside (TextDetails_Chr 'a') 1
+   Doc_Empty)))))))) (Doc_NilAbove (Doc_Nest (-231) (Doc_TextBeside
+   (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside
+   (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside
+   (TextDetails_Chr 'a') 1 Doc_Empty))))))))))) (Doc_NilAbove (Doc_Nest
+-}