-- | 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 <http://search.maven.org/ Maven Central>.
--
-- You can set the @CLASSPATH@ manually, or extract one from an external build
-- system configuration. Currently supported build systems:
--
-- * <https://gradle.org/ Gradle>

module Language.Java.Inline.Cabal
  ( gradleHooks
  , prependClasspathWithGradle
  , gradleBuild
  , addJarsToClasspath
  ) where

import Control.Exception (evaluate)
import Control.Monad (when)
import Data.List (intersperse, isPrefixOf)
import Distribution.Simple
import Distribution.Simple.Setup (BuildFlags)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
import Distribution.PackageDescription
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Environment (lookupEnv, setEnv)
import System.FilePath
import System.IO
import System.IO.Temp (withSystemTempFile)
import System.Process (callProcess, readProcess)

-- | Adds the 'prependClasspathWithGradle' and 'gradleBuild' hooks.
--
-- Also adds the jar produced by gradle to the data-files.
gradleHooks :: UserHooks -> UserHooks
gradleHooks :: UserHooks -> UserHooks
gradleHooks UserHooks
hooks = UserHooks
hooks
    { preBuild :: Args -> BuildFlags -> IO HookedBuildInfo
preBuild = Args -> BuildFlags -> IO HookedBuildInfo
forall b. Args -> b -> IO HookedBuildInfo
prependClasspathWithGradle (Args -> BuildFlags -> IO HookedBuildInfo)
-> (Args -> BuildFlags -> IO HookedBuildInfo)
-> Args
-> BuildFlags
-> IO HookedBuildInfo
forall a. Semigroup a => a -> a -> a
<> UserHooks -> Args -> BuildFlags -> IO HookedBuildInfo
preBuild UserHooks
hooks
    , buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
gradleBuild (PackageDescription
 -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ())
-> (PackageDescription
    -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ())
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
forall a. Semigroup a => a -> a -> a
<> UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
hooks
    , preHaddock :: Args -> HaddockFlags -> IO HookedBuildInfo
preHaddock = Args -> HaddockFlags -> IO HookedBuildInfo
forall b. Args -> b -> IO HookedBuildInfo
prependClasspathWithGradle (Args -> HaddockFlags -> IO HookedBuildInfo)
-> (Args -> HaddockFlags -> IO HookedBuildInfo)
-> Args
-> HaddockFlags
-> IO HookedBuildInfo
forall a. Semigroup a => a -> a -> a
<> UserHooks -> Args -> HaddockFlags -> IO HookedBuildInfo
preHaddock UserHooks
hooks
    , instHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()
instHook = UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> InstallFlags
-> IO ()
instHook UserHooks
simpleUserHooks (PackageDescription
 -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ())
-> (PackageDescription -> PackageDescription)
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> InstallFlags
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageDescription
addJarToDataFiles
    , copyHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
copyHook = UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> CopyFlags
-> IO ()
copyHook UserHooks
simpleUserHooks (PackageDescription
 -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ())
-> (PackageDescription -> PackageDescription)
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> CopyFlags
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageDescription
addJarToDataFiles
    , regHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()
regHook = UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> RegisterFlags
-> IO ()
regHook UserHooks
simpleUserHooks (PackageDescription
 -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ())
-> (PackageDescription -> PackageDescription)
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> RegisterFlags
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageDescription
addJarToDataFiles
    }

-- | Prepends the given jar paths to the CLASSPATH.
addJarsToClasspath :: [FilePath] -> UserHooks -> UserHooks
addJarsToClasspath :: Args -> UserHooks -> UserHooks
addJarsToClasspath Args
extraJars UserHooks
hooks = UserHooks
hooks
    { preBuild :: Args -> BuildFlags -> IO HookedBuildInfo
preBuild = Args -> Args -> BuildFlags -> IO HookedBuildInfo
forall a b. Args -> a -> b -> IO HookedBuildInfo
setClasspath Args
extraJars (Args -> BuildFlags -> IO HookedBuildInfo)
-> (Args -> BuildFlags -> IO HookedBuildInfo)
-> Args
-> BuildFlags
-> IO HookedBuildInfo
forall a. Semigroup a => a -> a -> a
<> UserHooks -> Args -> BuildFlags -> IO HookedBuildInfo
preBuild UserHooks
hooks
    , preHaddock :: Args -> HaddockFlags -> IO HookedBuildInfo
preHaddock = Args -> Args -> HaddockFlags -> IO HookedBuildInfo
forall a b. Args -> a -> b -> IO HookedBuildInfo
setClasspath Args
extraJars (Args -> HaddockFlags -> IO HookedBuildInfo)
-> (Args -> HaddockFlags -> IO HookedBuildInfo)
-> Args
-> HaddockFlags
-> IO HookedBuildInfo
forall a. Semigroup a => a -> a -> a
<> UserHooks -> Args -> HaddockFlags -> IO HookedBuildInfo
preHaddock UserHooks
hooks
    }

gradleBuildFile :: FilePath
gradleBuildFile :: FilePath
gradleBuildFile = FilePath
"build.gradle"

findGradleBuild :: FilePath -> IO (Maybe FilePath)
findGradleBuild :: FilePath -> IO (Maybe FilePath)
findGradleBuild FilePath
cwd = do
    let path :: FilePath
path = FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
gradleBuildFile
    Bool
yes <- FilePath -> IO Bool
doesFileExist FilePath
path
    if Bool
yes then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path) else Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

-- | Set the @CLASSPATH@ from a Gradle build configuration. Uses the classpath
-- for the @main@ source set.
getGradleClasspath :: FilePath -> IO String
getGradleClasspath :: FilePath -> IO FilePath
getGradleClasspath FilePath
parentBuildfile = do
    FilePath -> (FilePath -> Handle -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"build.gradle" ((FilePath -> Handle -> IO FilePath) -> IO FilePath)
-> (FilePath -> Handle -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
buildfile Handle
h -> do
      Handle -> IO ()
hClose Handle
h
      FilePath -> FilePath -> IO ()
writeFile FilePath
buildfile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        Args -> FilePath
unlines
          [ FilePath
"apply from: '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
parentBuildfile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
          , FilePath
"task classpath { doLast { println sourceSets.main.compileClasspath.getAsPath() } }"
          ]
      FilePath -> Args -> FilePath -> IO FilePath
readProcess FilePath
"gradle" [FilePath
"-q", FilePath
"-b", FilePath
buildfile, FilePath
"classpath"] FilePath
""
        -- Get the last line of output. Sometimes Gradle prepends garbage to the
        -- output despite the -q flag.
        IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath)
-> (FilePath -> FilePath) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> FilePath
forall a. [a] -> a
last (Args -> FilePath) -> (FilePath -> Args) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Args
lines

-- | Prepends the @CLASSPATH@ with the classpath from a Gradle build
-- configuration.
prependClasspathWithGradle :: Args -> b -> IO HookedBuildInfo
prependClasspathWithGradle :: Args -> b -> IO HookedBuildInfo
prependClasspathWithGradle Args
_ b
_ = do
    FilePath
here <- IO FilePath
getCurrentDirectory
    Maybe FilePath
origclasspath <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"CLASSPATH"
    Maybe FilePath
mbbuildfile <- FilePath -> IO (Maybe FilePath)
findGradleBuild FilePath
here
    case Maybe FilePath
mbbuildfile of
      Maybe FilePath
Nothing -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Args -> FilePath
unwords [FilePath
gradleBuildFile, FilePath
"file not found in", FilePath
here]
      Just FilePath
buildfile -> do
        FilePath
classpath <- FilePath -> IO FilePath
getGradleClasspath FilePath
buildfile
        FilePath -> FilePath -> IO ()
setEnv FilePath
"CLASSPATH" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
classpath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) Maybe FilePath
origclasspath
    HookedBuildInfo -> IO HookedBuildInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BuildInfo
forall a. Maybe a
Nothing, [])

setClasspath :: [FilePath] -> a -> b -> IO HookedBuildInfo
setClasspath :: Args -> a -> b -> IO HookedBuildInfo
setClasspath Args
extraJars a
_ b
_ = do
    Maybe FilePath
mclasspath <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"CLASSPATH"
    FilePath -> FilePath -> IO ()
setEnv FilePath
"CLASSPATH" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
      Args -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Args -> FilePath) -> Args -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Args -> Args
forall a. a -> [a] -> [a]
intersperse FilePath
":" (Args -> Args) -> Args -> Args
forall a b. (a -> b) -> a -> b
$
        Args -> (FilePath -> Args) -> Maybe FilePath -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args
extraJars (\FilePath
c -> Args
extraJars Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ [FilePath
c]) Maybe FilePath
mclasspath
    HookedBuildInfo -> IO HookedBuildInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BuildInfo
forall a. Maybe a
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 :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
gradleBuild PackageDescription
pd LocalBuildInfo
_ UserHooks
_ BuildFlags
_ = do
    IO ()
setProjectName
    FilePath -> Args -> IO ()
callProcess FilePath
"gradle" [FilePath
"build"]
  where
    settingsFile :: FilePath
settingsFile = FilePath
"settings.gradle"

    setProjectName :: IO ()
    setProjectName :: IO ()
setProjectName = do
      Bool
missingProjectName <- IO Bool
isProjectNameMissing
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
missingProjectName (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          FilePath -> FilePath -> IO ()
appendFile FilePath
"settings.gradle" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"\nrootProject.name = '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
            PackageName -> FilePath
unPackageName (PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package PackageDescription
pd)) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'\n"

    isProjectNameMissing :: IO Bool
    isProjectNameMissing :: IO Bool
isProjectNameMissing = do
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
settingsFile
      if Bool -> Bool
not Bool
exists
      then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else FilePath -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
settingsFile IOMode
ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
             Bool
b <- (FilePath -> Bool) -> Args -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"rootProject.name =" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) (Args -> Bool) -> (FilePath -> Args) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Args
lines
               (FilePath -> Bool) -> IO FilePath -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO FilePath
hGetContents Handle
h
             -- If we don't evaluate the boolean before returning, the
             -- file handle will be closed when we try to read the file.
             Bool -> IO Bool
forall a. a -> IO a
evaluate Bool
b

-- "<pkgname>.jar" is a file build by gradle during building. This file needs
-- to be installed together with the library, otherwise it wouldn't be available
-- to build other code depending on it. Therefore, we add the jar to the field
-- dataFiles in the hooks instHook, copyHook and regHook. This way the jar is
-- installed, but cabal does not account it when deciding if the package needs
-- to be rebuilt.

addJarToDataFiles :: PackageDescription -> PackageDescription
addJarToDataFiles :: PackageDescription -> PackageDescription
addJarToDataFiles PackageDescription
pd = PackageDescription
pd
    { dataFiles :: Args
dataFiles =
        (FilePath
"build/libs" FilePath -> FilePath -> FilePath
</> PackageName -> FilePath
unPackageName (PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package PackageDescription
pd)) FilePath -> FilePath -> FilePath
<.> FilePath
"jar")
        FilePath -> Args -> Args
forall a. a -> [a] -> [a]
: PackageDescription -> Args
dataFiles PackageDescription
pd
    }