{-
    as3tohaxe - An Actionscript 3 to haXe source file translator
    Copyright (C) 2008 Don-Duong Quach

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
-- Translate an Actionscript 3 AST to haXe and hxml for Flash 10

module ActionhaXe.Translator where

import ActionhaXe.Lexer
import ActionhaXe.Data
import ActionhaXe.Prim
import ActionhaXe.Parser
import ActionhaXe.CLArgs
import qualified System.Console.ParseArgs as PA

import Data.Map (Map)
import qualified Data.Map as Map
import Control.Monad.State
import Data.Foldable (foldlM, foldrM)
import Data.List (intercalate)
import Data.Char (toUpper, isUpper, isAlphaNum)
import Data.Generics -- not Haskell 98
import Data.Maybe (isJust)

-- subRegex, mkRegex used for text replacement
import Text.Regex 

-- flags
mainPackage = "mainPackage"
fpackage  = "packageName"
fclass = "className"
fclassAttr = "classAttr"
hasConstructor = "hasConstructor"

updateFlag flag val = do st <- get
                         put st{flags = Map.insert flag val (flags st)}

deleteFlag flag = do st <- get
                     put st{flags = Map.delete flag (flags st)}

getFlag :: String -> StateT AsState IO String
getFlag flag = do st <- get
                  case Map.lookup flag $ flags st of
                      Just mval -> return mval
                      Nothing   -> return ""
{-                  if Map.member flag $ flags st
                      then do mval <- Map.lookup flag $ flags st
                              return mval
                      else return ""
-}

insertInitMember output = do st <- get
                             put st{initMembers = (output:(initMembers st))}
                             st' <- get
                             return ()

getMembers = do st <- get
                let ret = reverse $ initMembers st
                return ret

getCLArg f = do st <- get
                return $ PA.gotArg (confArgs (conf st)) f

maybeEl f i = maybe "" (\m -> f m) i

cleanup s = subRegex (mkRegex "\\$") s "_S_"

--translateAs3Ast :: Ast -> StateT AsState IO String
translateAs3Ast p = 
    case p of 
        AS3Program    x st -> program x >>= return
        AS3Directives x st -> directives x >>= return

directives ds = foldlM (\str i -> do{s <- directive i; return $ str++s}) "" ds
    where directive d = case d of
                            Tok t                       -> do{ t' <- tok t; return $ cleanup t'}
                            ImportDecl _ _ _            -> do{ d' <- importDecl d; return $ cleanup $ d'}
                            Metadata m                  -> do{ m' <- metadata m; return $ cleanup m'}
                            MethodDecl _ _ _ _ _ _      -> do{ d' <- methodDecl d; return $ cleanup d'}
                            VarS _ _ _ _                -> do{ d' <- memberVarS d; return $ cleanup d'}
                            _                           -> return "--unexpected directive--"

--program :: Package -> StateT AsState IO String
program (Package w p n b) = do case n of
                                 Just ntok -> do{ updateFlag fpackage $ showd ntok ; x <- packageBlock b; return $ cleanup $ showb w ++ showd p ++" "++ showd ntok ++ ";" ++ showw ntok ++ x}
                                 Nothing   -> do{ updateFlag fpackage mainPackage; x <-packageBlock b; return $ cleanup $ showb w ++ showw p ++ x}

packageBlock (Block l bs r)  = do 
    bi <- foldlM (\s b -> do{ x <- packageBlockItem b; return $ s ++ x} ) "" bs 
    return $ showw l ++ bi

classBlock (Block l bs r)  = do 
    x <- get
    let a = accessors x
    let al = Map.toList a
    props <- foldlM (\str (k, (t, g, s)) -> do{ t' <- datatype t
                                              ; return $ str ++ showws l ++ "public var " ++ k ++ "(" 
                                                         ++ (if g then "get"++ [toUpper $ head k] ++ tail k else "null") ++ ", "
                                                         ++ (if s then "set"++ [toUpper $ head k] ++ tail k else "null") 
                                                         ++ ") : " ++ t' ++ ";"
                                              }
                     ) "" al
    bi <-  foldlM (\s b -> do{ x <- classBlockItem b; return $ s ++ x} ) "" bs 
    nc <- checkConstructor l
    return $ showd l ++ showw l ++ nc ++ props ++ showw l ++ bi ++ showb r

checkConstructor l = do
    con <- getFlag hasConstructor
    x <- getMembers
    if con == "" 
        then do let (nl, i) = getNlIndent l
                initM <- getInitMembers l
                return $ "public function new() { " ++ initM ++ "}"++ nl ++ i
        else return ""

interfaceBlock (Block l bs r)  = do 
    bi <-  foldlM (\s b -> do{ x <- interfaceBlockItem b; return $ s ++ x} ) "" bs 
    return $ showb l ++ bi ++ showb r

blockItemFold bs = foldlM (\s b -> do{ x <- blockItem b; return $ s ++ x} ) "" bs 

block (Block l bs r)  = do 
    bi <- blockItemFold bs
    return $ showb l ++ bi ++ showb r

constructorBlock (Block l bs r) = do 
    bi <-  blockItemFold bs
    initM <- getInitMembers l 
    return $ showb l ++ initM ++ bi ++ showb r

getNlIndent l = 
    let spacebreak = break (\c -> c == '\n') ( reverse $ showw l)
        i =  reverse $ fst spacebreak
        nl = if length (snd spacebreak) > 1 && (snd spacebreak)!!1 == '\r' then "\r\n" else "\n"
    in (nl, i)
 
getInitMembers l = 
    do let (nl, i) = getNlIndent l
       x <- getMembers
       if length x > 0
           then return $ nl++i++ intercalate (nl++i) x ++ nl ++ i
           else return $ ""


packageBlockItem b = 
    do x <- case b of
                Tok t                       -> tok t >>= return
                ImportDecl _ _ _            -> importDecl b >>= return
                ClassDecl _ _ _ _ _ _       -> classDecl b >>= return
                Interface _ _ _ _ _         -> interface b >>= return
                Metadata m                  -> metadata m >>= return
                _                           -> return ""
       return x

classBlockItem b = 
    do x <- case b of
                Tok t                       -> tok t >>= return
                MethodDecl _ _ _ _ _ _      -> methodDecl b >>= return
                VarS _ _ _ _                -> memberVarS b >>= return
                Metadata m                  -> metadata m >>= return
                Block _ _ _                 -> block b >>= return
                _                           -> return $ show b
       return x

interfaceBlockItem b = 
    do x <- case b of
                Tok t                       -> tok t >>= return
                MethodDecl _ _ _ _ _ _      -> imethodDecl b >>= return
                Metadata m                  -> metadata m >>= return
                _                           -> return $ show b
       return x

blockItem b = 
    do x <- case b of
                Tok t                       -> tok t >>= return
                Block _ _ _                 -> block b >>= return
                VarS _ _ _ _                -> varS b >>= return
                ForS _ _ _ _ _ _ _ _ _      -> forS b >>= return
                ForInS _ _ _ _ _ _ _ _      -> forInS b >>= return
                Expr _                      -> expr b >>= return
                Metadata m                  -> metadata m >>= return
                _                           -> return ""
       return x

tok t = do let x = showb t
           f <- getFlag fpackage
           return x

metadata m = case m of
                 MD l t x r -> do{ return $ "/*" ++ showb l ++ showb t ++ showl x++ showd r ++ "*/" ++ showw r}
                 MDSwf attr -> do{ o <- swfheader attr ["400", "300", "30", "FFFFFF"]
                                 ; st <- get
                                 ; let outclass = reverse $ drop 3 $ reverse $ filename st
                                 ; liftIO $ writeFile ((outfile st) ++ "ml") ("-swf "++outclass++".swf\n-main "++outclass++"\n-swf-version 10\n-swf-header " ++ o)
                                 ; return ""
                                 }
    where swfheader ((k, v):as) [w, h, f, b] = 
              case showd k of 
                  "width"            -> swfheader as [init.tail $ showd v, h, f, b]
                  "height"           -> swfheader as [w, init.tail $ showd v, f, b]
                  "frameRate"        -> swfheader as [w, h, init.tail $ showd v, b]
                  "backgroundColor"  -> swfheader as [w, h, f, tail.init.tail $ showd v]
          swfheader [] header = return $ intercalate ":" header

importDecl (ImportDecl i n s) = do
    ci <- getCLArg CreateImports
    let show_n = showd n
    let n' = if ci && elem '*' show_n
                 then (\(h, t) ->  init h ++ tail t) $ break (== '*') $ subRegex (mkRegex "\\.") ("Import_" ++ show_n) "_"
                 else show_n
    return $ showb i ++ n' ++ maybeEl showb s
          

classDecl (ClassDecl a c n e i b) = do
    updateFlag fclass $ showd n
    updateFlag fclassAttr $ publicAttr a
    x <- classBlock b
    let e' = maybe [] (\(k, c) -> if showd c == "Object" then [] else [showb k ++ showd c] ) e
    let i' = maybe [] (\(ic, cs) -> map (\(x, co) -> showb ic ++ showd x) cs ) i
    let i'' = i' ++ if "dynamic" `elem` map (\a' -> showd a') a then ["implements Dynamic<Dynamic>"] else [""]
    let ei = intercalate ", " $ filter (\x -> length x > 0) $ e'++i''
    return $ showb c ++ showb n ++ ei ++ " " ++ x 
    where publicAttr as = if "public" `elem` map (\a -> showd a) as then "public" else "private"

interface (Interface a i n e b) = do
    x <- interfaceBlock b
    let e' = maybe [] (\(ic, cs) -> map (\(x, co) -> "implements " ++ showd x) cs ) e
    let i' = intercalate ", " e'
    return $ showb i ++ showb n ++ i' ++ x

methodDecl (MethodDecl a f ac n s b) = do 
    packageName <- getFlag fpackage
    className <- getFlag fclass
    classAttr <- getFlag fclassAttr
    if packageName == mainPackage && className == (showd n) && classAttr == "public"
        then do{ x <- maybe (return "") block b; return $ "static " ++ showb f ++ "main() "++ x }
        else if className == (showd n)
                 then do{ updateFlag hasConstructor "true"; x <- maybe (return "") constructorBlock b; s' <- signatureArgs s; return $ namespace a ++ showb f ++ "new"++showw n ++ s' ++ x }
                 else do st <- get
                         let accMap = accessors st
                         case Map.lookup (showd n) accMap of
                             Just (t, _, _) -> do let arg = getArg s
                                                  x <- maybe (return "" ) (accblock arg ac) b
                                                  acc' <- accessor ac n s t
                                                  return $ namespace a ++ showb f ++ acc' ++ x 
                             Nothing        -> do x <- maybe (return "") block b
                                                  s' <- signature s
                                                  return $ namespace a ++ showb f ++ showb n ++ s' ++ x
    where accessor ac name s@(Signature l args r ret) t = 
              case ac of
                  Just x -> do{ a <- showArgs args
                              ; t' <- datatypet t
                              ; return $ showd x ++ [toUpper $ head $ showd name] ++ tail (showb name) ++ showb l ++ a ++ showd r ++ ":" 
                                ++ fst t' ++ (case ret of { Just (c, t) -> snd t'; Nothing -> showw r})
                              }
                  Nothing -> do{ s' <- signature s; return $ showb name ++ s'}
          accblock arg ac (Block l bs r) = 
              do let ts = case ac of { Just x -> if showd x == "set" then "\treturn "++arg++";"++ initl l else ""; Nothing -> ""}
                 bi <-  blockItemFold bs
                 return $ showb l ++ bi ++ ts ++ showb r
          initl l = if length (showw l) > 0
                        then init $ showw l
                        else ""
          getArg (Signature l (a@(Arg n c t md mc):as) r ret) = showd n
          getArg (Signature l [] r ret) = ""


imethodDecl (MethodDecl a f ac n s b) = do 
    s' <- signature s
    return $ attr a ++ showb f ++ showb n ++ s'
    where attr as = concat $ map (\attr -> case (showd attr) of { "internal" -> "public" ++ showw attr; x -> showb attr }) as


signatureArgs (Signature l args r ret) = do{ a <- showArgs args
                                           ; return $ showb l ++ a ++ showb r
                                           }

rettype ret = case ret of
                  Just (c, t) -> do{ t' <- datatype t; return $ showb c ++ t'}
                  Nothing     -> return ""

signature (Signature l args r ret) = do{ a <- showArgs args
                                       ; ret' <- rettype ret
                                       ; return $ showb l ++ a ++ showb r ++ ret'
                                       }

showArgs as = do{ as' <- mapM showArg as; return $ concat as'}
    where showArg (Arg n c t i mc) = do{ i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i
                                       ; t' <- datatypeiM t i
                                       ; return $ (case i of{ Just d  -> "?"; Nothing -> ""}) ++ showb n ++ showb c ++ t' ++ i' ++ maybeEl showb mc
                                       }
          showArg (RestArg o n t) = do{ return $ showd n ++ ":Array<Dynamic>"}

memberVarS (VarS ns k v@(VarBinding n d _) vs) = do 
    if elem "static" (map (\n -> showd n) ns)
        then do v' <- varBinding v
                vs' <- foldlM (\s (c, x) -> do{ x' <- varBinding x; return $ s ++ showb c ++ x'}) "" vs
--                let inl = if hasPrimitive v && length vs == length (filter (\(c, v) -> hasPrimitive v) vs) && foldr (\x s -> isUpper x && s ) True (showd n) then "inline " else ""
--                return $ inl ++ namespace ns ++ "var" ++ showw k ++ v' ++ vs'
                return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'
        else do{ v' <- varBindingInitMember v; vs' <- foldlM (\s (c, x) -> do{ x' <- varBindingInitMember x; return $ s ++ showb c ++ x'}) "" vs; return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'}

{-
hasPrimitive = everything (||) (False `mkQ` hasPrimitive')

hasPrimitive' (TokenNum _) = True
hasPrimitive' (TokenString _) = True
hasPrimitive' (TokenKw "true") = True
hasPrimitive' (TokenKw "false") = True
hasPrimitive' _ = False
-}

varS (VarS ns k v vs) = do{ v' <- varBinding v; vs' <- foldlM (\s (c, x) -> do{ x' <- varBinding x; return $ s++ showb c ++x' }) "" vs; return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'}


varBinding' (VarBinding n dt i) =
    do{ d' <- case dt of
                  Just (c, t) -> do{ d <- datatypeiM t i; return $ showb c ++ d}
                  Nothing -> case i of -- try to determine type from initializer
                                 Just (o, e) -> do let e' = getType e
                                                   case e' of
                                                       Just t -> return $ ":" ++ t ++ showw n -- set type to initializer's type
                                                       Nothing -> return $ ":Dynamic" ++ showw n -- can't determine type
                                 Nothing -> return $ ":Dynamic" ++ showw n -- no datatype, no initializer
      ; i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i; 
      ; return (d', i')
      }
 
--varBinding :: VarBinding -> StateT AsState IO String
varBinding (VarBinding n dt i) = 
    do (d', i') <- varBinding' (VarBinding n dt i)
       return $ showd n ++ d' ++ i'

varBindingInitMember (VarBinding n dt i) = 
    do (d', i') <- varBinding' (VarBinding n dt i)
       if i' /= ""
           then do insertInitMember $ showb n ++ (if last(showb n) == ' ' then "" else " ") ++ i' ++ ";"
                   return $ showd n ++ d' 
           else return $ showd n ++ d' ++ i'
      



getType = everything orElse ((Nothing `mkQ` getTypeTokenNum) `extQ` getTypeTokenType)

getTypeTokenNum (TokenDouble x) = Just "Float"
getTypeTokenNum (TokenInteger x) = Just "Int"
getTypeTokenNum (TokenHex x) = Just "Int"
getTypeTokenNum (TokenOctal x) = Just "Int"
getTypeTokenType (TokenString x) = Just "String"
getTypeTokenType (TokenKw "true") = Just "Bool"
getTypeTokenType (TokenKw "false") = Just "Bool"
getTypeTokenType _ = Nothing

namespace ns = concat $ map (\attr -> (case showd attr of { "private" -> "" -- all fields by default are private
                                                          ; "protected" -> "" -- in haXe private fields are accessible by subclasses
                                                          ; "internal" -> "public" ++ showw attr -- internal fields are used by different packages in as3
                                                          ; "dynamic" -> "dynamic /*class must implement Dynamic<Dynamic>*/" ++ showw attr
                                                          ; "final" -> ""
                                                          ; _ -> showb attr 
                                                          }
                                      ) ) ns

datatypet d = do{ d' <- datatype d; return $ span (\c -> isAlphaNum c || c =='>' || c == '<') d'}

datatype :: AsType -> StateT AsState IO String
datatype d = 
    case d of
        AsType n -> do d' <- (case (showd n) of 
                                  "void"    -> return "Void"
                                  "Boolean" -> return "Bool"
                                  "uint"    -> return "UInt"
                                  "int"     -> return "Int"
                                  "Number"  -> do ni <- getCLArg NumberToInt
                                                  if ni
                                                       then return "Int"
                                                       else return "Float"
                                  "String"  -> return "String"
                                  "*"       -> return "Dynamic"
                                  "Object"  -> return "Dynamic"
                                  "Function"-> return "Dynamic"
                                  "Array"   -> return "Array<Dynamic>"
                                  "XML"     -> return "XML"
                                  "RegExp"  -> return "EReg"
                                  "Class"   -> return "Class<Dynamic>"
                              )
                       return $ d' ++ showw n
        AsTypeRest -> return "Array<Dynamic>"
        AsTypeUser n -> return $ showb n

-- Changes type based on initializer value
datatypeiM d Nothing = datatype d
datatypeiM d i = 
    case d of
        AsType n -> do{ r <- case (showd n) of
                            "void"    -> return "Void"
                            "Boolean" -> return "Bool"
                            "uint"    -> return "UInt"
                            "int"     -> return "Int"
                            "Number"  -> do  case i of
                                                 Just (o, e) -> do{ if hasIntegerInit e
                                                                        then return "Int"
                                                                        else return "Float"
                                                                  } 
                                                 Nothing -> do ni <- getCLArg NumberToInt
                                                               if ni
                                                                   then return "Int"
                                                                   else return "Float"
                                           
                            "String"  -> return "String"
                            "*"       -> return "Dynamic"
                            "Object"  -> return "Dynamic"
                            "Function"-> return "Dynamic"
                            "Array"   -> return "Array<Dynamic>"
                            "XML"     -> return "XML"
                            "RegExp"  -> return "EReg"
                            "Class"   -> return "Class<Dynamic>"
                      ; return $ r ++ showw n
                      }
        AsTypeRest -> return $ "Array<Dynamic>"
        AsTypeUser n -> return $ showb n

hasIntegerInit = everything (||) (False `mkQ` isIntegerInit)

isIntegerInit (TokenInteger x) = True
isIntegerInit _ = False

{-
hasFloat = everything (||) (False `mkQ` isFloat)

isFloat (TokenDouble x) = True
isFloat _ = False
-}

primaryE x = case x of
                 PEThis x -> do{ return $ showb x}
                 PEIdent x -> do{ return $ showb x}
                 PELit x -> do{ return $ showb x}
                 PEArray x -> do{ r <- arrayLit x; return r}
                 PEObject x -> do{ r <- objectLit x; return r}
                 PEXml x -> do{ return $ "Xml.parse(\""++ showd x ++ "\")" ++ showw x}
                 PEFunc x -> do{ r <- funcE x; return r}
                 PEParens l x r -> do{ v <- listE x; return $ showb l ++ v ++ showd r ++ showw r}

arrayLit (ArrayLitC l x r) = do{ return $ showb l ++ maybe "" elision x ++ showb r }

arrayLit (ArrayLit l x r) = do{ e <- elementList x; return $ showb l ++ e ++ showb r}

elementList (El l e el r) = do{ es <- assignE e; els <- foldrM (\(EAE c p) s -> do{ ps <- assignE p; return $ elision c ++ ps ++ s}) "" el; return $ maybeEl elision l ++ es ++ els ++ maybeEl elision r }

elision (Elision x) = showl x

objectLit (ObjectLit l x r) = do{ p <- maybe (return "") propertyNameAndValueList x; return $ showb l ++ p ++ showb r}

propertyNameAndValueList (PropertyList x) = do
    p <- foldrM (\(p, c, e, s) str -> do{ ex <- assignE e; return $ showb p ++ showb c ++ ex ++ maybe "" showb s ++ str}) "" x
    return p

funcE (FuncE f i s b) = do{ x <- block b; s' <- signature s; return $ showb f ++ s' ++ x}

listE (ListE l) = do{ x <- foldrM (\(e, c) s -> do{es <- assignE e; return $ es ++ maybe "" showb c ++ s} ) "" l; return x}

listENoIn = listE

postFixE x = case x of
                 PFFull p o     -> do{ p' <- fullPostFixE p; o' <- postFixUp o; return $ p' ++ o'}
                 PFShortNew p o -> do{ p' <- shortNewE p; o' <- postFixUp o; return $ p' ++ o'}
    where postFixUp o = return $ maybe "" showb o

fullPostFixE x = case x of
                    FPFPrimary p sb  -> do{ e <- primaryE p; sub <- foldsub sb; return $ e ++ sub}
                    FPFFullNew f sb  -> do{ e <- fullNewE f; sub <- foldsub sb; return $ e ++ sub}
                    FPFSuper s p sb  -> do{ e <- superE s; p' <- propertyOp p; sub <- foldsub sb; return $ e ++ p' ++ sub}
    where foldsub sb = foldrM (\a b -> do{c <- fullPostFixSubE a; return $ c ++ b}) "" sb 

fullPostFixSubE x = case x of
                        FPSProperty p -> propertyOp p >>= return
                        FPSArgs     a -> args a >>= return
                        FPSQuery    q -> queryOp q >>= return

fullNewE (FN k e a) = do{ e' <- fullNewSubE e; a' <- args a; return $ showb k ++ e' ++ a'}

fullNewSubE x = case x of
                    FN _ _ _      -> do{ e <- fullNewE x; return e}
                    FNPrimary e p -> do{ e' <- primaryE e; p' <- foldprop p; return $ e' ++ p'}
                    FNSuper e p   -> do{ e' <- superE e; p' <- foldprop p; return $ e' ++ p'}
    where foldprop p = foldrM (\a b -> do{ a' <- propertyOp a; return $ a' ++ b}) "" p

shortNewE (SN k s) = do{ s' <- shortNewSubE s; return $ showb k ++ s'}

shortNewSubE x = case x of
                     SNSFull e  -> fullNewSubE e >>= return
                     SNSShort e -> shortNewE e >>= return

superE (SuperE k p) = do{ p' <- maybe (return "") args p; return $ showb k ++ p'}

propertyOp x = case x of
                   PropertyOp o n  -> return $ showb o ++ showb n
                   PropertyB l e r -> do{ e' <- listE e; return $ showb l ++ e' ++ showb r }

args (Arguments l e r)  = do{ e' <- maybe (return "") listE e; return $ showb l ++ e' ++ showb r}

queryOp x = case x of
                QueryOpDD o n    -> return $ showb o ++ showb n
                QueryOpD o l e r -> do{ e' <- listE e; return $ showb o ++ showb l ++ e' ++ showb r}

unaryE x = case x of
               UEDelete k p   -> do if checkDelete p
                                         then deleteField p >>= return
                                         else do{ p' <- postFixE p ; return $ showb k ++ p'}
               UEVoid k p     -> do{ p' <- postFixE p; return $ showb k ++ p'}
               UETypeof k p   -> do{ p' <- postFixE p; return $ showb k ++ p'}
               UEInc o p      -> do{ p' <- postFixE p; return $ showb o ++ p'}
               UEDec o p      -> do{ p' <- postFixE p; return $ showb o ++ p'}
               UEPlus o p     -> do{ p' <- unaryE p; return $ showb o ++ p'}
               UEMinus o p    -> do{ p' <- unaryE p; return $ showb o ++ p'}
               UEBitNot o p   -> do{ p' <- unaryE p; return $ showb o ++ p'}
               UENot o p      -> do{ p' <- unaryE p; return $ showb o ++ p'}
               UEPrimary p    -> postFixE p >>= return
    where checkDelete (PFFull (FPFPrimary (PEIdent i) [(FPSProperty (PropertyB _ _ _ ))]) _) = True
          checkDelete _ = False
          deleteField (PFFull (FPFPrimary (PEIdent i) [(FPSProperty (PropertyB l e r ))]) _) = 
              do e' <- listE e
                 return $ "Reflect.deleteField("++showd i++", "++e'++")"

aritE x = case x of
              AEUnary u  -> unaryE u >>= return
              AEBinary _ _ _ -> binaryE x >>= return 

aritENoIn = aritE

binaryE (AEBinary o x y)  
	| showd o == "as"  = do{ x' <- aritE x >>= (\c -> return $ splitLR c); y' <- aritE y >>= (\c -> return $ splitLR c); return $ "cast( "++ (x'!!1) ++", "++ (y'!!1) ++")" ++ (y'!!2) }
	| showd o == "is"  = do{ x' <- aritE x >>= (\c -> return $ splitLR c); y' <- aritE y >>= (\c -> return $ splitLR c); return $ "Std.is( "++ (x'!!1) ++", "++ (y'!!1) ++")" ++ (y'!!2) }
	| showd o == "==="  = do{ x' <- aritE x; y' <- aritE y; return $ x' ++"=="++showw o ++ y' }
	| showd o == "!=="  = do{ x' <- aritE x; y' <- aritE y; return $ x' ++"!="++showw o ++ y' }
    | otherwise        = do{ x' <- aritE x; y' <- aritE y; return $ x' ++ showb o ++ y'}


regE (RegE l x r o) = do{ return $ "~"++ showb l ++ showl x ++ showb r ++ maybeEl showb o}

condE (CondRE r) = do{ e <- regE r; return $ e}
condE (CondE e o) = do{ e' <- aritE e; o' <- maybe (return "") (\(q, e1, c, e2) -> do{ e1' <- assignE e1; e2' <- assignE e2; return $ showb q ++ e1' ++ showb c ++ e2'}) o; return $ e' ++ o'}

condENoIn = condE

nonAssignE (NAssignE e o) = do{ e' <- aritE e; o' <- maybe (return "") (\(q, e1, c, e2) -> do{ e1' <- nonAssignE e1; e2' <- nonAssignE e2; return $ showb q ++ e1' ++ showb c ++ e2'}) o; return $ e' ++ o'}

nonAssignENoIn = nonAssignE

assignE x = case x of
                ALogical p o a  -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' } 
                ACompound p o a -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' } 
                AAssign p o a   -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' } 
                ACond e         -> condE e >>= return

assignENoIn = assignE

typeE = nonAssignE
typeENoIn = nonAssignENoIn

expr (Expr x) = assignE x

forS (ForS k l finit s e s1 e1 r b) = 
    do if isIterator finit e e1
           then do let var = findVar finit 
                       start = findInt finit
                       rop = findROperand e
                   bound <- maybe (return "") (\r -> do{ r' <- aritE r; return r' }) rop
                   fblock <- block b
-- convert to iterator
                   return $ showb k ++ showb l ++ maybeEl showd var ++ " in " ++ maybeEl id start ++ "..." ++ bound ++ showb r ++ fblock
           else do fheader <- maybe (return "") cforInit finit
                   ftest <-  maybe (return "") listE e
                   ftail <- maybe (return "") listE e1
                   fblock <- cforBlock b ftail
                   ws <- wsBlock b
-- convert to while
                   return $ fheader ++ ";" ++ init ws ++ "while " ++ showb l ++ ftest ++ showb r ++ fblock
    where cforInit i = do case i of
                             FIListE l -> listE l >>= return
                             FIVarS v  -> varS v >>= return
          cforBlock (Block l bs r) tail = do bi <-  blockItemFold bs
                                             return $ showb l ++ bi ++ "\t" ++ tail ++ ";" ++ init (showw l) ++ showb r
          wsBlock (Block l bs r) = return $ showw l

isIterator fi e e1 = hasInteger fi && hasLessThan e && hasPlusPlus e1

hasInteger = everything (||) (False `mkQ` isInteger)

isInteger (TokenInteger x) = True
isInteger _ = False

hasLessThan = everything (||) (False `mkQ` isLessThan)

isLessThan (TokenOp x) = x == "<"
isLessThan _ = False

hasPlusPlus = everything (||) (False `mkQ` isPlusPlus)

isPlusPlus (TokenOp x) = x == "++"
isPlusPlus _ = False

findVar = everything orElse ((Nothing `mkQ` findVB) `extQ` findVA)
findVB (VarBinding n _ _) = Just n
findVA (PEIdent n) = Just n
findVA _ = Nothing

findInt = everything orElse (Nothing `mkQ` findI)
findI (TokenInteger x) = Just x
findI _ = Nothing

findROperand = everything orElse (Nothing `mkQ` findROp)
findROp (AEBinary op l r) = Just r
findROp _ = Nothing

forInS (ForInS  k me l fb i e r b) = 
    do if isJust me -- for each in?
           then do fb' <- eachBinding fb
                   e' <- listE e
                   b' <- block b
                   return $ showb k ++ showb l ++ fb' ++ showb i ++ e' ++ showb r ++ b'
           else do fb' <- elseBinding fb
                   e' <- listE e
                   b' <- block b
                   return $ showb k ++ showb l ++ fb' ++ showb i ++ e' ++ showb r ++ b'
    where eachBinding (FIBVar _ (VarBinding i _ _)) = return $ showd i ++ " "
          eachBinding (FIBPostE p) = do{ p' <- postFixE p; return $ p'}
          elseBinding (FIBVar v b) = do{ b' <- varBinding b; return $ showb v ++ b'}
          elseBinding (FIBPostE p) = do{ p' <- postFixE p; return $ p'}
