Merge pull request #4276 from unisonweb/tmpdir

cloud jit: implement createTempDirectory removeDirectory createDirectory renameFile isFileOpen ready

scheme-libs/racket/unison/io-handles.rkt

@@ -45,17 +45,16 @@
     getArgs.impl.v1
     getEnv.impl.v1
     getChar.impl.v1
+    isFileOpen.impl.v3
     process.call
     getCurrentDirectory.impl.v3
+    ready.impl.v1
     ))
 
 ; Still to implement:
 ;    handlePosition.impl.v3
 ;    isSeekable.impl.v3
 ;    getChar.impl.v1
-;    ready.impl.v1
-;    isFileOpen.impl.v3
-;    isFileEOF.impl.v3
    )
 
 ; typeLink msg any
@@ -64,6 +63,17 @@
            [x8 (unison-failure-failure typeLink message x7)])
     (unison-either-left x8)))
 
+(define-unison (isFileOpen.impl.v3 port)
+    (unison-either-right
+        (if (port-closed? port) unison-boolean-false unison-boolean-true)))
+
+(define-unison (ready.impl.v1 port)
+    (if (byte-ready? port)
+        (unison-either-right unison-boolean-true)
+        (if (port-eof? port)
+            (Exception 'IO "EOF" port)
+            (unison-either-right unison-boolean-false))))
+
 (define-unison (getCurrentDirectory.impl.v3 unit)
     (unison-either-right
       (string->chunked-string (path->string (current-directory)))))

scheme-libs/racket/unison/io.rkt

@@ -2,10 +2,14 @@
 (require unison/data
          unison/chunked-seq
          unison/core
+         unison/data-info
+         racket/file
          racket/flonum
+         (only-in unison/boot data-case define-unison)
          (only-in
            rnrs/arithmetic/flonums-6
            flmod))
+(require racket/file)
 
 (provide
  (prefix-out
@@ -24,7 +28,14 @@
    getFileTimestamp.impl.v3
    getTempDirectory.impl.v3
    removeFile.impl.v3
-   getFileSize.impl.v3)))
+   getFileSize.impl.v3))
+  (prefix-out
+    builtin-IO.
+    (combine-out
+        renameFile.impl.v3
+        createDirectory.impl.v3
+        removeDirectory.impl.v3
+        createTempDirectory.impl.v3)))
 
 (define (getFileSize.impl.v3 path)
     (with-handlers
@@ -36,8 +47,13 @@
         [[exn:fail:filesystem? (lambda (e) (exception "IOFailure" (exception->string e) '()))]]
         (right (file-or-directory-modify-seconds (chunked-string->string path)))))
 
+; in haskell, it's not just file but also directory
 (define (fileExists.impl.v3 path)
-    (right (bool (file-exists? (chunked-string->string path)))))
+    (let ([path-string (chunked-string->string path)])
+    (right (bool
+        (or
+        (file-exists? path-string)
+        (directory-exists? path-string))))))
 
 (define (removeFile.impl.v3 path)
     (delete-file (chunked-string->string path))
@@ -46,6 +62,27 @@
 (define (getTempDirectory.impl.v3)
     (right (string->chunked-string (path->string (find-system-path 'temp-dir)))))
 
+(define-unison (createTempDirectory.impl.v3 prefix)
+    (unison-either-right
+        (string->chunked-string
+            (path->string
+                (make-temporary-directory*
+                    (string->bytes/utf-8
+                        (chunked-string->string prefix)) #"")))))
+
+(define-unison (createDirectory.impl.v3 file)
+    (make-directory (chunked-string->string file))
+    (unison-either-right none))
+
+(define-unison (removeDirectory.impl.v3 file)
+    (delete-directory (chunked-string->string file))
+    (unison-either-right none))
+
+(define-unison (renameFile.impl.v3 old new)
+    (rename-file-or-directory (chunked-string->string old)
+        (chunked-string->string new))
+    (unison-either-right none))
+
 (define (threadCPUTime.v1)
     (right (current-process-milliseconds (current-thread))))
 (define (processCPUTime.v1)
@@ -55,7 +92,7 @@
 (define (monotonic.v1)
     (right (current-inexact-monotonic-milliseconds)))
 
-; 
+;
 (define (flt f) (fl->exact-integer (fltruncate f)))
 
 (define (sec.v1 ts) (flt (/ ts 1000)))

scheme-libs/racket/unison/primops.ss

@@ -72,12 +72,19 @@
     builtin-IO.setBuffering.impl.v3
     builtin-IO.getBuffering.impl.v3
     builtin-IO.setEcho.impl.v1
+    builtin-IO.isFileOpen.impl.v3
+    builtin-IO.ready.impl.v1
     builtin-IO.process.call
     builtin-IO.getEcho.impl.v1
     builtin-IO.getArgs.impl.v1
     builtin-IO.getEnv.impl.v1
     builtin-IO.getChar.impl.v1
+    builtin-IO.ready.impl.v1
     builtin-IO.getCurrentDirectory.impl.v3
+    builtin-IO.removeDirectory.impl.v3
+    builtin-IO.renameFile.impl.v3
+    builtin-IO.createTempDirectory.impl.v3
+    builtin-IO.createDirectory.impl.v3
     unison-FOp-IO.getFileSize.impl.v3
     unison-FOp-IO.getFileTimestamp.impl.v3
     unison-FOp-IO.fileExists.impl.v3

unison-src/builtin-tests/io-tests.u

@@ -15,16 +15,65 @@ io.tests = Tests.main do
     !io.test_getSomeBytes
     !io.test_getChar
     !io.test_getCurrentDirectory
+    !io.test_createTempDirectory
+    !io.test_renameFile
+    !io.test_isFileOpen
+    !io.test_ready
 
-testFile = do
-    fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
-    () = if FilePath.exists fp
+rm_if_exists fp =
+    if FilePath.exists fp
         then
             removeFile fp
         else
             ()
+
+testFile = do
+    fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
+    rm_if_exists fp
     fp
 
+io.test_createTempDirectory = do
+    tmp = (createTempDirectory (FilePath "prefix-"))
+    match tmp with
+        FilePath text -> if Text.contains "/prefix-" text then
+            if exists tmp then
+                removeDirectory tmp
+                Tests.pass "Tmp directory exists and contains prefix-"
+            else
+                Tests.fail "Tmp directory doesn't exist" text
+        else
+            Tests.fail "Tmp directory doesn't contain prefix-" text
+
+io.test_isFileOpen = do
+    fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
+    fhandle = open fp Write
+    open1 = isOpen fhandle
+    Handle.close fhandle
+    open2 = isOpen fhandle
+    rm_if_exists fp
+    checkEqual "opened handle is open" open1 true
+    checkEqual "closed handle is not open" open2 false
+
+io.test_ready = do
+    fp = !testFile
+    _ = writeFile fp "What"
+    fhandle = open fp Read
+    ready1 = ready fhandle
+    checkEqual "handle with text ready is ready" ready1 true
+
+io.test_renameFile = do
+    fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
+    rmp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test-renamed")
+    rm_if_exists fp
+    rm_if_exists rmp
+    contents = "a file contents"
+    _ = writeFile fp contents
+    renameFile fp rmp
+    got = (getText (open rmp Read))
+    rm_if_exists fp
+    rm_if_exists rmp
+    checkEqual "renameFile" contents got
+
 writeFile fp txt =
     fh = open fp Write
     putText fh txt