{-# 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 -> FilePath
gccPath :: FilePath }

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

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

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

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

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

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

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

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

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

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

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


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