--
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
--               2005 Stefan Wehr - http://www.stefanwehr.de
--
-- 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 2 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, write to the Free Software
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-- 

module Main ( main ) where

import System.Exit              ( exitWith, ExitCode(..) )
import System.Environment       ( getArgs, getProgName )
import System.Console.GetOpt
import System.IO                ( hFlush, stdin, stdout, stderr, hPutStrLn )

import Phrac.Driver
import Phrac.Error
import Phrac.Configuration
import Phrac.Constants

main :: IO ()
main = do
    args          <- getArgs
    prog          <- getProgName
    (flags,file) <- parseArgs args prog
    res           <- startFromSrc flags file
    case res of
      Left err ->
          do hFlush stdout
             hPutStrLn stderr err
             exitWith (ExitFailure 1)
      Right _ -> exitWith ExitSuccess



-- ---------------------------------------------------------------------
-- Handling command line flags

--
-- associate concrete flags with their abstract representation
--
opts :: [OptDescr Flag]
opts = 
    [ Option ['v'] ["version"] (NoArg Version) "version string"
    , Option ['?']    ["help"] (NoArg Help) "this message"
    , Option []    ["debug"] (NoArg (DebugLevel Debug)) "enable debug messages"
    , Option []    ["verbose"] (NoArg (DebugLevel Verbose)) 
            "be verbose (but not as much as with `--debug')"
    , Option []    ["dont-run"] (NoArg DontRun) 
            "don't run the program"
    , Option []    ["no-prelude"] (NoArg NoPrelude) 
            "don't load the prelude"
    , Option []    ["exit-after-dump"] (NoArg ExitAfterDump) 
            "terminate the program after dumping"
    , Option []    ["dump-lex"]   (NoArg (Dump Lex  )) 
            "dump lexed tokens"
    , Option []    ["dump-parse"]  (NoArg (Dump Parse)) 
            "print syntax tree after parsing"
    , Option []    ["dump-rawparse"]   (NoArg (Dump RawParse)) 
            "dump data type after parsing"
    , Option []    ["dump-ast"]  (NoArg (Dump AST)) 
            "print abstract syntax tree"
    , Option []    ["dump-rawast"]   (NoArg (Dump RawAST)) 
            "dump abstract syntax data type"
    , Option []    ["dump-kindinfer"]   (NoArg (Dump KindInfer)) 
            "print kinds after kind inference"
    , Option []    ["dump-infer"]   (NoArg (Dump TypeInfer)) 
            "print types after type inference"
    , Option []    ["dump-over"]   (NoArg (Dump OverReso)) 
            "print syntax after overloading resolution"
    , Option []    ["no-location"]  (NoArg NoLocation) 
            "do not print source file locations in error messages" 
    , Option []    ["allow-diverging-tysyns"]
          (NoArg (TerminationCondition AllowDiverge))
          "do not check if the rewrite system for type synonyms is terminating"
    ]


--
-- parse the args.
--
-- we also short circuit here, for the known cases of --version or --help
--
parseArgs :: [String] -> String -> IO ([Flag], Maybe FilePath)
parseArgs argv prog = case (getOpt Permute opts argv) of

    (flags,fs,[]) -> case () of { _ 
         | Version `elem` flags -> putStrLn phracVersion >> exitWith ExitSuccess
         | Help `elem` flags -> putStrLn usage   >> exitWith ExitSuccess
--         | null fs           -> error usage
         | otherwise         -> return (flags, if null fs 
                                                  then Nothing
                                                  else Just $ head fs)
    }
    (_,_,err) -> error $ concat err ++ usage

    where usage = usageInfo ("Usage: "++ prog ++" [OPTION...] file") opts