module Main (main) where

import qualified Data.ByteString as BS
import Language.C
import Language.C.System.GCC
import Language.C.System.Preprocess
import System.Environment
import System.Exit
import System.IO

main :: IO ()
main = do
  args <- getArgs
  if needHelp args then help else do
    let a = parseArgs Args { defines = [], includes = [], output = "a.out", inputs = [] } args
    a <- mapM (parse (includes a) (defines a)) (inputs a)
    mapM_ (print . pretty) a

data Args = Args
  { defines  :: [(String, String)]
  , includes :: [FilePath]
  , output   :: FilePath
  , inputs   :: [FilePath]
  } deriving Show

needHelp :: [String] -> Bool
needHelp args = null args || elem "-h" args || elem "--help" args

parseArgs :: Args -> [String] -> Args
parseArgs a b = case b of
  [] -> a
  "-o" : file : args -> parseArgs a { output = file } args
  arg : args | isInclude -> parseArgs a { includes = includes a ++ [drop 2 arg]    } args
             | isDefine  -> parseArgs a { defines  = defines a  ++ [(name, value)] } args
    where
    isInclude = length arg > 2 && take 2 arg == "-I"
    isDefine  = length arg > 2 && take 2 arg == "-D"
    (name, value') = span (/= '=') $ drop 2 arg
    value = if length value' <= 1 then "1" else tail value'
  files -> a { inputs = files }
 
help :: IO ()
help = putStrLn "synopsis : hcc {-Idir} {-Dmacro[=def]} [-o outfile] infile {infile}"

parse :: [FilePath] -> [(String,String)] -> FilePath -> IO CTranslUnit
parse includes defines file = do
  putStrLn $ "parsing " ++ file ++ "..."
  a <- preprocess includes defines file
  case parseC a (initPos file) of
    Left e  -> error $ show e
    Right a -> return a

preprocess :: [FilePath] -> [(String,String)] -> FilePath -> IO InputStream
preprocess includes defines file = do
  a <- runPreprocessor (newGCC "/usr/bin/gcc") CppArgs
    { cppOptions = map IncludeDir includes ++ map (\ (a,b) -> Define a b) defines
    , extraOptions = []
    , cppTmpDir = Nothing
    , inputFile = file
    , outputFile = Nothing
    }
  case a of
    Left e  -> exitWith e
    Right a -> return a