content: module StrategoPretty where
  import StrategoAST
  
  showB :: B -> String
  showB (Normal e) = showE e
  showB (Guarded ps) = foldr f "\n" ps
     where f (e1,e2) ans = "| "++(showE e1) ++ " = " ++(showE e2)++ ans
  
  showWhere ds = if null ds then "" else "   where "
  
  showD :: D -> String
  showD (Val p body ds) =  " " ++ showP p ++ "=" ++ (showB body) ++ "\n" ++
                           (showWhere ds) ++ (showDs ds)
  showD (Fun nm xs) = foldr (++) "" (map f xs)
     where f (ps,body,ds) = 
             nm ++ " " ++(showPs ps) ++ " = " ++(showB body) ++ "\n" ++
             (showWhere ds) ++ (showDs ds)
     
  
  showDs dcls = foldr (++) "" (map showD dcls)
  
  showOp :: Op -> String
  showOp Plus = "+"
  showOp Mult = "*"
  showOp IntEq = "=="
  showOp IntLess = "<"
  
  showP (Pconst i)      = "LitPat("++show i++")"
  showP (Pvar n)        = "VarPat(\""++n++"\")"
  showP (Pcondata n ns) = "ConstrPat(" ++ n ++ "," ++ (mkSlist ns) ++")"
  showP (Paspat n p)    = "AsPattern("++n++","++show p++")"
  showP (Pnewdata n x)  = error "no new constructor pattern yet"
  showP (Ptilde p)      = error "no tilde pattern yet"
  showP (Ptuple ps)     = "TuplePat(" ++ mkSlist ps ++ ")" 
  showP Pwildcard       = "WildCard"
  
  showPs [] = ""
  showPs (p:ps) = (showP p)++" "++(showPs ps)
  
  {- Pretty prints a haskell list expression into a stratego list -}
  mkSlist = foldr 
               (\ s t -> if t/="Nil" then (show s++","++t) else (show s))
               "Nil" 
  
  {- N.b., the resulting string is Stratego code -}
  showE :: E -> String
  showE (Var nm)     = "HVar(\""++nm++"\")"
  showE (Const i)    = "HLit("++show i++")"
  showE (App d d')   = "HApp(" ++ showE d ++ "," ++ showE d' ++ ")"
  showE (Abs p d)    = "(\\" ++ (foldr (++) " " (map showP p)) ++ " -> " 
                             ++ showE d ++ ")"
  showE (TupleExp l) =  "(" ++   
                  (foldr (\ s t -> 
                              if t/="" then (showE s) ++ "," ++ t
                                       else (showE s)) 
                         "" l)
                        ++ ")"
  showE (ConApp n l) =  "(" ++ n ++ " " ++  
                  (foldr (\ (s,ls) t -> 
                              let sa = if (ls == Strict) then "!" else "" 
                              in
                                   if t/="" then sa ++ (showE s) ++ "," ++ t
                                       else sa ++ (showE s)) 
                          "" l)
                        ++ ")"
  showE (NewApp n x)  = "(" ++ n ++ " " ++  (showE x) ++ ")"                     
  showE (Seq x y)     = "(seq "++(showE x) ++ " " ++ (showE y) ++ ")"
  showE (Bin op d d') = "(" ++ showE d ++ " " ++ showOp op ++ " " ++ 
                                 showE d' ++ ")"
  showE (Cond b e1 e2) = "if "++showE b++" then "++showE e1++" else "++show e2
  showE (Let dcls d)   = "let " ++ 
                              foldr (++) "" (map showD dcls)
                                ++ " in " ++ showE d
  showE (Case e ms) =
        "(case " ++ showE e ++ " of " ++ 
             (foldr (++) "" 
             (map (\ alt -> "[" ++ (showAlt alt) ++ "]") ms)) ++ ")"
     where showAlt (p,b,ds) = show p ++ " -> " ++ show b ++ "\n" ++ showDs ds
  
  
  instance Show D where
    show = showD
  
  instance Show E where
    show = showE
  
  instance Show P where
    show = showP
  
  instance Show B where
    show = showB
  