as2hx.hs

-- The program use types.used and import.stars generated by as2hx.txl to automatically generate the import clauses in Haxe (For Haxe 2.x doesn't support import xxx.*)
-- FIXME the ambiguous class reference isn't detected
module Main where
import System.Cmd
import System.Exit
import System.Environment
import System.Directory
import Data.List
import HaxeFind
import Control.Monad
import Control.Exception
import Control.Applicative
import Control.Monad.Instances

main :: IO ()
main = do
    args <- getArgs
    if length args /= 1 then putStrLn "Usage: as2hx [file|directory]"
    else
        let fileName = head args in 
        if isSuffixOf ".as" fileName then translate fileName
        else
            do
                b <- doesDirectoryExist fileName
                if b then translateInDir fileName
                else putStrLn "Argument Error!"

translateInDir :: String -> IO ()
translateInDir dirName = do
    putStrLn $ "Translating all *.as in: " ++ dirName
    putStrLn $ "==============================="

    getFilesInDir dirName >>= mapM_ translate

    where
        getFilesInDir :: String -> IO [String]
        getFilesInDir dirName = do
            files <- getDirectoryContents dirName >>= filterM (return . (isSuffixOf ".as")) >>= mapM (return . (prefix++))
            dirs <- getDirectoryContents dirName >>= (mapM (return . (prefix++))) . (filter $ \f -> (f /= "." && f /= "..")) >>= filterM doesDirectoryExist
            return . (files++) . concat =<< mapM getFilesInDir dirs
            where
                prefix = if (last dirName) /= '/' && (last dirName) /= '\\' then dirName ++ "/" else dirName

translate :: String -> IO ()
translate fileName = do
    putStrLn $ "Translating File: " ++ fileName
    putStrLn $ "+++++++++++++++++++++++++++++++"

    mapM_ ifRemoveFile ["import.stars", "temp.o", "types.used", "import.gen"]
    system ("txl " ++ fileName ++ " -o temp.o") >>= checkExitCode


    haxePath <- getEnv "HAXEPATH"

    importLines <- getFromFile "import.stars"
    -- get all classes from the import xxx.* given
    classLists <- mapM (\line -> do
            classes <- case (stripPrefix "import " line) of
                Just l -> liftM2 (++) (findClassesLocal fileDir l) $ findClasses haxePath l 
                Nothing -> return []
            return (line, classes) ) $ lines importLines

    -- get types and generate import clauses
    typeContents <- getFromFile "types.used"
    types <- return $ nub $ lines typeContents
    let primaryGenLines = map (\t -> case find (elem t . snd) classLists of
                    Just l -> replaceToStr '*' t $ fst l
                    Nothing -> "Error" ) types
        genLines = filter (/="Error") primaryGenLines
        result = foldr (++) [] $ map (++"\n") genLines
    -- putStrLn $ show $ zip types primaryGenLines -- uncomment this to debug
    -- write to import.gen
    putStrLn "Generated import clauses:"
    putStrLn result
    writeFile "import.gen" result

    createDirectoryIfMissing True "hxOutput"
    createDirectoryForFile fileName
    system ("txl temp.o as2hxPost.txl -o hxOutput/" ++ (take ((length fileName) - 3) fileName) ++ ".hx") >>= checkExitCode
    return ()

    where
        fileDir = fst $ splitAt (last $ findIndices ((||) <$> (=='/') <*> (=='\\')) fileName) fileName
        ifRemoveFile filePath = do
            b <- doesFileExist filePath
            when b $ removeFile filePath
        getFromFile filePath = do
            b <- doesFileExist filePath
            if b then readFile filePath else return ""
        createDirectoryForFile fileName = do
            when (directory /= "") $ createDirectoryIfMissing True $ "hxOutput/" ++ directory
            where
                directory = splitDirectory fileName
                splitDirectory name
                    | last name == '/' = name
                    | otherwise = splitDirectory $ init name
                    
        checkExitCode :: ExitCode -> IO ()
        checkExitCode exitCode = do
            when (exitCode /= ExitSuccess) $ throwIO exitCode


-- Helper

replaceToStr :: Eq a => a -> [a] -> [a] -> [a]
replaceToStr c str [] = []
replaceToStr c str (x:xs) = if x == c
    then str ++ replaceToStr c str xs
    else x:replaceToStr c str xs