{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module Vodka.PrintVodka where

-- pretty-printer generated by the BNF converter

import Vodka.AbsVodka
import Data.Char


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

type Doc = [ShowS] -> [ShowS]

doc :: ShowS -> Doc
doc = (:)

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

parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')')

concatS :: [ShowS] -> ShowS
concatS = foldr (.) id

concatD :: [Doc] -> Doc
concatD = foldr (.) id

replicateS :: Int -> ShowS -> ShowS
replicateS n f = concatS (replicate n f)

-- the printer class does the job
class Print a where
  prt :: Int -> a -> Doc
  prtList :: Int -> [a] -> Doc
  prtList i = concatD . map (prt i)

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

instance Print Char where
  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
  prtList _ s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')

mkEsc :: Char -> Char -> ShowS
mkEsc q s = case s of
  _ | s == q -> showChar '\\' . showChar s
  '\\'-> showString "\\\\"
  '\n' -> showString "\\n"
  '\t' -> showString "\\t"
  _ -> showChar s

prPrec :: Int -> Int -> Doc -> Doc
prPrec i j = if j<i then parenth else id


instance Print Integer where
  prt _ x = doc (shows x)


instance Print Double where
  prt _ x = doc (shows x)


instance Print Ident where
  prt _ (Ident i) = doc (showString ( i))
  prtList _ [] = (concatD [])
  prtList _ [x] = (concatD [prt 0 x])
  prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs])


instance Print Progr where
  prt i e = case e of
    Program decfs main -> prPrec i 0 (concatD [prt 0 decfs, prt 0 main])

instance Print Main where
  prt i e = case e of
    Main ids block -> prPrec i 0 (concatD [doc (showString "main"), doc (showString "("), prt 0 ids, doc (showString ")"), doc (showString ":"), prt 0 block])

instance Print DecF where
  prt i e = case e of
    DecFunc id ids block -> prPrec i 0 (concatD [prt 0 id, doc (showString "=>"), doc (showString "("), prt 0 ids, doc (showString ")"), doc (showString ":"), prt 0 block])
  prtList _ [] = (concatD [])
  prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs])
instance Print Stm where
  prt i e = case e of
    SAss id exp -> prPrec i 0 (concatD [prt 0 id, doc (showString "="), prt 0 exp, doc (showString ";")])
    SAssL1 id -> prPrec i 0 (concatD [prt 0 id, doc (showString "="), doc (showString "[]"), doc (showString ";")])
    SAssL2 id indic exp -> prPrec i 0 (concatD [prt 0 id, prt 0 indic, doc (showString "="), prt 0 exp, doc (showString ";")])
    SVFunc id exps -> prPrec i 0 (concatD [prt 0 id, doc (showString "("), prt 0 exps, doc (showString ")"), doc (showString ";")])
    SFunc decf -> prPrec i 0 (concatD [prt 0 decf])
    SIncr id -> prPrec i 0 (concatD [prt 0 id, doc (showString "++"), doc (showString ";")])
    SDecr id -> prPrec i 0 (concatD [prt 0 id, doc (showString "--"), doc (showString ";")])
    SPrint exp -> prPrec i 0 (concatD [doc (showString "print"), doc (showString "("), prt 0 exp, doc (showString ")"), doc (showString ";")])
    SIf0 exp block -> prPrec i 0 (concatD [doc (showString "if"), doc (showString "("), prt 0 exp, doc (showString ")"), doc (showString ":"), prt 0 block])
    SIf1 exp block1 block2 -> prPrec i 0 (concatD [doc (showString "if"), doc (showString "("), prt 0 exp, doc (showString ")"), doc (showString ":"), prt 0 block1, doc (showString "else"), doc (showString ":"), prt 0 block2])
    SWhile exp block -> prPrec i 0 (concatD [doc (showString "while"), doc (showString "("), prt 0 exp, doc (showString ")"), doc (showString ":"), prt 0 block])
    SFor id exp block -> prPrec i 0 (concatD [doc (showString "for"), prt 0 id, doc (showString "in"), prt 0 exp, doc (showString ":"), prt 0 block])
    SReturn exp -> prPrec i 0 (concatD [doc (showString "return"), prt 0 exp, doc (showString ";")])
  prtList _ [] = (concatD [])
  prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs])
instance Print Indic where
  prt i e = case e of
    Indic exp -> prPrec i 0 (concatD [doc (showString "["), prt 0 exp, doc (showString "]")])

instance Print Block where
  prt i e = case e of
    Block stms -> prPrec i 0 (concatD [doc (showString "{"), prt 0 stms, doc (showString "}")])

instance Print Exp where
  prt i e = case e of
    EObool exp1 op exp2 -> prPrec i 0 (concatD [prt 0 exp1, prt 0 op, prt 0 exp2])
    EOboolN op exp -> prPrec i 0 (concatD [prt 3 op, prt 0 exp])
    EOMat exp1 op exp2 -> prPrec i 1 (concatD [prt 1 exp1, prt 1 op, prt 2 exp2])
    EOMin exp -> prPrec i 3 (concatD [doc (showString "-"), prt 3 exp])
    EVar id -> prPrec i 3 (concatD [prt 0 id])
    EList id n -> prPrec i 3 (concatD [prt 0 id, doc (showString "["), prt 0 n, doc (showString "]")])
    EFunc id exps -> prPrec i 3 (concatD [prt 0 id, doc (showString "("), prt 0 exps, doc (showString ")")])
    EInt n -> prPrec i 3 (concatD [prt 0 n])
    EString str -> prPrec i 3 (concatD [prt 0 str])
    EChar c -> prPrec i 3 (concatD [prt 0 c])
    EDouble d -> prPrec i 3 (concatD [prt 0 d])
    ETrue -> prPrec i 3 (concatD [doc (showString "true")])
    EFalse -> prPrec i 3 (concatD [doc (showString "false")])
  prtList _ [] = (concatD [])
  prtList _ [x] = (concatD [prt 0 x])
  prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs])
instance Print Op where
  prt i e = case e of
    OAnd -> prPrec i 0 (concatD [doc (showString "&&")])
    OOr -> prPrec i 0 (concatD [doc (showString "||")])
    Omenorq -> prPrec i 0 (concatD [doc (showString "<")])
    Omaiorq -> prPrec i 0 (concatD [doc (showString ">")])
    OmenorIgq -> prPrec i 0 (concatD [doc (showString "<=")])
    OmaiorIgq -> prPrec i 0 (concatD [doc (showString ">=")])
    Oigual -> prPrec i 0 (concatD [doc (showString "==")])
    ODifd -> prPrec i 0 (concatD [doc (showString "!=")])
    OPlus -> prPrec i 1 (concatD [doc (showString "+")])
    OMinus -> prPrec i 1 (concatD [doc (showString "-")])
    OTimes -> prPrec i 2 (concatD [doc (showString "*")])
    ODivF -> prPrec i 2 (concatD [doc (showString "/")])
    ODivI -> prPrec i 2 (concatD [doc (showString "`div`")])
    OMod -> prPrec i 2 (concatD [doc (showString "%")])
    ONot -> prPrec i 3 (concatD [doc (showString "!")])


