Add System.Directory

Currently supports creating and changing directories. Support for
reading contents of directories still missing.

libs/base/System/Directory.idr

@@ -2,52 +2,38 @@ module System.Directory
 
 import public System.File
 
-public export
+toFileError : Int -> FileError
-data Directory : Type where
+toFileError 1 = FileReadError
-  DHandle : (p : AnyPtr) -> Directory
+toFileError 2 = FileWriteError
+toFileError 3 = FileNotFound
+toFileError 4 = PermissionDenied
+toFileError x = GenericFileError (x - 256)
 
-export
+fpure : Either Int a -> IO (Either FileError a)
-dirOpen : (d : String) -> IO (Either FileError Directory)
+fpure (Left err) = pure (Left (toFileError err))
--- dirOpen d
+fpure (Right x) = pure (Right x)
---     = do dptr <- foreign FFI_C "idris_dirOpen" (String -> IO Ptr) d
---          if !(nullPtr dptr)
---             then Left <$> getFileError
---             else pure (Right (DHandle dptr))
 
-export
+%foreign "scheme:blodwen-current-directory"
-dirClose : Directory -> IO ()
+prim_currentDir : PrimIO String
--- dirClose (DHandle d) = foreign FFI_C "idris_dirClose" (Ptr -> IO ()) d
 
-export
+%foreign "scheme:blodwen-change-directory"
-dirError : Directory -> IO Bool
+prim_changeDir : String -> PrimIO Int
--- dirError (DHandle d)
---     = do err <- foreign FFI_C "idris_dirError" (Ptr -> IO Int) d
---          pure (err /= 0)
 
-export
+%foreign "scheme:blodwen-create-directory"
-dirEntry : Directory -> IO (Either FileError String)
+prim_createDir : String -> PrimIO (Either Int ())
--- dirEntry (DHandle d)
---     = do fn <- foreign FFI_C "idris_nextDirEntry" (Ptr -> IO String) d
---          if !(dirError (DHandle d))
---             then pure (Left FileReadError)
---             else pure (Right fn)
 
 export
 createDir : String -> IO (Either FileError ())
--- createDir d
+createDir dir
---     = do ok <- foreign FFI_C "idris_mkdir" (String -> IO Int) d
+    = do ok <- primIO (prim_createDir dir)
---          if (ok == 0)
+         fpure ok
---             then pure (Right ())
---             else Left <$> getFileError
 
 export
 changeDir : String -> IO Bool
--- changeDir dir 
+changeDir dir
---     = do ok <- foreign FFI_C "idris_chdir" (String -> IO Int) dir
+    = do ok <- primIO (prim_changeDir dir)
---          pure (ok == 0)
+         pure (ok /= 0)
 
 export
 currentDir : IO String
--- currentDir = do
+currentDir = primIO prim_currentDir
---   MkRaw s <- foreign FFI_C "idris_currentDir" (IO (Raw String))
---   pure s

libs/base/base.ipkg

@@ -33,6 +33,7 @@ modules = Control.Monad.Identity,
 
           System,
           System.Concurrency.Raw,
+          System.Directory,
           System.File,
           System.Info,
           System.REPL

support/chez/support.ss

@@ -117,7 +117,7 @@
         ((i/o-write-error? x) 2)
         ((i/o-file-does-not-exist-error? x) 3)
         ((i/o-file-protection-error? x) 4)
-        (else (+ x 256))))
+        (else 255)))
 
 ;; If the file operation raises an error, catch it and return an appropriate
 ;; error code
@@ -164,6 +164,19 @@
         1
         0))
 
+;; Directories
+
+(define (blodwen-current-directory)
+  (current-directory))
+
+(define (blodwen-change-directory dir)
+  (if (file-directory? dir)
+      (begin (current-directory dir) 1)
+      0))
+
+(define (blodwen-create-directory dir)
+  (blodwen-file-op (lambda () (mkdir dir) 0)))
+
 ;; Threads
 
 (define blodwen-thread-data (make-thread-parameter #f))

support/racket/support.rkt

@@ -169,6 +169,19 @@
       1
       0))
 
+;; Directories
+
+(define (blodwen-current-directory)
+  (path->string (current-directory)))
+
+(define (blodwen-change-directory dir)
+  (if (directory-exists? dir)
+      (begin (current-directory dir) 1)
+      0))
+
+(define (blodwen-create-directory dir)
+  (blodwen-file-op (lambda () (make-directory dir))))
+
 ;; Threads
 
 (define blodwen-thread-data (make-thread-cell #f))