module PrintGFC where

-- pretty-printer generated by the BNF converter, except handhacked spacing --H

import Ident --H
import AbsGFC
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
    "NEW"    :ts -> realnew   $ rend i ts --H
    "<"      :ts -> cons "<"  $ rend i ts --H
    "$"      :ts -> cons "$"  $ rend i ts --H
    "?"      :ts -> cons "?"  $ rend i ts --H
    "["      :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 -> cons t    $ cons ">"  $ rend i ts --H
    t  : "." :ts -> cons t    $ cons "."  $ rend i ts --H
    t        :ts -> realspace t   $ rend i ts --H
    _            -> ""
  cons s t  = s ++ t
  space t s = t ++ " " ++ s --H
  realspace t s = if null s then t else t ++ " " ++ s --H
  new i s   = s      --H '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
  realnew s = '\n':s --H

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 _ i = [prIdent i]
  prtList es = case es of
   [] -> (concat [])
   [x] -> (concat [prt 0 x])
   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])



instance Print Canon where
  prt i e = case e of
   Gr modules -> prPrec i 0 (concat [prt 0 modules])


instance Print Module where
  prt i e = case e of
   Mod modtype extend open flags defs -> prPrec i 0 (concat [prt 0 modtype , ["="] , prt 0 extend , prt 0 open , ["{"] , prt 0 flags , prt 0 defs , ["}"]])

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

instance Print ModType where
  prt i e = case e of
   MTAbs id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
   MTCnc id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
   MTRes id -> prPrec i 0 (concat [["resource"] , prt 0 id])


instance Print Extend where
  prt i e = case e of
   Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
   NoExt  -> prPrec i 0 (concat [])


instance Print Open where
  prt i e = case e of
   NoOpens  -> prPrec i 0 (concat [])
   Opens ids -> prPrec i 0 (concat [["open"] , prt 0 ids , ["in"]])


instance Print Flag where
  prt i e = case e of
   Flg id0 id -> prPrec i 0 (concat [["flags"] , prt 0 id0 , ["="] , prt 0 id])

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

instance Print Def where
  prt i e = case e of
   AbsDCat id decls cidents -> prPrec i 0 (concat [["cat"] , prt 0 id , ["["] , prt 0 decls , ["]"] , ["="] , prt 0 cidents])
   AbsDFun id exp0 exp -> prPrec i 0 (concat [["fun"] , prt 0 id , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
   ResDPar id pardefs -> prPrec i 0 (concat [["param"] , prt 0 id , ["="] , prt 0 pardefs])
   ResDOper id ctype term -> prPrec i 0 (concat [["oper"] , prt 0 id , [":"] , prt 0 ctype , ["="] , prt 0 term])
   CncDCat id ctype term0 term -> prPrec i 0 (concat [["lincat"] , prt 0 id , ["="] , prt 0 ctype , ["="] , prt 0 term0 , [";"] , prt 0 term])
   CncDFun id cident argvars term0 term -> prPrec i 0 (concat [["lin"] , prt 0 id , [":"] , prt 0 cident , ["="] , ["\\"] , prt 0 argvars , ["->"] , prt 0 term0 , [";"] , prt 0 term])
   AnyDInd id0 status id -> prPrec i 0 (concat [prt 0 id0 , prt 0 status , ["in"] , prt 0 id])

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

instance Print ParDef where
  prt i e = case e of
   ParD id ctypes -> prPrec i 0 (concat [prt 0 id , prt 0 ctypes])

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

instance Print Status where
  prt i e = case e of
   Canon  -> prPrec i 0 (concat [["data"]])
   NonCan  -> prPrec i 0 (concat [])


instance Print CIdent where
  prt i e = case e of
   CIQ id0 id -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id])

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

instance Print Exp where
  prt i e = case e of
   EApp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , prt 2 exp])
   EProd id exp0 exp -> prPrec i 0 (concat [["("] , prt 0 id , [":"] , prt 0 exp0 , [")"] , ["->"] , prt 0 exp])
   EAtom atom -> prPrec i 2 (concat [prt 0 atom])
   EAbs id exp -> prPrec i 0 (concat [["\\"] , prt 0 id , ["->"] , prt 0 exp])
   EEq equations -> prPrec i 0 (concat [["{"] , prt 0 equations , ["}"]])

instance Print Sort where
  prt i e = case e of
   SType  -> prPrec i 0 (concat [["Type"]])

instance Print Equation where
  prt i e = case e of
   Equ apatts exp -> prPrec i 0 (concat [prt 0 apatts , ["->"] , prt 0 exp])

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

instance Print APatt where
  prt i e = case e of
   APC cident apatts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 apatts , [")"]])
   APV id -> prPrec i 0 (concat [prt 0 id])
   APS str -> prPrec i 0 (concat [prt 0 str])
   API n -> prPrec i 0 (concat [prt 0 n])
   APW  -> prPrec i 0 (concat [["_"]])

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

instance Print Atom where
  prt i e = case e of
   AC cident -> prPrec i 0 (concat [prt 0 cident])
   AD cident -> prPrec i 0 (concat [["<"] , prt 0 cident , [">"]])
   AV id -> prPrec i 0 (concat [["$"] , prt 0 id])
   AM n -> prPrec i 0 (concat [["?"] , prt 0 n])
   AS str -> prPrec i 0 (concat [prt 0 str])
   AI n -> prPrec i 0 (concat [prt 0 n])
   AT sort -> prPrec i 0 (concat [prt 0 sort])


instance Print Decl where
  prt i e = case e of
   Decl id exp -> prPrec i 0 (concat [prt 0 id , [":"] , prt 0 exp])

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

instance Print CType where
  prt i e = case e of
   RecType labellings -> prPrec i 0 (concat [["{"] , prt 0 labellings , ["}"]])
   Table ctype0 ctype -> prPrec i 0 (concat [["("] , prt 0 ctype0 , ["=>"] , prt 0 ctype , [")"]])
   Cn cident -> prPrec i 0 (concat [prt 0 cident])
   TStr  -> prPrec i 0 (concat [["Str"]])

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

instance Print Labelling where
  prt i e = case e of
   Lbg label ctype -> prPrec i 0 (concat [prt 0 label , [":"] , prt 0 ctype])

  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
   Arg argvar -> prPrec i 2 (concat [prt 0 argvar])
   I cident -> prPrec i 2 (concat [prt 0 cident])
   Con cident terms -> prPrec i 2 (concat [["<"] , prt 0 cident , prt 2 terms , [">"]])
   LI id -> prPrec i 2 (concat [["$"] , prt 0 id])
   R assigns -> prPrec i 2 (concat [["{"] , prt 0 assigns , ["}"]])
   P term label -> prPrec i 1 (concat [prt 2 term , ["."] , prt 0 label])
   T ctype cases -> prPrec i 1 (concat [["table"] , prt 0 ctype , ["{"] , prt 0 cases , ["}"]])
   S term0 term -> prPrec i 1 (concat [prt 1 term0 , ["!"] , prt 2 term])
   C term0 term -> prPrec i 0 (concat [prt 0 term0 , ["++"] , prt 1 term])
   FV terms -> prPrec i 1 (concat [["variants"] , ["{"] , prt 2 terms , ["}"]])
   K tokn -> prPrec i 2 (concat [prt 0 tokn])
   E  -> prPrec i 2 (concat [["["] , ["]"]])

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

instance Print Tokn where
  prt i e = case e of
   KS str -> prPrec i 0 (concat [prt 0 str])
   KP strs variants -> prPrec i 0 (concat [["["] , ["pre"] , prt 0 strs , ["{"] , prt 0 variants , ["}"] , ["]"]])


instance Print Assign where
  prt i e = case e of
   Ass label term -> prPrec i 0 (concat [prt 0 label , ["="] , prt 0 term])

  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
   Cas patts term -> prPrec i 0 (concat [prt 0 patts , ["=>"] , prt 0 term])

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

instance Print Variant where
  prt i e = case e of
   Var strs0 strs -> prPrec i 0 (concat [prt 0 strs0 , ["/"] , prt 0 strs])

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

instance Print Label where
  prt i e = case e of
   L id -> prPrec i 0 (concat [prt 0 id])
   LV n -> prPrec i 0 (concat [["$"] , prt 0 n])


instance Print ArgVar where
  prt i e = case e of
   A id n -> prPrec i 0 (concat [prt 0 id , ["@"] , prt 0 n])
   AB id n0 n -> prPrec i 0 (concat [prt 0 id , ["+"] , prt 0 n0 , ["@"] , prt 0 n])

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

instance Print Patt where
  prt i e = case e of
   PC cident patts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 patts , [")"]])
   PV id -> prPrec i 0 (concat [prt 0 id])
   PW  -> prPrec i 0 (concat [["_"]])
   PR pattassigns -> prPrec i 0 (concat [["{"] , prt 0 pattassigns , ["}"]])

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

instance Print PattAssign where
  prt i e = case e of
   PAss label patt -> prPrec i 0 (concat [prt 0 label , ["="] , prt 0 patt])

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