-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Wrapper.Preprocess
-- Copyright   :  (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Invoking external preprocessors.
-----------------------------------------------------------------------------
module Language.C.System.Preprocess (
    Preprocessor(..),
    CppOption(..),
    CppArgs(..),rawCppArgs,addCppOption,addExtraOption,cppFile,
    runPreprocessor,
    isPreprocessed,
)
where
import Language.C.Data.InputStream
import System.Exit
import System.Directory
import System.FilePath
import System.IO
import Control.Exception
import Control.Monad
import Data.List

-- | 'Preprocessor' encapsulates the abstract interface for invoking C preprocessors
class Preprocessor cpp where
    -- | parse the given command line arguments, and return a pair of parsed and ignored arguments
    parseCPPArgs :: cpp -> [String] -> Either String (CppArgs, [String])
    -- | run the preprocessor
    runCPP :: cpp -> CppArgs -> IO ExitCode

-- | file extension of a preprocessed file
preprocessedExt :: String
preprocessedExt :: String
preprocessedExt = String
".i"

-- | Generic Options for the preprocessor
data CppOption =
        IncludeDir FilePath
      | Define String String
      | Undefine String
      | IncludeFile FilePath

-- | Generic arguments for the preprocessor
data CppArgs = CppArgs {
        CppArgs -> [CppOption]
cppOptions :: [CppOption],
        CppArgs -> [String]
extraOptions :: [String],
        CppArgs -> Maybe String
cppTmpDir  :: Maybe FilePath,
        CppArgs -> String
inputFile  :: FilePath,
        CppArgs -> Maybe String
outputFile :: Maybe FilePath
    }

-- | Cpp arguments that only specify the input file name.
cppFile :: FilePath -> CppArgs
cppFile :: String -> CppArgs
cppFile String
input_file = CppArgs { cppOptions :: [CppOption]
cppOptions = [], extraOptions :: [String]
extraOptions = [], cppTmpDir :: Maybe String
cppTmpDir = Maybe String
forall a. Maybe a
Nothing, inputFile :: String
inputFile = String
input_file, outputFile :: Maybe String
outputFile = Maybe String
forall a. Maybe a
Nothing }


-- | use the given preprocessor arguments without analyzing them
rawCppArgs :: [String] -> FilePath -> CppArgs
rawCppArgs :: [String] -> String -> CppArgs
rawCppArgs [String]
opts String
input_file =
    CppArgs { inputFile :: String
inputFile = String
input_file, cppOptions :: [CppOption]
cppOptions = [], extraOptions :: [String]
extraOptions = [String]
opts, outputFile :: Maybe String
outputFile = Maybe String
forall a. Maybe a
Nothing, cppTmpDir :: Maybe String
cppTmpDir = Maybe String
forall a. Maybe a
Nothing }

-- | add a typed option to the given preprocessor arguments
addCppOption :: CppArgs -> CppOption -> CppArgs
addCppOption :: CppArgs -> CppOption -> CppArgs
addCppOption CppArgs
cpp_args CppOption
opt =
    CppArgs
cpp_args { cppOptions = opt : cppOptions cpp_args }

-- | add a string option to the given preprocessor arguments
addExtraOption :: CppArgs -> String -> CppArgs
addExtraOption :: CppArgs -> String -> CppArgs
addExtraOption CppArgs
cpp_args String
extra =
    CppArgs
cpp_args { extraOptions = extra : extraOptions cpp_args }

-- | run the preprocessor and return an 'InputStream' if preprocesssing succeeded
runPreprocessor :: (Preprocessor cpp) => cpp -> CppArgs -> IO (Either ExitCode InputStream)
runPreprocessor :: forall cpp.
Preprocessor cpp =>
cpp -> CppArgs -> IO (Either ExitCode InputStream)
runPreprocessor cpp
cpp CppArgs
cpp_args =
    IO String
-> (String -> IO ())
-> (String -> IO (Either ExitCode InputStream))
-> IO (Either ExitCode InputStream)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        IO String
getActualOutFile
        -- remove outfile if it was temporary
        String -> IO ()
removeTmpOutFile
        -- invoke preprocessor
        String -> IO (Either ExitCode InputStream)
invokeCpp
    where
    getActualOutFile :: IO FilePath
    getActualOutFile :: IO String
getActualOutFile = IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String -> String -> IO String
mkOutputFile (CppArgs -> Maybe String
cppTmpDir CppArgs
cpp_args) (CppArgs -> String
inputFile CppArgs
cpp_args)) String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CppArgs -> Maybe String
outputFile CppArgs
cpp_args)
    invokeCpp :: String -> IO (Either ExitCode InputStream)
invokeCpp String
actual_out_file = do
        ExitCode
exit_code <- cpp -> CppArgs -> IO ExitCode
forall cpp. Preprocessor cpp => cpp -> CppArgs -> IO ExitCode
runCPP cpp
cpp (CppArgs
cpp_args { outputFile = Just actual_out_file})
        case ExitCode
exit_code of
            ExitCode
ExitSuccess   -> (InputStream -> Either ExitCode InputStream)
-> IO InputStream -> IO (Either ExitCode InputStream)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM InputStream -> Either ExitCode InputStream
forall a b. b -> Either a b
Right (String -> IO InputStream
readInputStream String
actual_out_file)
            ExitFailure Int
_ -> Either ExitCode InputStream -> IO (Either ExitCode InputStream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ExitCode InputStream -> IO (Either ExitCode InputStream))
-> Either ExitCode InputStream -> IO (Either ExitCode InputStream)
forall a b. (a -> b) -> a -> b
$ ExitCode -> Either ExitCode InputStream
forall a b. a -> Either a b
Left ExitCode
exit_code
    removeTmpOutFile :: String -> IO ()
removeTmpOutFile String
out_file = IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO ()
removeFile String
out_file) (\String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (CppArgs -> Maybe String
outputFile CppArgs
cpp_args)

-- | create an output file, given  @Maybe tmpdir@ and @inputfile@
mkOutputFile :: Maybe FilePath -> FilePath -> IO FilePath
mkOutputFile :: Maybe String -> String -> IO String
mkOutputFile Maybe String
tmp_dir_opt String
input_file =
    do String
tmpDir <- Maybe String -> IO String
getTempDir Maybe String
tmp_dir_opt
       String -> String -> IO String
mkTmpFile String
tmpDir (String -> String
getOutputFileName String
input_file)
    where
    getTempDir :: Maybe String -> IO String
getTempDir (Just String
tmpdir) = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
tmpdir
    getTempDir Maybe String
Nothing       = IO String
getTemporaryDirectory

-- | compute output file name from input file name
getOutputFileName :: FilePath -> FilePath
getOutputFileName :: String -> String
getOutputFileName String
fp | String -> Bool
hasExtension String
fp = String -> String -> String
replaceExtension String
filename String
preprocessedExt
                     | Bool
otherwise       = String -> String -> String
addExtension String
filename String
preprocessedExt
    where
    filename :: String
filename = String -> String
takeFileName String
fp

-- | create a temporary file
mkTmpFile :: FilePath -> FilePath -> IO FilePath
mkTmpFile :: String -> String -> IO String
mkTmpFile String
tmp_dir String
file_templ = do
    -- putStrLn $ "TmpDir: "++tmp_dir
    -- putStrLn $ "FileTempl: "++file_templ
    (String
path,Handle
file_handle) <- String -> String -> IO (String, Handle)
openTempFile String
tmp_dir String
file_templ
    Handle -> IO ()
hClose Handle
file_handle
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path

-- | guess whether a file is preprocessed (file end with .i)
isPreprocessed :: FilePath -> Bool
isPreprocessed :: String -> Bool
isPreprocessed = (String
".i" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)