{-# OPTIONS_HADDOCK hide #-}

module Cubix.Language.C.Parse (
  parse
) where

import Language.C
import Language.C.System.GCC

import System.IO ( hClose, hPutStrLn )
import System.IO.Temp ( withSystemTempFile )


parse :: FilePath -> IO (Either String CTranslUnit)
parse :: FilePath -> IO (Either FilePath CTranslUnit)
parse path :: FilePath
path = FilePath
-> (FilePath -> Handle -> IO (Either FilePath CTranslUnit))
-> IO (Either FilePath CTranslUnit)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile "parseTmp.c" ((FilePath -> Handle -> IO (Either FilePath CTranslUnit))
 -> IO (Either FilePath CTranslUnit))
-> (FilePath -> Handle -> IO (Either FilePath CTranslUnit))
-> IO (Either FilePath CTranslUnit)
forall a b. (a -> b) -> a -> b
$ \tmp :: FilePath
tmp h :: Handle
h -> do
                         FilePath
contents <- FilePath -> IO FilePath
readFile FilePath
path

                         -- On Mac, stdlib.h includes some Objective-C syntax (oh Clang...),
                         -- which breaks the language-c parser. This directive kills the offending parts
                         Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "#undef __BLOCKS__\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
contents
                         Handle -> IO ()
hClose Handle
h


                         let gcc :: GCC
gcc = FilePath -> GCC
newGCC "gcc"
                         Either ParseError CTranslUnit
res <- GCC
-> Maybe FilePath
-> [FilePath]
-> FilePath
-> IO (Either ParseError CTranslUnit)
forall cpp.
Preprocessor cpp =>
cpp
-> Maybe FilePath
-> [FilePath]
-> FilePath
-> IO (Either ParseError CTranslUnit)
parseCFile GCC
gcc Maybe FilePath
forall a. Maybe a
Nothing [] FilePath
tmp

                         case Either ParseError CTranslUnit
res of
                           Left errors :: ParseError
errors -> Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit))
-> Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath CTranslUnit
forall a b. a -> Either a b
Left (FilePath -> Either FilePath CTranslUnit)
-> FilePath -> Either FilePath CTranslUnit
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
errors
                           Right tree :: CTranslUnit
tree  -> Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit))
-> Either FilePath CTranslUnit -> IO (Either FilePath CTranslUnit)
forall a b. (a -> b) -> a -> b
$ CTranslUnit -> Either FilePath CTranslUnit
forall a b. b -> Either a b
Right CTranslUnit
tree