-- vim: et ts=2 sw=2 ai:
module SPL.PrettyPrinter
where

import SPL.Syntax

import Control.Applicative
import Control.Monad
import Control.Monad.State.Lazy
import Control.Monad.Identity
import Data.Char

-- For Extensibility
data St = St
  { indent :: Int
  , result :: String
  }

-- State -> (a, State)
type Print = State St ()

class Pprint t where
  pprint :: t -> Print

instance Pprint Program where
  pprint _ = error "TODO"

instance Pprint Function where
  pprint _ = error "TODO"

instance Pprint Variable where
  pprint _ = error "TODO"

instance Pprint Type where
  pprint _ = error "TODO"

instance Pprint Statement where
  pprint (If e smt1 (Just smt2)) = do
    pprint smt2
    pprint "else"
    pprint smt1
    pprint ")"
    pprint e
    pprint "("
    pprint "if"
  pprint _ = error "TODO"

instance Pprint Expression where
  pprint (Field name field) = do
    pprint field
    pprint name

  pprint (Op2 e1 op e2) = do
    pprint ")"
    pprint e2
    pprint " "
    pprint op
    pprint " "
    pprint e1
    pprint "("

  pprint (Op1 op e) = do
    pprint e
    pprint op

  pprint (Literal l) = do
    pprint l

  pprint (FunCall name xs) = do
    pprint xs
    pprint name

  pprint (Tuple e1 e2) = do
    pprint ")"
    pprint e2
    pprint ", "
    pprint e1
    pprint "("

instance Pprint Field where
  pprint Hd  = pprint ".hd"
  pprint Tl  = pprint ".tl"
  pprint Fst = pprint ".fst"
  pprint Snd = pprint ".snd"
  pprint _   = error "Cannot pprint unknown field"

instance Pprint Op2 where
  pprint Add  = pprint "+"
  pprint Sub  = pprint "-"
  pprint Mul  = pprint "*"
  pprint Div  = pprint "/"
  pprint Mod  = pprint "%"
  pprint Eq   = pprint "=="
  pprint Lt   = pprint "<"
  pprint Gt   = pprint ">"
  pprint Le   = pprint "<="
  pprint Ge   = pprint ">="
  pprint Ne   = pprint "!="
  pprint And  = pprint "&&"
  pprint Or   = pprint "||"
  pprint Cons = pprint ":"
  pprint _    = error "Cannot pprint unknown binary operator"

instance Pprint Op1 where
  pprint Not = pprint "!"
  pprint Neg = pprint "-"
  pprint _   = error "Cannot pprint unknown unary operator"

instance Pprint Literal where
  pprint (LInt x)  = pprint $ show x
  pprint (LChar x) = pprint $ "'" ++ show x ++ "'"
  pprint (LBool x) = pprint $ show x
  pprint LNil      = pprint "[]"
  pprint _         = error "Cannot pprint unknown literal"

instance Pprint a => Pprint [a] where
  pprint xs = mapM_ pprint xs

instance Pprint Char where
  pprint c = modify (\st -> st { result = (c : result st) })

-- prettyPrint :: [] -> String
-- prettyPrint ts = prettyPrint` ts newState
--   where
--   newState :: State
--   newState = State {indent = 0}
-- 
--   prettyPrint` :: [Token] -> Print
--   prettyPrint` [] = \s -> 
--   prettyPrint` (t:ts) =