{-# OPTIONS_HADDOCK hide #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- Provides Java parser via the javaparser-to-hs bridge
module Cubix.Language.Java.Parse
  (
    parse
  ) where

import Control.Monad ( liftM )

import Language.Java.Parser ( compilationUnit, parser )
import Language.Java.Syntax

import System.Exit ( ExitCode(..) )
import System.IO ( hClose, hPutStrLn, stderr )
import System.IO.Temp ( withSystemTempFile )
import System.Process ( system )


parse :: FilePath -> IO (Either String CompilationUnit)
parse :: [Char] -> IO (Either [Char] CompilationUnit)
parse [Char]
path = [Char]
-> ([Char] -> Handle -> IO (Either [Char] CompilationUnit))
-> IO (Either [Char] CompilationUnit)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"parse" (([Char] -> Handle -> IO (Either [Char] CompilationUnit))
 -> IO (Either [Char] CompilationUnit))
-> ([Char] -> Handle -> IO (Either [Char] CompilationUnit))
-> IO (Either [Char] CompilationUnit)
forall a b. (a -> b) -> a -> b
$ \[Char]
tmp Handle
h -> do
                         Handle -> IO ()
hClose Handle
h
                         ExitCode
exitCode <- [Char] -> IO ExitCode
system ([Char] -> IO ExitCode) -> [Char] -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ [Char]
"java -jar javaparser-to-hs.jar " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
path) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
tmp)
                         case ExitCode
exitCode of
                           ExitFailure Int
_ -> do Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"Java parser failed; using fallback parser"
                                               [Char] -> IO (Either [Char] CompilationUnit)
parseFallback [Char]
path
                           ExitCode
ExitSuccess   -> ([Char] -> Either [Char] CompilationUnit)
-> IO [Char] -> IO (Either [Char] CompilationUnit)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CompilationUnit -> Either [Char] CompilationUnit
forall a b. b -> Either a b
Right (CompilationUnit -> Either [Char] CompilationUnit)
-> ([Char] -> CompilationUnit)
-> [Char]
-> Either [Char] CompilationUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CompilationUnit
forall a. Read a => [Char] -> a
read) (IO [Char] -> IO (Either [Char] CompilationUnit))
-> IO [Char] -> IO (Either [Char] CompilationUnit)
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
readFile [Char]
tmp
                           

parseFallback :: FilePath -> IO (Either String CompilationUnit)
parseFallback :: [Char] -> IO (Either [Char] CompilationUnit)
parseFallback [Char]
path = do
  [Char]
contents <- [Char] -> IO [Char]
readFile [Char]
path
  case Parsec [L Token] () CompilationUnit
-> [Char] -> Either ParseError CompilationUnit
forall {a}. Parsec [L Token] () a -> [Char] -> Either ParseError a
parser Parsec [L Token] () CompilationUnit
compilationUnit [Char]
contents of
    Left ParseError
err -> Either [Char] CompilationUnit -> IO (Either [Char] CompilationUnit)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] CompilationUnit
 -> IO (Either [Char] CompilationUnit))
-> Either [Char] CompilationUnit
-> IO (Either [Char] CompilationUnit)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] CompilationUnit
forall a b. a -> Either a b
Left ([Char] -> Either [Char] CompilationUnit)
-> [Char] -> Either [Char] CompilationUnit
forall a b. (a -> b) -> a -> b
$ [Char]
"parse error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
    Right CompilationUnit
x  -> do Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"Fallback parser succeeded"
                   return $ CompilationUnit -> Either [Char] CompilationUnit
forall a b. b -> Either a b
Right CompilationUnit
x