content: module Pretty (
        Pretty,
        PprStyle(..),
        ppNil, ppStr, ppChar, ppInt, ppInteger, ppDouble,
        ppSP, pp'SP, ppLbrack, ppRbrack, ppLparen, ppRparen,
        ppSemi, ppComma,
  
        ppCat, ppBeside, ppBesides, ppAbove, ppAboves,
        ppNest, ppSep, ppHang, ppInterleave,
        ppShow, ppUnformatted,
        -- abstract type, to complete the interface...
        PrettyRep
  ) where
  
  import CharSeq
  
  ppNil         :: Pretty
  ppSP, pp'SP, ppLbrack, ppRbrack, ppLparen, ppRparen, ppSemi, ppComma :: Pretty
  ppStr         :: [Char] -> Pretty
  ppChar        :: Char -> Pretty
  ppInt         :: Int -> Pretty
  ppInteger     :: Integer -> Pretty
  ppDouble      :: Double -> Pretty
  ppBeside      :: Pretty -> Pretty -> Pretty
  ppBesides     :: [Pretty] -> Pretty
  ppBesideSP    :: Pretty -> Pretty -> Pretty
  ppCat         :: [Pretty] -> Pretty           -- i.e., ppBesidesSP
  ppAbove       :: Pretty -> Pretty -> Pretty
  ppAboves      :: [Pretty] -> Pretty
  ppInterleave  :: Pretty -> [Pretty] -> Pretty
  ppSep         :: [Pretty] -> Pretty
  ppHang        :: Pretty -> Int -> Pretty -> Pretty
  ppNest        :: Int -> Pretty -> Pretty
  ppShow        :: Int -> Pretty -> [Char]
  ppUnformatted :: Pretty -> [Char]
  type Pretty = Int             -- The width to print in
  	    -> Bool           -- True => vertical context
  	    -> PrettyRep
  data PrettyRep
    = MkPrettyRep       CSeq    -- The text
  		      Int     -- No of chars in last line
  		      Bool    -- True if empty object
  		      Bool    -- Fits on a single line in specified width
    deriving ()
  ppShow width p
   = cShow seq
   where (MkPrettyRep seq ll emp sl) = p width False
  {- !!! this seems to tickle an nhc bug (works w/ hbc)
   = case (p width False) of
        MkPrettyRep seq sl ll -> cShow seq
  -}
  
  ppUnformatted p
   = cShow seq
   where (MkPrettyRep seq ll emp sl) = p 80 False
        -- ToDo: ppUnformatted doesn't do anything yet
  ppNil    width is_vert = MkPrettyRep cNil 0 True (width >= 0)
  			 -- Doesn't fit if width < 0, otherwise, ppNil
  			 -- will make ppBesides always return True.
  
  ppStr  s width is_vert = MkPrettyRep (cStr s) ls False (width >= ls)
  			 where ls = length s
  ppChar c width is_vert = MkPrettyRep (cCh c) 1 False (width >= 1)
  ppInt  n               = ppStr (show n)
  ppInteger n            = ppStr (show n)
  ppDouble  n            = ppStr (show n)
  ppSP      = ppChar ' '
  pp'SP     = ppStr ", "
  ppLbrack  = ppChar '['
  ppRbrack  = ppChar ']'
  ppLparen  = ppChar '('
  ppRparen  = ppChar ')'
  ppSemi    = ppChar ';'
  ppComma   = ppChar ','
  ppInterleave sep ps   = ppSep (pi ps)
   where
    pi []       = []
    pi [x]      = [x]
    pi (x:xs)   = (ppBeside x sep) : pi xs
  ppBeside p1 p2 width is_vert
   = MkPrettyRep (seq1 `cAppend` (cIndent ll1 seq2))
  	       (ll1 + ll2)
  	       (emp1 `andL` emp2)
  	       ((width >= 0) `andL` (sl1 `andL` sl2))
  		      -- This sequence of andL's ensures that ppBeside
  		      -- returns a False for sl as soon as possible.
   where
    MkPrettyRep seq1 ll1 emp1 sl1 = p1 width       False
    MkPrettyRep seq2 ll2 emp2 sl2 = p2 (width-ll1) False
        -- ToDo: if emp{1,2} then we really
        -- should be passing on "is_vert" to p{2,1}.
  ppBesides [] = ppNil
  ppBesides ps = foldr1 ppBeside ps
  ppBesideSP p1 p2 width is_vert
   = MkPrettyRep (seq1 `cAppend` (sp `cAppend` (cIndent li seq2)))
  	       (li + ll2)
  	       (emp1 `andL` emp2)
  	       ((width >= wi) `andL` (sl1 `andL` sl2))
   where
    MkPrettyRep seq1 ll1 emp1 sl1 = p1 width      False
    MkPrettyRep seq2 ll2 emp2 sl2 = p2 (width-li) False
    li, wi :: Int
    li = if emp1 then 0 else ll1+1
    wi = if emp1 then 0 else 1
    sp = if emp1 `orL` emp2 then cNil else (cCh ' ')
  ppCat []  = ppNil
  ppCat ps  = foldr1 ppBesideSP ps
  ppAbove p1 p2 width is_vert
   = MkPrettyRep (seq1 `cAppend` (nl `cAppend` seq2))
  	       ll2
  	      -- ToDo: make ll depend on empties?
  	       (emp1 `andL` emp2)
  	       False
   where
    nl = if emp1 `orL` emp2 then cNil else cNL
    MkPrettyRep seq1 ll1 emp1 sl1 = p1 width True
    MkPrettyRep seq2 ll2 emp2 sl2 = p2 width True
        -- ToDo: ditto about passing is_vert if empties
  ppAboves [] = ppNil
  ppAboves ps = foldr1 ppAbove ps
  ppNest n p width False = p width False
  ppNest n p width True
   = MkPrettyRep (cIndent n seq) (ll+n) emp sl
   where
    MkPrettyRep seq ll emp sl = p (width-n) True
  ppHang p1 n p2 width is_vert  -- This is a little bit stricter than it could
  			      -- be made with a little more effort.
  			      -- Eg the output always starts with seq1
   = if emp1 then
        p2 width is_vert
     else 
     if (ll1 <= n) `orL` sl2 then       -- very ppBesideSP'ish
        -- Hang it if p1 shorter than indent or if it doesn't fit
        MkPrettyRep (seq1 `cAppend` (cCh ' ') `cAppend` (cIndent (ll1+1) seq2))
  		(ll1 + 1 + ll2)
  		False
  		(sl1 `andL` sl2)
    else
        -- Nest it (pretty ppAbove-ish)
        MkPrettyRep (seq1 `cAppend` (cNL `cAppend` (cIndent n seq2')))
  		ll2' -- ToDo: depend on empties
  		False
  		False
   where
    MkPrettyRep seq1 ll1 emp1 sl1 = p1 width      False
    MkPrettyRep seq2 ll2 emp2 sl2 = p2 (width-(ll1+1)) False
        -- ToDo: more "is_vert if empty" stuff
  
    MkPrettyRep seq2' ll2' emp2' sl2' = p2 (width-n) False      -- ToDo: True?
  ppSep []  width is_vert = ppNil width is_vert
  ppSep [p] width is_vert = p     width is_vert
  ppSep ps  width is_vert
   = if sl then
        pr                              -- Fits on one line
     else
        ppAboves ps width is_vert       -- Takes several lines
   where
    pr@(MkPrettyRep seq ll emp sl) = ppCat ps width is_vert
  
  {- !!! suspected on same nhc-bug grounds
   = case (ppBesides ps width is_vert) of
        pr1@(MkPrettyRep seq1 sl1 ll1) ->
  	  if (sl1 && ll1 <= width) then
  	      pr1                             -- Fits on one line
  	  else
  	      ppAboves ps width is_vert       -- Takes several lines
  -}
  andL :: Bool -> Bool -> Bool
  andL False x = False
  andL True  x = x
  orL :: Bool -> Bool -> Bool
  orL True  x = True
  orL False x = x
  data PprStyle
    = PprForUser -- Pretty-print in a way that will make sense
  	       -- to the ordinary user; must be very close to Haskell
  	       -- syntax, etc.
  	       -- ToDo: how diff is this from what pprInterface must do?
    | PprDebug   -- Standard debugging output
    | PprShowAll -- Debugging output which leaves nothing to the imagination
    | PprInterface -- Interface generation
  