-----------------------------------------------------------------------------
-- |
-- 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 = ".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 input_file :: String
input_file = CppArgs :: [CppOption]
-> [String] -> Maybe String -> String -> Maybe String -> CppArgs
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 opts :: [String]
opts input_file :: String
input_file =
    CppArgs :: [CppOption]
-> [String] -> Maybe String -> String -> Maybe String -> CppArgs
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 cpp_args :: CppArgs
cpp_args opt :: CppOption
opt =
    CppArgs
cpp_args { cppOptions :: [CppOption]
cppOptions = CppOption
opt CppOption -> [CppOption] -> [CppOption]
forall a. a -> [a] -> [a]
: CppArgs -> [CppOption]
cppOptions CppArgs
cpp_args }

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

-- | run the preprocessor and return an 'InputStream' if preprocesssing succeeded
runPreprocessor :: (Preprocessor cpp) => cpp -> CppArgs -> IO (Either ExitCode InputStream)
runPreprocessor :: cpp -> CppArgs -> IO (Either ExitCode InputStream)
runPreprocessor cpp :: cpp
cpp cpp_args :: 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 (m :: * -> *) a. Monad m => a -> m a
return (CppArgs -> Maybe String
outputFile CppArgs
cpp_args)
    invokeCpp :: String -> IO (Either ExitCode InputStream)
invokeCpp actual_out_file :: 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 :: Maybe String
outputFile = String -> Maybe String
forall a. a -> Maybe a
Just String
actual_out_file})
        case ExitCode
exit_code of
            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 _ -> Either ExitCode InputStream -> IO (Either ExitCode InputStream)
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 out_file :: 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) (\_ -> () -> IO ()
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 tmp_dir_opt :: Maybe String
tmp_dir_opt input_file :: 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 tmpdir :: String
tmpdir) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
tmpdir
    getTempDir Nothing       = IO String
getTemporaryDirectory

-- | compute output file name from input file name
getOutputFileName :: FilePath -> FilePath
getOutputFileName :: String -> String
getOutputFileName fp :: 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 tmp_dir :: String
tmp_dir file_templ :: String
file_templ = do
    -- putStrLn $ "TmpDir: "++tmp_dir
    -- putStrLn $ "FileTempl: "++file_templ
    (path :: String
path,file_handle :: 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 (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 = (".i" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)