Paragon.hs

-- module Language.Java.Paragon where

import Language.Java.Paragon.Syntax
import Language.Java.Paragon.Parser
import Language.Java.Paragon.Pretty
import Language.Java.Paragon.TypeCheck
import Language.Java.Paragon.Compile
import Language.Java.Paragon.PiGeneration
--import Language.Java.Paragon.TypeCheck.TcEnv
--import Language.Java.Paragon.TypeCheck.Locks
--import Language.Java.Paragon.TypeCheck.Policy
--import qualified Language.Java.Paragon.TypeCheck.Types as TP
import Language.Java.Paragon.Verbosity

import System.FilePath
import System.Environment
import System.Directory
import Control.Monad
import qualified Data.Map as DM
import Data.Maybe

import System.Console.GetOpt

-------------------------------------------------------------------------------------
main :: IO ()
main = do
  (flags, files) <- compilerOpts =<< getArgs
  when (Version `elem` flags) $ putStrLn versionString
  mapM_ setVerbosity $ [ k | Verbose k <- flags ]
  when (not (null files)) $
    compile flags (head files) -- TODO: Enable multiple files

-- This probably needs to live somewhere else
data Flag = Verbose Int | Version
  deriving (Show, Eq)

versionString :: String
versionString = "Paragon Compiler version: 0.1.5"

options :: [OptDescr Flag]
options =
    [ Option ['v'] ["verbose"] 
                 (OptArg (Verbose . maybe 3 read) "n") 
                 "Control verbosity (n is 0--4, normal verbosity level is 1, -v alone is equivalent to -v3"
    , Option ['V','?'] ["version"] 
                 (NoArg Version)       "Show version number"
    ]

compilerOpts :: [String] -> IO ([Flag], [String])
compilerOpts argv =
    case getOpt RequireOrder options argv of
      (o,n,[]) -> return (o,n)
      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
          where header = "Usage: parac [OPTION...] files..."

-------------------------------------------------------------------------------------
--type ErrM = Either String

liftE :: Show e => Either e a -> IO a
liftE eea = case eea of
              Right a -> return a
              Left  e -> fail $ show e

debugPrint :: String -> IO ()
debugPrint = putStrLn
--debugPrint = return ()

compile :: [Flag] -> String -> IO ()
compile flags filePath = do
  let (directory,fileName) = splitFileName filePath --relative or absolute path?
  fc <- readFile filePath
  ast <- liftE $ parser compilationUnit fc
  verbosePrint 2 "Parsing complete!"
  ast2 <- typeCheck directory ast
  verbosePrint 2 "Type checking complete!"
  genFiles filePath  ast2
  verbosePrint 2 "File generation complete!"

genFiles :: FilePath -> CompilationUnit -> IO ()
genFiles filePath ast  = let astC      = compileTransform ast
                             astPi     = piTransform ast 
                             baseName  = takeBaseName filePath
                             directory = takeDirectory filePath
                             javaPath  = directory </> baseName <.> "java"
                             piPath    = directory </> baseName <.> "pi"
                             java,pi :: String
                             java      = prettyPrint astC
                             pi        = prettyPrint astPi
                         in writeFile javaPath java
                            >> writeFile piPath pi