{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Backend.Lua.Emit where

import Backend.Lua.Lua hiding (block, body)
import Data.List
import Control.Monad.RWS
import Control.Applicative

import Pretty

instance Pretty Name where
  pprint (Scoped n) = pprint n
  pprint (Qualified ns n) = ZipList ns <+> "." <+> spcClr n

instance Pretty Application where
  pprint (Call e@(Name x) a) = e <+> parens (ZipList a)
  pprint (Call e@EApply{} a) = e <+> parens (ZipList a) 
  pprint (Call e a) = parens e <+> parens (ZipList a)
  pprint (Invoke t m a) = t <+> ":" <+> m <+> parens (ZipList a)

instance Pretty Expr where
  pprint Nil = spcClr "nil"
  pprint Dots = spcClr "..."
  pprint Backend.Lua.Lua.True = litClr "true"
  pprint Backend.Lua.Lua.False = litClr "false"
  pprint (Table prs) = braces $ interleave ", " $ flip map prs $ \(x, y) ->
    "[ " <+> x <+> " ] = " <+> y
  pprint (WrapTable e) = braces e
  pprint (Op l o Nothing) = pprint o >> pprint l
  pprint (Op l o (Just r)) = l <+> " " <+> o <+> " " <+> r
  pprint (Tuple e) = pprint $ ZipList e
  pprint (Index (WrapTable e) x) = parens (braces e) <+> squares x
  pprint (Index (Table e) x) = parens (braces tabl) <+> squares x where
    tabl = interleave "," $ flip map e $ \(x, y) ->
      "[ " <+> x <+> " ] = " <+> y

  pprint (Index e x) = e <+> squares (pprint x)
  pprint (EApply a) = pprint a
  pprint (Name n) = pprint n
  pprint (Number d) = litClr d
  pprint (String s) = strClr s
  pprint (Function ars dt b) = do
    let dt' = if dt
        then "..."
        else ""

    kwClr "function"
    parens $ ZipList $ filter (not . null) $ ars ++ [dt']
    body b
    indented $ kwClr "end"

instance Pretty [Statement] where
  pprint xs = do forM_ (init xs) $ \x -> do pprint x
                                            tell "\n"
                 pprint $ last xs

instance Pretty Statement where
  pprint (Do xs) = do 
    kwClr "do"
    body xs
    indented $ kwClr "end"

  pprint (Set n (Function ars dt b)) = do
    let dt' = if dt
        then "..."
        else ""

    kwClr "function "
    pprint n
    parens $ ZipList $ filter (not . null) $ ars ++ [dt']
    pprint ""
    body b
    indented $ kwClr "end"

  pprint (Set (Qualified (nm:nms) n) e) = do
    pprint nm
    forM_ nms squares
    squares n 
    tell " = "
    pprint e

  pprint (Set (Scoped "_") e) = pprint e
  pprint (Set n e) = n <+> " = " <+> e
  pprint (While c b) = do
    pprint "while " <+> c <+> " do"
    body b
    indented $ kwClr "end"
  pprint (Repeat c b) = do
    kwClr "repeat"
    body b
    indented $ kwClr "until " <+> c

  pprint (If (x:xs) els) = do
    mkif x
    mapM_ mkelif xs
    mkels els
    indented $ kwClr "end"
      where mkif (x, b) = do kwClr "if " <+> x <+> kwClr " then"
                             body b
            mkelif (x, b) = indented $ kwClr "else" >> mkif (x, b)
            mkels [] = tell ""
            mkels b = do indented $ kwClr "else"
                         body b
  pprint (Local nms) = kwClr "local " <+> (ZipList $ map fst nms) <+> " = " <+> (ZipList $ map snd nms)
  pprint (SApply ap) = pprint ap
  pprint (Return e) = kwClr "return " <+> e
  pprint (ForIn its b) = do
    kwClr "for "
    pprint (ZipList $ map fst its)
    kwClr " in "
    pprint (ZipList $ map snd its)
    kwClr " do"
    body b
    indented $ kwClr "end"

  pprint (ForRange s e st i b) = do
    kwClr "for " <+> i <+> " = " <+> s <+> ", " <+> e <+> ", " <+> st <+> kwClr " do"
    body b
    indented $ kwClr "end"

instance Pretty Operator where
  pprint Add    = opClr "+"
  pprint Sub    = opClr "-"
  pprint Mul    = opClr "*"
  pprint Div    = opClr "/"
  pprint Mod    = opClr "%"
  pprint Pow    = opClr "^"
  pprint Concat = opClr ".."
  pprint Eq     = opClr "=="
  pprint Lt     = opClr "<"
  pprint Le     = opClr "<="
  pprint And    = kwClr "and"
  pprint Or     = kwClr "or"
  pprint Not    = kwClr "not "
  pprint Len    = opClr "#"
  pprint Shr    = opClr ">>"
  pprint Shl    = opClr "<<"
  pprint Neq    = opClr "~="
  pprint Gt     = opClr ">"
  pprint Ge     = opClr ">="

