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

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

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

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

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

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

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

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

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

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

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

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


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