summaryrefslogtreecommitdiff
path: root/src/main/frege/buildclient/tasks/Executor.fr
diff options
context:
space:
mode:
Diffstat (limited to 'src/main/frege/buildclient/tasks/Executor.fr')
-rw-r--r--src/main/frege/buildclient/tasks/Executor.fr111
1 files changed, 111 insertions, 0 deletions
diff --git a/src/main/frege/buildclient/tasks/Executor.fr b/src/main/frege/buildclient/tasks/Executor.fr
new file mode 100644
index 0000000..da17d89
--- /dev/null
+++ b/src/main/frege/buildclient/tasks/Executor.fr
@@ -0,0 +1,111 @@
+module buildclient.tasks.Executor where
+
+
+import buildclient.config.BuildConfig
+import frege.java.Net
+import frege.java.IO
+import Data.Array
+
+
+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
+
+ let etagFile = File.new targetDirectory "etag.txt"
+ oldEtagExists <- File.exists etagFile
+ oldEtag <- if oldEtagExists then readFileStr etagFile else pure ""
+
+ parsedUrl <- URL.new url
+ conn <- URL.openConnection parsedUrl >>= (HttpURLConnection.fromUrlConnection)
+ HttpURLConnection.setRequestProperty conn "If-None-Match" oldEtag
+
+ -- Get InputStream early to trigger communication with server -> load response headers
+ inputStream <- URLConnection.getInputStream conn
+
+ newEtag <- HttpURLConnection.getHeaderField conn "etag"
+ maybe (return ()) (writeFileStr etagFile) newEtag
+ resp <- HttpURLConnection.getResponseCode conn
+ case resp of
+ 304 = return () -- 304 indicated etag hit
+ 200 = do
+ let archiveFile = File.new targetDirectory "archive.zip"
+ saveInputStreamTo inputStream $ archiveFile
+ extractZip skipDirs archiveFile $ File.new targetDirectory "archive-extracted"
+ otherwise = fail ("Server replied with unexpected http code " ++ show resp)
+
+ 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 ()
+
+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