summaryrefslogtreecommitdiff
path: root/src/main/frege
diff options
context:
space:
mode:
Diffstat (limited to 'src/main/frege')
-rw-r--r--src/main/frege/buildclient/config/BuildConfig.fr17
-rw-r--r--src/main/frege/buildclient/config/BuildParser.fr7
-rw-r--r--src/main/frege/buildclient/tasks/Executor.fr88
-rw-r--r--src/main/frege/buildclient/util/IoUtils.fr78
-rw-r--r--src/main/frege/examples/HelloFrege.fr1
5 files changed, 113 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 ()
generated by cgit (git 2.46.0) at 2024-11-22 03:02:11 +0000