{-# 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 :: [Char] -> IO (Either [Char] CTranslUnit)
parse [Char]
path = [Char]
-> ([Char] -> Handle -> IO (Either [Char] CTranslUnit))
-> IO (Either [Char] CTranslUnit)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"parseTmp.c" (([Char] -> Handle -> IO (Either [Char] CTranslUnit))
 -> IO (Either [Char] CTranslUnit))
-> ([Char] -> Handle -> IO (Either [Char] CTranslUnit))
-> IO (Either [Char] CTranslUnit)
forall a b. (a -> b) -> a -> b
$ \[Char]
tmp Handle
h -> do
                         [Char]
contents <- [Char] -> IO [Char]
readFile [Char]
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 -> [Char] -> IO ()
hPutStrLn Handle
h ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"#undef __BLOCKS__\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
contents
                         Handle -> IO ()
hClose Handle
h


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

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