    {-# 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.Process
    import System.Directory
    import Data.List

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

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

    instance Preprocessor GCC where
        parseCPPArgs :: GCC -> [String] -> Either String (CppArgs, [String])
    parseCPPArgs GCC
    _ = [String] -> Either String (CppArgs, [String])
    gccParseCPPArgs
        runCPP :: GCC -> CppArgs -> IO ExitCode
    runCPP GCC
    gcc CppArgs
    cpp_args =
            do  -- copy the input to the outputfile, because in case the input is preprocessed,
                -- gcc -E will do nothing.
                IO () -> (String -> IO ()) -> Maybe String -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return()) (String -> String -> IO ()
    copyWritable (CppArgs -> String
    inputFile CppArgs
    cpp_args)) (CppArgs -> Maybe String
    outputFile CppArgs
    cpp_args)
                String -> [String] -> IO ExitCode
    rawSystem (GCC -> String
    gccPath GCC
    gcc) (CppArgs -> [String]
    buildCppArgs CppArgs
    cpp_args)
                    where copyWritable :: String -> String -> IO ()
    copyWritable String
    source String
    target = do String -> String -> IO ()
    copyFile String
    source String
    target
                                                          p <- String -> IO Permissions
    getPermissions String
    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 :: [String] -> Either String (CppArgs, [String])
    gccParseCPPArgs [String]
    args =
        case ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String
    forall a. Maybe a
    Nothing,Maybe String
    forall a. Maybe a
    Nothing,Reversed [CppOption]
    forall a. Reversed [a]
    RList.empty),(Reversed [String]
    forall a. Reversed [a]
    RList.empty,Reversed [String]
    forall a. Reversed [a]
    RList.empty)) [String]
    args of
            Left String
    err                   -> String -> Either String (CppArgs, [String])
    forall a b. a -> Either a b
    Left String
    err
            Right ((Maybe String
    Nothing,Maybe String
    _,Reversed [CppOption]
    _),(Reversed [String], Reversed [String])
    _)  -> String -> Either String (CppArgs, [String])
    forall a b. a -> Either a b
    Left String
    "No .c / .hc / .h source file given"
            Right ((Just String
    input_file,Maybe String
    output_file_opt,Reversed [CppOption]
    cpp_opts),(Reversed [String]
    extra_args,Reversed [String]
    other_args))
                -> (CppArgs, [String]) -> Either String (CppArgs, [String])
    forall a b. b -> Either a b
    Right (([String] -> String -> CppArgs
    rawCppArgs (Reversed [String] -> [String]
    forall a. Reversed [a] -> [a]
    RList.reverse Reversed [String]
    extra_args) String
    input_file)
                          { outputFile = output_file_opt, cppOptions = RList.reverse cpp_opts },
                          Reversed [String] -> [String]
    forall a. Reversed [a] -> [a]
    RList.reverse Reversed [String]
    other_args)
        where
        mungeArgs :: ParseArgsState -> [String] -> Either String ParseArgsState
        mungeArgs :: ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs parsed :: ParseArgsState
    parsed@( cpp_args :: (Maybe String, Maybe String, Reversed [CppOption])
    cpp_args@(Maybe String
    inp,Maybe String
    out,Reversed [CppOption]
    cpp_opts),
                              unparsed :: (Reversed [String], Reversed [String])
    unparsed@(Reversed [String]
    extra,Reversed [String]
    other))
                  [String]
    unparsed_args =
            case [String]
    unparsed_args of
                (String
    "-E":[String]
    rest) -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ParseArgsState
    parsed [String]
    rest

                (String
    flag:String
    flagArg:[String]
    rest) | String
    flag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-MF"
                                    Bool -> Bool -> Bool
    || String
    flag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-MT"
                                    Bool -> Bool -> Bool
    || String
    flag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-MQ"
                                    -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String, Maybe String, Reversed [CppOption])
    cpp_args,(Reversed [String]
    extra,Reversed [String]
    other Reversed [String] -> String -> Reversed [String]
    forall a. Reversed [a] -> a -> Reversed [a]
    `snoc` String
    flag Reversed [String] -> String -> Reversed [String]
    forall a. Reversed [a] -> a -> Reversed [a]
    `snoc` String
    flagArg)) [String]
    rest

                (String
    flag:[String]
    rest) |  String
    flag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-c"
                            Bool -> Bool -> Bool
    || String
    flag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-S"
                            Bool -> Bool -> Bool
    || String
    "-M" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    flag
                            -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String, Maybe String, Reversed [CppOption])
    cpp_args,(Reversed [String]
    extra,Reversed [String]
    other Reversed [String] -> String -> Reversed [String]
    forall a. Reversed [a] -> a -> Reversed [a]
    `snoc` String
    flag)) [String]
    rest

                (String
    "-o":String
    file:[String]
    rest)   | Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    out -> String -> Either String ParseArgsState
    forall a b. a -> Either a b
    Left String
    "two output files given"
                                   | Bool
    otherwise          -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String
    inp,String -> Maybe String
    forall a. a -> Maybe a
    Just String
    file,Reversed [CppOption]
    cpp_opts),(Reversed [String], Reversed [String])
    unparsed) [String]
    rest

                (String
    cpp_opt:[String]
    rest)     | Just (CppOption
    opt,[String]
    rest') <- String -> [String] -> Maybe (CppOption, [String])
    getArgOpt String
    cpp_opt [String]
    rest
                                   -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String
    inp,Maybe String
    out,Reversed [CppOption]
    cpp_opts Reversed [CppOption] -> CppOption -> Reversed [CppOption]
    forall a. Reversed [a] -> a -> Reversed [a]
    `snoc` CppOption
    opt),(Reversed [String], Reversed [String])
    unparsed) [String]
    rest'

                (String
    cfile:[String]
    rest)       | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    cfile) (String -> [String]
    words String
    ".c .hc .h")
                                   -> if Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    inp
                                       then String -> Either String ParseArgsState
    forall a b. a -> Either a b
    Left String
    "two input files given"
                                       else ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((String -> Maybe String
    forall a. a -> Maybe a
    Just String
    cfile,Maybe String
    out,Reversed [CppOption]
    cpp_opts),(Reversed [String], Reversed [String])
    unparsed) [String]
    rest

                (String
    unknown:[String]
    rest)     -> ParseArgsState -> [String] -> Either String ParseArgsState
    mungeArgs ((Maybe String, Maybe String, Reversed [CppOption])
    cpp_args,(Reversed [String]
    extra Reversed [String] -> String -> Reversed [String]
    forall a. Reversed [a] -> a -> Reversed [a]
    `snoc` String
    unknown,Reversed [String]
    other)) [String]
    rest

                []                 -> ParseArgsState -> Either String ParseArgsState
    forall a b. b -> Either a b
    Right ParseArgsState
    parsed

        getArgOpt :: String -> [String] -> Maybe (CppOption, [String])
    getArgOpt String
    cpp_opt [String]
    rest | String
    "-I" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    cpp_opt = (CppOption, [String]) -> Maybe (CppOption, [String])
    forall a. a -> Maybe a
    Just (String -> CppOption
    IncludeDir (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 String
    cpp_opt),[String]
    rest)
                               | String
    "-U" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    cpp_opt = (CppOption, [String]) -> Maybe (CppOption, [String])
    forall a. a -> Maybe a
    Just (String -> CppOption
    Undefine (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 String
    cpp_opt),[String]
    rest)
                               | String
    "-D" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    cpp_opt = (CppOption, [String]) -> Maybe (CppOption, [String])
    forall a. a -> Maybe a
    Just (String -> CppOption
    getDefine (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 String
    cpp_opt),[String]
    rest)
        getArgOpt String
    "-include" (String
    f:[String]
    rest')                     = (CppOption, [String]) -> Maybe (CppOption, [String])
    forall a. a -> Maybe a
    Just (String -> CppOption
    IncludeFile String
    f, [String]
    rest')
        getArgOpt String
    _ [String]
    _ = Maybe (CppOption, [String])
    forall a. Maybe a
    Nothing
        getDefine :: String -> CppOption
    getDefine String
    opt = let (String
    key,String
    val) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') String
    opt in String -> String -> CppOption
    Define String
    key (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    val)

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

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