SyntaxRecPretty.hs

module SyntaxRecPretty where
import SyntaxRec
import PrettyPrint
import SpecialNames
import HsTypeStruct
import PrettySymbols(rarrow)

instance (PrintableOp i,IsSpecialName i) => Printable (HsDeclI i) where
    ppi (Dec d) = ppi d

    ppiList []  = empty
    ppiList ds  = vcat $ (map (blankline . ppi) (init ds)) ++ [ppi (last ds)]

    wrap (Dec d) = wrap d


{- We want something like this,

   instance Rec rec struct => Printable rec where
     ppi = ppi . struct
     wrap = ppi . struct

   but we have to repeat it for each type in the Rec class, since otherwise
   we get an instance that "overlaps" with everything else... /TH
-}

instance (PrintableOp i,IsSpecialName i) => Printable (HsExpI i) where
    ppi = ppi . struct
    wrap = wrap . struct

instance PrintableOp i => Printable (HsPatI i) where
    ppi = ppi . struct
    wrap = wrap . struct

instance (Printable i,IsSpecialName i) => Printable (HsTypeI i) where
    --ppi (Typ (HsTyApp (Typ (HsTyCon (Qual (Module "Prelude") "[]"))) t)) =
    --    brackets $ appParensOff $ ppi t
    ppi (Typ t) = ppi t

--  ppiList [] = empty
--  ppiList ts = {-appParensOn $-} ppiSet space $ map struct ts

    --wrap (Typ (HsTyApp (Typ (HsTyCon (Qual (Module "Prelude") "[]"))) t)) =
    --	brackets $ appParensOff $ ppi t
    wrap (Typ t) = wrap t

instance (Printable i,IsSpecialName i) => PrintableApp (HsTypeI i) (HsTypeI i) where
   ppiApp = ppiApp . struct
   wrapApp = wrapApp . struct

instance Printable HsKind where
    ppi = ppi . struct
    wrap = wrap . struct


instance (Printable i,IsSpecialName i) => PrintableApp i (HsTypeI i) where
  ppiApp i ts = -- i is always a  constructor, not a type variable
      case ts of
        [t]     | is_list_tycon_name i -> ppListType t
        [t1,t2] | is_fun_tycon_name  i -> sep [wrap t1<+>rarrow,ppi t2]
        _       | n>=2 && is_tuple_tycon_name (n-1) i -> ppiFTuple ts
	_                              -> tcon (wrap i)<+>fsep (map wrap ts)
    where
      n=length ts

  wrapApp i ts =
      case ts of
        [t]     | is_list_tycon_name i -> ppListType t
        [t1,t2] | is_fun_tycon_name  i -> parens (sep [wrap t1<+>rarrow,ppi t2])
        _       | n>=2 && is_tuple_tycon_name (n-1) i -> ppiFTuple ts
	_                         -> parens (tcon (wrap i)<+>fsep (map wrap ts))
    where
      n=length ts

ppListType t =
  case t of
    Typ (HsTyCon i) | is_char_tycon_name i -> tcon "String"
    _ -> brackets t