diff options
-rw-r--r-- | src/main/frege/buildclient/config/BuildConfig.fr | 17 | ||||
-rw-r--r-- | src/main/frege/buildclient/config/BuildParser.fr | 7 | ||||
-rw-r--r-- | src/main/frege/buildclient/tasks/Executor.fr | 88 | ||||
-rw-r--r-- | src/main/frege/buildclient/util/IoUtils.fr | 78 | ||||
-rw-r--r-- | src/main/frege/examples/HelloFrege.fr | 1 | ||||
-rw-r--r-- | src/main/resources/testconfig.bcc | 1 |
6 files changed, 114 insertions, 78 deletions
diff --git a/src/main/frege/buildclient/config/BuildConfig.fr b/src/main/frege/buildclient/config/BuildConfig.fr index 7c3290f..616b0bd 100644 --- a/src/main/frege/buildclient/config/BuildConfig.fr +++ b/src/main/frege/buildclient/config/BuildConfig.fr @@ -50,7 +50,6 @@ maybeOr :: a -> Maybe a -> a maybeOr _ (Just x) = x maybeOr x Nothing = x - data ArchiveFormat = Zip derive Show ArchiveFormat @@ -74,14 +73,22 @@ findSource (ASTDirective _ [ASTWord name] _) = fail ("Unknown source type " ++ n findSource _ = fail "Please provide a source type" -data BuildSystem = GradleBuild { task::String, project :: Maybe String } +data BuildSystem = GradleBuild { task::String, project :: Maybe String, extraProperties :: [(String, String)] } derive Show BuildSystem findBuildSystem :: ASTDirective -> Either String BuildSystem -findBuildSystem (ASTDirective _ [ASTWord "gradle"] block) = do - task <- getTypedArg "task" "gradle task" block expectString - return $ GradleBuild task $ (getArgDirective "project" block >>= expectString) +findBuildSystem (ASTDirective _ [ASTWord "gradle"] block) = + do + task <- getTypedArg "task" "gradle task" block expectString + let extraProperties = findDirectives "property" block >>= parseExtraProperty + return $ GradleBuild task (getArgDirective "project" block >>= expectString) extraProperties + where + parseExtraProperty directive = maybeToList $ do + name <- (getArg directive 0 >>= expectString) + value <- (getArg directive 1 >>= expectString) + return (name,value) + findBuildSystem _ = fail "Please provide a build system" parseBuildConfig :: [ASTDirective] -> Either String BuildConfig diff --git a/src/main/frege/buildclient/config/BuildParser.fr b/src/main/frege/buildclient/config/BuildParser.fr index 367b177..961be01 100644 --- a/src/main/frege/buildclient/config/BuildParser.fr +++ b/src/main/frege/buildclient/config/BuildParser.fr @@ -113,3 +113,10 @@ findDirective name (directive:ds) | directive.name == name = Just directive | otherwise = findDirective name ds findDirective _ [] = Nothing + +findDirectives :: String -> [ASTDirective] -> [ASTDirective] +findDirectives = findDirectives' [] + where findDirectives' acc name (a:as) + | name == a.name = findDirectives' (a:acc) name as + | otherwise = findDirectives' acc name as + findDirectives' acc _ [] = acc diff --git a/src/main/frege/buildclient/tasks/Executor.fr b/src/main/frege/buildclient/tasks/Executor.fr index da17d89..e0f9b20 100644 --- a/src/main/frege/buildclient/tasks/Executor.fr +++ b/src/main/frege/buildclient/tasks/Executor.fr @@ -2,27 +2,12 @@ module buildclient.tasks.Executor where import buildclient.config.BuildConfig +import buildclient.util.IoUtils import frege.java.Net import frege.java.IO -import Data.Array +import frege.java.lang.Processes -data HttpURLConnection = native java.net.HttpURLConnection where - -- Unchecked cast, but who cares - native fromUrlConnection "(java.net.HttpURLConnection)" :: MutableIO URLConnection -> IOMutable HttpURLConnection - native setRequestProperty :: MutableIO HttpURLConnection -> String -> String -> IO () - native getHeaderField :: MutableIO HttpURLConnection -> String -> IO (Maybe String) - native getResponseCode :: MutableIO HttpURLConnection -> IO Int throws IOException - -data ZipEntry = native java.util.zip.ZipEntry where - native getName :: Mutable s ZipEntry -> ST s String - native isDirectory :: Mutable s ZipEntry -> ST s Bool - -data ZipInputStream = native java.util.zip.ZipInputStream where - native new :: MutableIO InputStream -> IOMutable ZipInputStream - native getNextEntry :: MutableIO ZipInputStream -> IO (Maybe (MutableIO ZipEntry)) throws IOException - native closeEntry :: MutableIO ZipInputStream -> IO () throws IOException - bcDownloadSync :: File -> BuildSource -> IO () bcDownloadSync targetDirectory (HttpSource url format archiveRoot skipDirs) = do File.mkdirs targetDirectory @@ -52,60 +37,17 @@ bcDownloadSync targetDirectory (HttpSource url format archiveRoot skipDirs) = do return () -extractZip :: Int -> File -> File -> IO () -extractZip skipDirs archiveFile targetDirectory = - do - File.mkdirs targetDirectory - fis <- FileInputStream.new archiveFile - zis <- ZipInputStream.new fis - extractFiles zis - return () - where - extractFiles zis = do - entry <- ZipInputStream.getNextEntry zis - case entry of - Just n -> extractFile zis n >> extractFiles zis - Nothing -> return () - extractFile zis zentry = do - isdir <- ZipEntry.isDirectory zentry - if isdir - then return () - else do - name <- ZipEntry.getName zentry - let (Right pattern) = Regex.compile "[/\\\\]" - let parts = drop skipDirs $ toList $ Regex.split (pattern) name - let targetFile = fold File.new targetDirectory parts - maybe (return false) File.mkdirs $ File.getParentFile targetFile - saveInputStreamTo zis targetFile - return () +data AFile = native java.io.File where + native setExecutable :: File -> Bool -> Bool -> IO Bool -writeFileStr :: File -> String -> IO () -writeFileStr file text = do - fos <- FileOutputStream.new file - osw <- OutputStreamWriter.new fos "UTF-8" - osw.write text - osw.close - -readFileStr :: File -> IO String -readFileStr file = do - fis <- FileInputStream.new file - isr <- InputStreamReader.new fis "UTF-8" - getContentsOf isr - -saveInputStreamTo :: MutableIO InputStream -> File -> IO () -saveInputStreamTo is file = - do maybe (return false) File.mkdirs $ File.getParentFile file - fos <- FileOutputStream.new file - arr <- newArray 4096 - copyloop arr fos - fos.close - return () - where - copyloop :: ArrayOf RealWorld Byte -> MutableIO FileOutputStream -> IO () - copyloop buf to = do - rc <- InputStream.read is buf - if rc < 0 - then return () - else do - OutputStream.write to buf 0 rc - copyloop buf to +bcExecuteBuild :: BuildSystem -> File -> File -> IO () +bcExecuteBuild (BuildSystem.GradleBuild task project properties) buildDir targetFile = do + AFile.setExecutable (File.new buildDir "gradlew") true true + let commandLine = (["./gradlew", ":buildClientGenerateFile", "-Pbuildclienttarget=" ++ (File.getPath targetFile)] ++ fmap (\(a,b)-> "-P"++a++"="++b) properties) + println commandLine + pb <- ProcessBuilder.new (commandLine) + ProcessBuilder.directory pb buildDir + ProcessBuilder.inheritIO pb + proc <- ProcessBuilder.start pb + void $ Process.waitFor proc + return () diff --git a/src/main/frege/buildclient/util/IoUtils.fr b/src/main/frege/buildclient/util/IoUtils.fr new file mode 100644 index 0000000..afa6bd6 --- /dev/null +++ b/src/main/frege/buildclient/util/IoUtils.fr @@ -0,0 +1,78 @@ +module buildclient.util.IoUtils where + + +import frege.java.Net +import frege.java.IO + +data HttpURLConnection = native java.net.HttpURLConnection where + -- Unchecked cast, but who cares + native fromUrlConnection "(java.net.HttpURLConnection)" :: MutableIO URLConnection -> IOMutable HttpURLConnection + native setRequestProperty :: MutableIO HttpURLConnection -> String -> String -> IO () + native getHeaderField :: MutableIO HttpURLConnection -> String -> IO (Maybe String) + native getResponseCode :: MutableIO HttpURLConnection -> IO Int throws IOException + +data ZipEntry = native java.util.zip.ZipEntry where + native getName :: Mutable s ZipEntry -> ST s String + native isDirectory :: Mutable s ZipEntry -> ST s Bool + +data ZipInputStream = native java.util.zip.ZipInputStream where + native new :: MutableIO InputStream -> IOMutable ZipInputStream + native getNextEntry :: MutableIO ZipInputStream -> IO (Maybe (MutableIO ZipEntry)) throws IOException + native closeEntry :: MutableIO ZipInputStream -> IO () throws IOException +extractZip :: Int -> File -> File -> IO () +extractZip skipDirs archiveFile targetDirectory = + do + File.mkdirs targetDirectory + fis <- FileInputStream.new archiveFile + zis <- ZipInputStream.new fis + extractFiles zis + return () + where + extractFiles zis = do + entry <- ZipInputStream.getNextEntry zis + case entry of + Just n -> extractFile zis n >> extractFiles zis + Nothing -> return () + extractFile zis zentry = do + isdir <- ZipEntry.isDirectory zentry + if isdir + then return () + else do + name <- ZipEntry.getName zentry + let (Right pattern) = Regex.compile "[/\\\\]" + let parts = drop skipDirs $ toList $ Regex.split (pattern) name + let targetFile = fold File.new targetDirectory parts + maybe (return false) File.mkdirs $ File.getParentFile targetFile + saveInputStreamTo zis targetFile + return () + +writeFileStr :: File -> String -> IO () +writeFileStr file text = do + fos <- FileOutputStream.new file + osw <- OutputStreamWriter.new fos "UTF-8" + osw.write text + osw.close + +readFileStr :: File -> IO String +readFileStr file = do + fis <- FileInputStream.new file + isr <- InputStreamReader.new fis "UTF-8" + getContentsOf isr + +saveInputStreamTo :: MutableIO InputStream -> File -> IO () +saveInputStreamTo is file = + do maybe (return false) File.mkdirs $ File.getParentFile file + fos <- FileOutputStream.new file + arr <- newArray 4096 + copyloop arr fos + fos.close + return () + where + copyloop :: ArrayOf RealWorld Byte -> MutableIO FileOutputStream -> IO () + copyloop buf to = do + rc <- InputStream.read is buf + if rc < 0 + then return () + else do + OutputStream.write to buf 0 rc + copyloop buf to diff --git a/src/main/frege/examples/HelloFrege.fr b/src/main/frege/examples/HelloFrege.fr index 8f49899..856cbd7 100644 --- a/src/main/frege/examples/HelloFrege.fr +++ b/src/main/frege/examples/HelloFrege.fr @@ -9,4 +9,5 @@ main = do let (Right x) = parseBuildConfigStr text bcDownloadSync (File.new "testdest") (BuildConfig.source x) + bcExecuteBuild (BuildConfig.build x) (File.new "testdest/archive-extracted") (File.new "testdest/finished.jar") return () diff --git a/src/main/resources/testconfig.bcc b/src/main/resources/testconfig.bcc index 18bd21f..bf471d2 100644 --- a/src/main/resources/testconfig.bcc +++ b/src/main/resources/testconfig.bcc @@ -16,5 +16,6 @@ source http { build gradle { task "jar" project "forge-1.8.9" + property "testprop" "othertestprop" } |