\begin{code}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
module Show () where

import Syntax (Type(..), Func(..), Term(..))

import Control.Monad.State


instance Show Type where
  show Alpha       = "alpha"
  show Bool        = "Bool"
  show Int         = "Int"
  show (List t)    = "[" ++ show t ++ "]" 
  show (Maybe t)   = "Maybe " ++ show_ t
  show (s `To` t)  = showF s ++ " -> " ++ show t

show_ t@(Maybe _)   = "(" ++ show t ++ ")"
show_ t@(_ `To` _)  = "(" ++ show t ++ ")"
show_ t             = show t

showF t@(_ `To` _)   = show_ t
showF t              = show t


instance Show (Func String) where
  show f = evalState (show' f) ['h':show n | n <- [1..]]
    where  show' Id            = return "id"
           show' (Embed v)     = return v
           show' (Map name f)  = fmap (\f -> name ++ " " ++ f) (show_ f)
           show' (f `Comp` g)  = liftM2 (\f g -> f ++ " . " ++ g) (show' f) (show' g)
           show' (Lambda f)    = do  v:vs <- get
                                     put vs
                                     fmap (\t -> "(\\" ++ v ++ " -> " ++ t ++ ")") (show' (f v))
           
           show_ f@Id           = show' f
           show_ f@(Embed _)    = show' f
           show_ f@(Lambda _)   = show' f
           show_ f              = fmap (\f -> "(" ++ f ++ ")") (show' f)


instance Show (Term String) where
  show t = evalState (show' t) ['x':show n | n <- [1..]]
    where  show' (Const name)     = return name
           show' (Var v)          = return v
           show' t@(_ `Apply` _)  = showA t
           show' t@(Lambda' _)    = fmap ("\\" ++) (showL t)

           showA (f `Apply` t)   = liftM2 (\f t -> f ++ " " ++ t) (showA f) (show_ t)
           showA f               = show_ f

           show_ t@(Const _)  = show' t
           show_ t@(Var _)    = show' t
           show_ t            = fmap (\t -> "(" ++ t ++ ")") (show' t)

           showL (Lambda' f)       = do  v:vs <- get
                                         put vs
                                         fmap (\t -> v ++ " " ++ t) (showL (f v))
           showL t                 = fmap ("-> " ++) (show' t)
\end{code}