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

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