From 0ecf74e434835cf31c837d846828f3e351f9e099 Mon Sep 17 00:00:00 2001
From: Stiopa Koltsov <stepan.koltsov@gmail.com>
Date: Fri, 16 Jul 2021 18:33:48 +0100
Subject: [PATCH] System.Directory.nextDirEntry

* add `nextDirEntry` which returns `Maybe String`, so `Nothing` on
  the end of directory unlike `dirEntry` which returns unspecified error
  on the end of directory
* `dirEntry` is deprecated now, but not removed because compiler depends on it
* native implementation of `dirEntry` is patched to explicitly reset `errno`
  before the `readdir` call: without it end of directory and error were
  indistinguishable
* test added
---
 libs/base/System/Directory.idr          | 20 ++++++++++++++++----
 support/c/idris_directory.c             |  4 ++++
 tests/Main.idr                          |  1 +
 tests/base/system_directory/ReadDir.idr | 22 ++++++++++++++++++++++
 tests/base/system_directory/dir/a       |  0
 tests/base/system_directory/expected    |  2 ++
 tests/base/system_directory/input       |  2 ++
 tests/base/system_directory/run         |  3 +++
 8 files changed, 50 insertions(+), 4 deletions(-)
 create mode 100644 tests/base/system_directory/ReadDir.idr
 create mode 100644 tests/base/system_directory/dir/a
 create mode 100644 tests/base/system_directory/expected
 create mode 100644 tests/base/system_directory/input
 create mode 100755 tests/base/system_directory/run

diff --git a/libs/base/System/Directory.idr b/libs/base/System/Directory.idr
index be3fe88f0..bc5cdfdf7 100644
--- a/libs/base/System/Directory.idr
+++ b/libs/base/System/Directory.idr
@@ -1,5 +1,6 @@
 module System.Directory
 
+import System.Errno
 import public System.File
 
 %default total
@@ -97,9 +98,20 @@ removeDir : HasIO io => String -> io ()
 removeDir dirName = primIO (prim__removeDir dirName)
 
 export
-dirEntry : HasIO io => Directory -> io (Either FileError String)
-dirEntry (MkDir d)
+nextDirEntry : HasIO io => Directory -> io (Either FileError (Maybe String))
+nextDirEntry (MkDir d)
     = do res <- primIO (prim__dirEntry d)
          if prim__nullPtr res /= 0
-            then returnError
-            else ok (prim__getString res)
+            then if !(getErrno) /= 0
+                    then returnError
+                    else pure $ Right Nothing
+            else pure $ Right (Just (prim__getString res))
+
+-- This function is deprecated; to be removed after the next version bump
+export
+dirEntry : HasIO io => Directory -> io (Either FileError String)
+dirEntry d = do r <- nextDirEntry d
+                pure $ case r of
+                         Left e         => Left e
+                         Right (Just n) => Right n
+                         Right Nothing  => Left FileNotFound
diff --git a/support/c/idris_directory.c b/support/c/idris_directory.c
index d0f86d7bb..80479e362 100644
--- a/support/c/idris_directory.c
+++ b/support/c/idris_directory.c
@@ -60,6 +60,10 @@ int idris2_removeDir(char* path) {
 
 char* idris2_nextDirEntry(void* d) {
     DirInfo* di = (DirInfo*)d;
+    // `readdir` keeps `errno` unchanged on end of stream
+    // so we need to reset `errno` to distinguish between
+    // end of stream and failure.
+    errno = 0;
     struct dirent* de = readdir(di->dirptr);
 
     if (de == NULL) {
diff --git a/tests/Main.idr b/tests/Main.idr
index 76eba47ee..31e8e0759 100644
--- a/tests/Main.idr
+++ b/tests/Main.idr
@@ -298,6 +298,7 @@ baseLibraryTests = MkTestPool "Base library" [Chez, Node] Nothing
   , "data_bits001"
   , "data_string_lines001"
   , "data_string_unlines001"
+  , "system_directory"
   , "system_errno"
   , "system_info001"
   , "system_signal001", "system_signal002", "system_signal003", "system_signal004"
diff --git a/tests/base/system_directory/ReadDir.idr b/tests/base/system_directory/ReadDir.idr
new file mode 100644
index 000000000..2e11b5a91
--- /dev/null
+++ b/tests/base/system_directory/ReadDir.idr
@@ -0,0 +1,22 @@
+import System
+import System.Directory
+
+panic : String -> IO a
+panic s = do putStrLn s
+             exitFailure
+
+collectEntries : Directory -> IO (List String)
+collectEntries d = do Right (Just n) <- nextDirEntry d
+                        | Right Nothing => pure []
+                        | Left e        => panic (show e)
+                      ns <- collectEntries d
+                      if n == "." || n == ".."
+                         then pure ns
+                         else pure (n :: ns)
+
+main : IO ()
+main = do Right d <- openDir "dir"
+            | Left e => panic (show e)
+          ["a"] <- collectEntries d
+            | x => panic ("wrong entries: " ++ (show x))
+          pure ()
diff --git a/tests/base/system_directory/dir/a b/tests/base/system_directory/dir/a
new file mode 100644
index 000000000..e69de29bb
diff --git a/tests/base/system_directory/expected b/tests/base/system_directory/expected
new file mode 100644
index 000000000..2f0f68c04
--- /dev/null
+++ b/tests/base/system_directory/expected
@@ -0,0 +1,2 @@
+1/1: Building ReadDir (ReadDir.idr)
+Main> Main> Bye for now!
diff --git a/tests/base/system_directory/input b/tests/base/system_directory/input
new file mode 100644
index 000000000..fc5992c29
--- /dev/null
+++ b/tests/base/system_directory/input
@@ -0,0 +1,2 @@
+:exec main
+:q
diff --git a/tests/base/system_directory/run b/tests/base/system_directory/run
new file mode 100755
index 000000000..5e9264afd
--- /dev/null
+++ b/tests/base/system_directory/run
@@ -0,0 +1,3 @@
+rm -rf build
+
+$1 --no-color --console-width 0 --no-banner ReadDir.idr < input