{-# 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
                                                      Permissions
p <- String -> IO Permissions
getPermissions String
target
                                                      String -> Permissions -> IO ()
setPermissions String
target Permissions
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 ]