module PrintHao where

-- pretty-printer generated by the BNF converter

import AbsHao
import Char

-- the top-level printing method
printTree :: Print a => a -> String
printTree = render . prt 0

-- you may want to change render and parenth

render :: [String] -> String
render = rend 0 where
  rend i ss = case ss of
    "["      :ts -> cons "["  $ rend i ts
    "("      :ts -> cons "("  $ rend i ts
    "{"      :ts -> cons "{"  $ new (i+1) $ rend (i+1) ts
    "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
    "}"      :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
    ";"      :ts -> cons ";"  $ new i $ rend i ts
    t  : "," :ts -> cons t    $ space "," $ rend i ts
    t  : ")" :ts -> cons t    $ cons ")"  $ rend i ts
    t  : "]" :ts -> cons t    $ cons "]"  $ rend i ts
    t        :ts -> space t   $ rend i ts
    _            -> ""
  cons s t  = s ++ t
  new i s   = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
  space t s = if null s then t else t ++ " " ++ s

parenth :: [String] -> [String]
parenth ss = ["("] ++ ss ++ [")"]

-- the printer class does the job
class Print a where
  prt :: Int -> a -> [String]
  prtList :: [a] -> [String]
  prtList = concat . map (prt 0)

instance Print a => Print [a] where
  prt _ = prtList

instance Print Integer where
  prt _ = (:[]) . show

instance Print Double where
  prt _ = (:[]) . show

instance Print Char where
  prt _ s = ["'" ++ mkEsc s ++ "'"]
  prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]

mkEsc s = case s of
  _ | elem s "\\\"'" -> '\\':[s]
  '\n' -> "\\n"
  '\t' -> "\\t"
  _ -> [s]

prPrec :: Int -> Int -> [String] -> [String]
prPrec i j = if j<i then parenth else id


instance Print Ident where
  prt _ (Ident i) = [i]
  prtList es = case es of
   [x] -> (concat [prt 0 x , ["::"]])
   x:xs -> (concat [prt 0 x , ["::"] , prt 0 xs])


instance Print Infix where
  prt _ (Infix i) = [i]



instance Print Module where
  prt i e = case e of
   Module ids exports term -> prPrec i 0 (concat [["module"] , prt 0 ids , [";"] , prt 0 exports , prt 0 term])


instance Print Export where
  prt i e = case e of
   Export symbol -> prPrec i 0 (concat [["export"] , prt 0 symbol])

  prtList es = case es of
   [] -> (concat [])
   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])

instance Print QIdent where
  prt i e = case e of
   FQIdent ids id -> prPrec i 0 (concat [prt 0 ids , prt 0 id])


instance Print QInfix where
  prt i e = case e of
   FQInfix ids infix' -> prPrec i 0 (concat [prt 0 ids , prt 0 infix'])


instance Print Symbol where
  prt i e = case e of
   IdSym qident -> prPrec i 0 (concat [prt 0 qident])
   OpSym op -> prPrec i 0 (concat [["("] , prt 0 op , [")"]])


instance Print Op where
  prt i e = case e of
   InfOp qinfix -> prPrec i 0 (concat [prt 0 qinfix])
   IdOp symbol -> prPrec i 0 (concat [["`"] , prt 0 symbol , ["`"]])

  prtList es = case es of
   [] -> (concat [])
   [x] -> (concat [prt 0 x])
   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])

instance Print Term where
  prt i e = case e of
   Seq term0 term -> prPrec i 0 (concat [prt 0 term0 , [";"] , prt 1 term])
   Binding term0 term -> prPrec i 1 (concat [prt 4 term0 , ["="] , prt 1 term])
   OpApp term0 op term -> prPrec i 2 (concat [prt 2 term0 , prt 0 op , prt 3 term])
   App term0 term -> prPrec i 3 (concat [prt 3 term0 , prt 4 term])
   Var symbol -> prPrec i 4 (concat [prt 0 symbol])
   Form cases -> prPrec i 4 (concat [["{"] , prt 0 cases , ["}"]])
   Block term -> prPrec i 4 (concat [["{"] , prt 0 term , ["}"]])
   Tuple terms -> prPrec i 4 (concat [["("] , prt 0 terms , [")"]])
   OpDecl op assoc fixitys -> prPrec i 4 (concat [["operator"] , prt 0 op , prt 0 assoc , prt 0 fixitys])

  prtList es = case es of
   [] -> (concat [])
   [x] -> (concat [prt 0 x])
   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])

instance Print Case where
  prt i e = case e of
   PatCase term guards -> prPrec i 0 (concat [["case"] , prt 0 term , prt 0 guards])

  prtList es = case es of
   [] -> (concat [])
   x:xs -> (concat [prt 0 x , prt 0 xs])

instance Print Guard where
  prt i e = case e of
   NormGuard term0 term -> prPrec i 0 (concat [["|"] , prt 0 term0 , [":"] , prt 0 term])
   DefaultGuard term -> prPrec i 0 (concat [["|"] , ["default"] , [":"] , prt 0 term])

  prtList es = case es of
   [] -> (concat [])
   x:xs -> (concat [prt 0 x , prt 0 xs])

instance Print Assoc where
  prt i e = case e of
   LeftAssoc  -> prPrec i 0 (concat [["left"]])
   RightAssoc  -> prPrec i 0 (concat [["right"]])
   NoAssoc  -> prPrec i 0 (concat [])


instance Print Fixity where
  prt i e = case e of
   GtFixity ops -> prPrec i 0 (concat [["precedes"] , ["("] , prt 0 ops , [")"]])
   LtFixity ops -> prPrec i 0 (concat [["succeeds"] , ["("] , prt 0 ops , [")"]])

  prtList es = case es of
   [] -> (concat [])
   x:xs -> (concat [prt 0 x , prt 0 xs])