diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,37 @@ +# Change Log + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/). + +## [0.6.0] - 2016-12-13 + +### Added + +* Can set a custom `CLASSPATH` in `Setup.hs` from Gradle build + configurations to use when compiling inline expressions. +* GHC 8 compatibility +* Support inline expressions that compile to multiple .class files + (e.g for anonymous classes and anonymous function literals). + +### Changed + +* The return type of inline expressions no longer needs + `Reify`/`Reflect` instances. + +### Fixed + +* Fix antiquotation: in [java| $obj.foo() |], `obj` is now recognized + as an antiquotation variable. +* Passing multiple options to the JVM using `withJVM`. + +## [0.5.0] - 2016-12-13 + +### Added + +* First release with support for inline Java expressions. + +### Changed + +* Split lower-level and mid-level bindings into separate packages: jni + and jvm. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # inline-java: Call any JVM function from Haskell -[![Circle CI](https://circleci.com/gh/tweag/inline-java.svg?style=svg)](https://circleci.com/gh/tweag/inline-java) +[![wercker status](https://app.wercker.com/status/dfeba78838cc77d4c5e06eedc5c0833d/s/master "wercker status")](https://app.wercker.com/project/byKey/dfeba78838cc77d4c5e06eedc5c0833d) **NOTE: you'll need GHC >= 8.0.2 to compile and use this package. Use** ``` @@ -16,7 +16,7 @@ `inline-r` for calling R, `inline-java` lets you name any function to call inline in your code. -# Example +## Example Graphical Hello World using Java Swing: @@ -39,6 +39,39 @@ [java| { javax.swing.JOptionPane.showMessageDialog(null, $message); return 0; } |] ``` + +## Building it + +**Requirements:** +* the [Stack][stack] build tool (version 1.2 or above); +* either, the [Nix][nix] package manager, +* or, OpenJDK, Gradle and Spark (version 1.6) installed from your distro. + +To build: + +``` +$ stack build +``` + +You can optionally get Stack to download a JDK in a local sandbox +(using [Nix][nix]) for good build results reproducibility. **This is +the recommended way to build inline-java.** Alternatively, you'll need +it installed through your OS distribution's package manager for the +next steps (and you'll need to tell Stack how to find the JVM header +files and shared libraries). + +To use Nix, set the following in your `~/.stack/config.yaml` (or pass +`--nix` to all Stack commands, see the [Stack manual][stack-nix] for +more): + +```yaml +nix: + enable: true +``` + +[stack]: https://github.com/commercialhaskell/stack +[stack-nix]: https://docs.haskellstack.org/en/stable/nix_integration/#configuration +[nix]: http://nixos.org/nix ## License diff --git a/inline-java.cabal b/inline-java.cabal --- a/inline-java.cabal +++ b/inline-java.cabal @@ -1,5 +1,5 @@ name: inline-java -version: 0.5.1 +version: 0.6 synopsis: Java interop via inline Java code in Haskell modules. description: Please see README.md. homepage: http://github.com/tweag/inline-java#readme @@ -11,7 +11,9 @@ category: FFI, JVM, Java build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md +extra-source-files: + CHANGELOG.md + README.md extra-tmp-files: src/Foreign/JNI.c @@ -23,12 +25,15 @@ hs-source-dirs: src exposed-modules: Language.Java.Inline + Language.Java.Inline.Cabal build-depends: -- Can't build at all with GHC < 8.0.2. base > 4.9.0.0 && < 5, binary >=0.7, bytestring >=0.10, + Cabal >= 1.24, containers >=0.5, + directory >=1.2, distributed-closure >=0.3, filepath >= 1, ghc-heap-view >= 0.5, @@ -36,7 +41,6 @@ jni >= 0.1, jvm >= 0.1, language-java >= 0.2, - monad-loops >= 0.4, process >= 1.2, singletons >= 2.0, syb >= 0.6, @@ -58,6 +62,7 @@ build-depends: base, bytestring, + jni, jvm, hspec, inline-java, diff --git a/src/Language/Java/Inline.hs b/src/Language/Java/Inline.hs --- a/src/Language/Java/Inline.hs +++ b/src/Language/Java/Inline.hs @@ -51,7 +51,6 @@ import Control.Monad (forM_, unless) import Control.Monad.Fix (mfix) -import Control.Monad.Loops (unfoldM) import qualified Data.ByteString.Char8 as BS import Data.Generics (everything, mkQ) import Data.List (intercalate, isPrefixOf, isSuffixOf) @@ -75,10 +74,10 @@ import qualified Language.Java.Syntax as Java import Language.Haskell.TH.Quote import qualified Language.Haskell.TH as TH -import qualified Language.Haskell.TH.Ppr as TH import qualified Language.Haskell.TH.Syntax as TH import Language.Haskell.TH (Q) import System.FilePath ((), (<.>)) +import System.Directory (listDirectory) import System.IO.Temp (withSystemTempDirectory) import System.IO.Unsafe (unsafePerformIO) import System.Process (callProcess) @@ -119,6 +118,11 @@ -- printf format string). An antiquotation variable @$foo@ is well-scoped if -- there exists a variable with the name @foo@ in the Haskell context of the -- quasiquote, whose type is 'Coercible' to a Java primitive or reference type. +-- +-- __NOTE:__ In GHC 8.0.2 and earlier, due to +-- , a quasiquote must +-- always return a boxed value (i.e. an object, not void or a primitive type). +-- This limitation may be lifted in the future. java :: QuasiQuoter java = QuasiQuoter { quoteExp = \txt -> blockOrExpQQ txt @@ -128,7 +132,7 @@ } antis :: Java.Block -> [String] -antis = everything (++) (mkQ [] (\case Java.Name [Java.Ident ('$':av)] -> [av]; _ -> [])) +antis = everything (++) (mkQ [] (\case Java.Name (Java.Ident ('$':av):_) -> [av]; _ -> [])) toJavaType :: Sing (a :: JType) -> Java.Type toJavaType ty = case Java.parser Java.ttype (pretty ty) of @@ -261,29 +265,34 @@ , classBytecode :: BS.ByteString } +instance TH.Lift DotClass where + lift DotClass{..} = + [| DotClass + (JNI.fromChars $(TH.lift (JNI.toChars className))) + (BS.pack $(TH.lift (BS.unpack classBytecode))) + |] + embedAsBytecode :: String -> String -> Java.CompilationUnit -> Q () embedAsBytecode pkg name unit = do - bcode <- TH.runIO $ do + dcs <- TH.runIO $ do withSystemTempDirectory "inlinejava" $ \dir -> do let src = dir name <.> "java" emit src unit callProcess "javac" [src] - BS.readFile (dir name <.> "class") - f <- TH.newName "inlinejava__bytecode" - TH.addTopDecls =<< - sequence - [ TH.sigD f [t| StaticPtr DotClass |] - , TH.valD - (TH.varP f) - (TH.normalB - [| static - (DotClass (fromString $(TH.lift (pkg ++ "/" ++ name))) - (BS.pack $(TH.lift (BS.unpack bcode)))) |]) - [] - ] - -newtype ClassLoader = ClassLoader (J ('Class "java.lang.ClassLoader")) -instance Coercible ClassLoader ('Class "java.lang.ClassLoader") + -- A single compilation unit can produce multiple class files. + classFiles <- filter (".class" `isSuffixOf`) <$> listDirectory dir + forM classFiles $ \classFile -> do + bcode <- BS.readFile (dir classFile) + -- Strip the .class suffix. + let klass = pkg ++ "/" ++ takeWhile (/= '.') classFile + return $ DotClass (JNI.fromChars klass) bcode + forM_ (zip dcs [(0 :: Int)..]) $ \(dc, i) -> do + ptr <- TH.newName $ "inlinejava__bytecode" ++ show i + TH.addTopDecls =<< + sequence + [ TH.sigD ptr [t| StaticPtr DotClass |] + , TH.valD (TH.varP ptr) (TH.normalB [| static $(TH.lift dc) |]) [] + ] -- | Idempotent action that loads all wrappers in every module of the current -- program into the JVM. @@ -293,8 +302,8 @@ {-# NOINLINE doit #-} doit = unsafePerformIO $ do keys <- staticPtrKeys - loader :: ClassLoader <- - callStatic (classOf (undefined :: ClassLoader)) "getSystemClassLoader" [] + loader :: J ('Class "java.lang.ClassLoader") <- + callStatic (sing :: Sing "java.lang.ClassLoader") "getSystemClassLoader" [] forM_ keys $ \key -> do sptr :: StaticPtr Any <- fromJust <$> unsafeLookupStaticPtr key let !x = deRefStaticPtr sptr @@ -382,29 +391,8 @@ -- always return java.lang.Object. This works, because in Java >= 5 if -- what you have is a primitive type but what you're requesting is an -- object type, then the value of primitive type gets autoboxed. So now we - -- have to guess on the Haskell side what autoboxing did. We assume - -- autoboxing is equivalent to reflecting a value at primitive type. - -- - -- We have to write part of this programmatically due to a TH limitation, - -- https://ghc.haskell.org/trac/ghc/ticket/12164. It stands for: - -- - -- @ - -- [| -- Determine what Java type we'd get if we reflected the result. - -- -- That's the type we need to reify from. - -- mfix $ \x -> case Some (reflect x) of - -- Some (_ :: IO (J ty)) -> do - -- y <- $funcall - -- reify (unsafeCast y :: J ty) - -- |] - -- @ - castReturnType funcall = do - ty <- TH.newName "ty" - [| mfix $ \x -> - $(TH.caseE - [| Some (reflect x) |] - [TH.match - (TH.conP 'Some [TH.sigP TH.wildP [t| IO (J $(TH.varT ty)) |]]) - (TH.normalB [| do - y <- $funcall - reify (unsafeCast y :: J ty) |]) - []]) |] + -- have to guess on the Haskell side what autoboxing did, to reverse its + -- effect. Alternatively, we can say that for now we only support + -- returning boxed values. Once this limitation of the compiler gets + -- lifted, we'll support returning unboxed values, just like `call` does. + castReturnType funcall = [| unsafeUncoerce . coerce <$> $funcall |] diff --git a/src/Language/Java/Inline/Cabal.hs b/src/Language/Java/Inline/Cabal.hs new file mode 100644 --- /dev/null +++ b/src/Language/Java/Inline/Cabal.hs @@ -0,0 +1,78 @@ +-- | This module contains Cabal @Setup.hs@ hooks to set the @CLASSPATH@ to use +-- when compiling inline code. The @CLASSPATH@ environment variable specifies +-- where to find JVM package dependencies, such as third party packages +-- downloaded from . +-- +-- You can set the @CLASSPATH@ manually, or extract one from an external build +-- system configuration. Currently supported build systems: +-- +-- * + +module Language.Java.Inline.Cabal + ( gradleHooks + , setGradleClasspath + , gradleBuild + ) where + +import Distribution.Simple +import Distribution.Simple.Setup (BuildFlags) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) +import Distribution.PackageDescription (HookedBuildInfo, PackageDescription) +import System.Directory (doesFileExist, getCurrentDirectory) +import System.Environment (lookupEnv, setEnv) +import System.FilePath +import System.IO (hClose) +import System.IO.Temp (withSystemTempFile) +import System.Process (callProcess, readProcess) + +-- | Adds the 'setGradleClasspath' and 'gradleBuild' hooks. +gradleHooks :: UserHooks -> UserHooks +gradleHooks hooks = hooks + { preBuild = setGradleClasspath + , buildHook = buildHook hooks >> gradleBuild + } + +gradleBuildFile :: FilePath +gradleBuildFile = "build.gradle" + +findGradleBuild :: FilePath -> IO (Maybe FilePath) +findGradleBuild cwd = do + let path = cwd gradleBuildFile + yes <- doesFileExist path + if yes then return (Just path) else return Nothing + +-- | Set the @CLASSPATH@ from a Gradle build configuration. Uses the classpath +-- for the @main@ source set. +getGradleClasspath :: FilePath -> IO String +getGradleClasspath parentBuildfile = do + withSystemTempFile "build.gradle" $ \buildfile h -> do + hClose h + writeFile buildfile $ + unlines + [ "apply from: '" ++ parentBuildfile ++ "'" + , "task classpath { doLast { println sourceSets.main.compileClasspath.getAsPath() } }" + ] + readProcess "gradle" ["-q", "-b", buildfile, "classpath"] "" + +-- | Set the @CLASSPATH@ from a Gradle build configuration. Does not override +-- the @CLASSPATH@ if one exists. +setGradleClasspath :: Args -> BuildFlags -> IO HookedBuildInfo +setGradleClasspath _ _ = do + here <- getCurrentDirectory + origclasspath <- lookupEnv "CLASSPATH" + case origclasspath of + Nothing -> do + mbbuildfile <- findGradleBuild here + case mbbuildfile of + Nothing -> fail $ unwords [gradleBuildFile, "file not found in", here] + Just buildfile -> do + classpath <- getGradleClasspath buildfile + setEnv "CLASSPATH" classpath + Just _ -> return () + return (Nothing, []) + +-- | Call @gradle build@ as part of the Cabal build. Useful to e.g. build +-- auxiliary Java source code and to create packages. +gradleBuild :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO () +gradleBuild _ _ _ _ = do + callProcess "gradle" ["build"] diff --git a/tests/Language/Java/InlineSpec.hs b/tests/Language/Java/InlineSpec.hs --- a/tests/Language/Java/InlineSpec.hs +++ b/tests/Language/Java/InlineSpec.hs @@ -5,6 +5,7 @@ module Language.Java.InlineSpec where import Data.Int +import Foreign.JNI.Types (JObject) import Language.Java.Inline import Test.Hspec @@ -33,3 +34,10 @@ it "Supports antiquotation variables in blocks" $ do let z = 1 :: Int32 [java| { return $z + 1; } |] `shouldReturn` (2 :: Int32) + + it "Supports anonymous classes" $ do + _ :: JObject <- [java| new Object() {} |] + return () + + it "Supports multiple anonymous classes" $ do + [java| new Object() {}.equals(new Object() {}) |] `shouldReturn` False