    {-# LANGUAGE PatternGuards #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.System.Gcc
    -- Copyright   :  (c) 2008 Benedikt Huber
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Invoking gcc for preprocessing and compiling.
    -----------------------------------------------------------------------------
    module Language.C.System.GCC (
        GCC,newGCC,
    )
    where
    import Language.C.Data.RList as RList
    import Language.C.System.Preprocess
    import Data.Maybe
    import System.Cmd
    import System.Directory
    import Data.List

    -- | @GCC@ represents a reference to the gcc compiler
    newtype GCC = GCC { gccPath :: FilePath }

    -- | create a reference to @gcc@
    newGCC :: FilePath -> GCC
    newGCC = GCC

    instance Preprocessor GCC where
        parseCPPArgs _ = gccParseCPPArgs
        runCPP gcc cpp_args =
            do  -- copy the input to the outputfile, because in case the input is preprocessed,
                -- gcc -E will do nothing.
                maybe (return()) (copyWritable (inputFile cpp_args)) (outputFile cpp_args)
                rawSystem (gccPath gcc) (buildCppArgs cpp_args)
                    where copyWritable source target = do copyFile source target
                                                          p <- getPermissions target
                                                          setPermissions target p{writable=True}

    -- | Parse arguments for preprocessing via GCC.
    --   At least one .c, .hc or .h file has to be present.
    --   For now we only support the most important gcc options.
    --
    --   1) Parse all flags relevant to CppArgs
    --   2) Move -c,-S,-M? to other_args
    --   3) Strip -E
    --   4) The rest goes into extra_args
    gccParseCPPArgs :: [String] -> Either String (CppArgs, [String])
    gccParseCPPArgs args =
        case mungeArgs ((Nothing,Nothing,RList.empty),(RList.empty,RList.empty)) args of
            Left err                   -> Left err
            Right ((Nothing,_,_),_)  -> Left "No .c / .hc / .h source file given"
            Right ((Just input_file,output_file_opt,cpp_opts),(extra_args,other_args))
                -> Right ((rawCppArgs (RList.reverse extra_args) input_file)
                          { outputFile = output_file_opt, cppOptions = RList.reverse cpp_opts },
                          RList.reverse other_args)
        where
        mungeArgs :: ParseArgsState -> [String] -> Either String ParseArgsState
        mungeArgs parsed@( cpp_args@(inp,out,cpp_opts),
                              unparsed@(extra,other))
                  unparsed_args =
            case unparsed_args of
                ("-E":rest) -> mungeArgs parsed rest

                (flag:rest) |  flag == "-c"
                            || flag == "-S"
                            || "-M" `isPrefixOf` flag
                            -> mungeArgs (cpp_args,(extra,other `snoc` flag)) rest

                ("-o":file:rest)   | isJust out -> Left "two output files given"
                                   | otherwise          -> mungeArgs ((inp,Just file,cpp_opts),unparsed) rest

                (cpp_opt:rest)     | Just (opt,rest') <- getArgOpt cpp_opt rest
                                   -> mungeArgs ((inp,out,cpp_opts `snoc` opt),unparsed) rest'

                (cfile:rest)       | any (flip isSuffixOf cfile) (words ".c .hc .h")
                                   -> if isJust inp
                                       then Left "two input files given"
                                       else mungeArgs ((Just cfile,out,cpp_opts),unparsed) rest

                (unknown:rest)     -> mungeArgs (cpp_args,(extra `snoc` unknown,other)) rest

                []                 -> Right parsed

        getArgOpt cpp_opt rest | "-I" `isPrefixOf` cpp_opt = Just (IncludeDir (drop 2 cpp_opt),rest)
                               | "-U" `isPrefixOf` cpp_opt = Just (Undefine (drop 2 cpp_opt),rest)
                               | "-D" `isPrefixOf` cpp_opt = Just (getDefine (drop 2 cpp_opt),rest)
        getArgOpt "-include" (f:rest')                     = Just (IncludeFile f, rest')
        getArgOpt _ _ = Nothing
        getDefine opt = let (key,val) = break (== '=') opt in Define key (if null val then "" else tail val)

    type ParseArgsState = ((Maybe FilePath, Maybe FilePath, RList CppOption), (RList String, RList String))

    buildCppArgs :: CppArgs -> [String]
    buildCppArgs (CppArgs options extra_args _tmpdir input_file output_file_opt) = do
           (concatMap tOption options)
        ++ outputFileOpt
        ++ ["-E", input_file]
        ++ extra_args
        where
        tOption (IncludeDir incl)  = ["-I",incl]
        tOption (Define key value) = [ "-D" ++ key ++ (if null value then "" else "=" ++ value) ]
        tOption (Undefine key)     = [ "-U" ++ key ]
        tOption (IncludeFile f)    = [ "-include", f]
        outputFileOpt = concat [ ["-o",output_file] | output_file <- maybeToList output_file_opt ]