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.NameResolution
import Language.Java.Paragon.TypeCheck
import Language.Java.Paragon.Compile
import Language.Java.Paragon.PiGeneration
import Language.Java.Paragon.Interaction

import Language.Java.Paragon.Monad.Base

import System.FilePath
import System.Environment
import System.IO.Error (isDoesNotExistError)
import Control.Exception
--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
  mapM_ setVerbosity $ [ k | Verbose k <- flags ]
  when (Version `elem` flags)
           $ normalPrint paracVersionString
  when (Help    `elem` flags || null flags && null files) 
           $ normalPrint $ usageInfo usageHeader options
  when (not (null files)) $
    compile flags (head files) -- TODO: Enable multiple files

data Flag = Verbose Int | Version | Help | PiPath String
  deriving (Show, Eq)

paracVersionString, usageHeader :: String
paracVersionString = "Paragon Compiler version: " ++ versionString
usageHeader = "Usage: parac [OPTION...] files..."

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"
    , Option ['h','?'] ["help"]
                 (NoArg Help)          "Show this help"
    , Option ['p'] ["pipath"]
                 (ReqArg PiPath "<path>")
                 "Path to the root directory for Paragon interface (.pi) files (default is . )"
    ]

compilerOpts :: [String] -> IO ([Flag], [String])
compilerOpts argv =
    case getOpt RequireOrder options argv of
      (o,n,[]) -> return (o,n)
      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))



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

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

compile :: [Flag] -> String -> IO ()
compile flags filePath = do
  debugPrint $ "Filepath: " ++ filePath
  let (directoryRaw,_fileName) = splitFileName filePath --relative or absolute path?
      -- Workaround for old and buggy 'filepath' versions
      _directory = if null directoryRaw then "./" else directoryRaw
  pp <- getPIPATH
  let pDirsSpec = concat [ splitSearchPath dir | PiPath dir <- flags ] ++ pp
      pDirs = if null pDirsSpec then ["./"] else pDirsSpec
  debugPrint $ show pDirs
  fc <- readFile filePath
  runBaseErr $ do
    ast <- liftShowEither $ parser compilationUnit fc
    detailPrint "Parsing complete!"
    ast1 <- resolveNames pDirs ast
    detailPrint "Name resolution complete!"
    debugPrint $ prettyPrint ast1
    ast2 <- typeCheck pDirs ast1
    detailPrint "Type checking complete!"
    liftIO $ genFiles filePath  ast2
    detailPrint "File generation complete!"

getPIPATH :: IO [FilePath]
getPIPATH = do
  ePpStr <- tryJust (guard . isDoesNotExistError) $ getEnv "PIPATH"
  return $ splitSearchPath $ either (const []) id ePpStr

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