content: 
  -- | A Pretty printing class using multiparameter type classes for
  -- maximal generality with some useful instances.
  --
  -- the pprinted type comes as the last argument so newtype deriving can be used
  -- in more places.
  
  module Doc.PPrint where
  
  import Doc.DocLike
  import qualified Data.Map as Map
  
  {-
   - some useful fixities for comparison
   -
   - application left 10
   - infixr 9  .
   - infixr 8  ^, ^^, **
   - infixl 7  *  , /, `quot`, `rem`, `div`, `mod`
   - infixl 6  +, -
   - infixr 5  :
   - infix  4  ==, /=, <, <=, >=, >
   - infixr 3  &&
   - infixr 2  ||
   - infixl 1  >>, >>=
   - infixr 1  =<<
   - infixr 0  $, $!, `seq`
   -
   -}
  
  data Assoc = AssocLeft | AssocRight | AssocNone
      deriving(Eq,Ord,Show)
  
  class DocLike d => PPrint d a  where
      pprint ::  a -> d
      pprintAssoc :: Assoc -> Int -> a -> d
  
      pprintAssoc _ _ a = pprint a
      pprint a = pprintAssoc AssocNone (-1) a
  
  
      pplist    ::  [a] -> d
      pplist    xs = brackets (hcat (punctuate comma (map pprint xs)))
  
  pprintParen :: PPrint d a => a -> d
  pprintParen = pprintPrec 11
  
  pprintPrec n a = pprintAssoc AssocNone n  a
  
  instance PPrint d a => PPrint d [a] where
      pprint  = pplist
  
  instance DocLike d => PPrint d Char where
    pprint  = char
    pplist  = text
  
  instance DocLike d => PPrint d Integer where
    pprint  = tshow
  
  instance DocLike d => PPrint d Int where
    pprint  = tshow
  
  instance DocLike d => PPrint d Float where
    pprint  = tshow
  
  instance DocLike d => PPrint d Double where
    pprint  = tshow
  
  instance DocLike d => PPrint d () where
      pprint () = text "()"
  
  instance (PPrint d a, PPrint d b) => PPrint d (a,b) where
    pprint (x,y) = parens (hsep [pprint x <> comma, pprint y])
  
  checkAssoc a1 n1 a2 n2 | n2 < n1 = id
                         | n1 == n2 && a1 == a2 && a1 /= AssocNone = id
                         | otherwise = parens
  
  checkAssocApp a n p = checkAssoc AssocLeft 10 a n p
  
  pprintBinary a1 n1 a2 n2 x1 b x2 = checkAssoc a1 n1 a2 n2 $ pprintAssoc l n1 x1 <+> b <+> pprintAssoc r n1 x2 where
      l = if a1 == AssocLeft then AssocLeft else AssocNone
      r = if a1 == AssocRight then AssocRight else AssocNone
  
  instance (PPrint d a, PPrint d b) => PPrint d (Either a b) where
    pprintAssoc a n (Left x)  = checkAssocApp a n $ text "Left" <+> pprintPrec 10 x
    pprintAssoc a n (Right x) = checkAssocApp a n $ text "Right" <+> pprintPrec 10 x
  
  instance (PPrint d a, PPrint d b, PPrint d c) => PPrint d (a,b,c) where
    pprint (x,y,z) = parens (hsep [pprint x <> comma,
                                  pprint y <> comma,
                                  pprint z])
  
  instance (PPrint d a, PPrint d b) => PPrint d (Map.Map a b) where
      pprint m = vcat [ pprint x <+> text "=>" <+> pprint y | (x,y) <- Map.toList m]
  
  
  