From cbaf54d76f1ace2ad3e7643101e54d2a196eec50 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?=
 <44544735+xsebek@users.noreply.github.com>
Date: Sun, 9 Jun 2024 19:38:45 +0200
Subject: [PATCH] Fix Lazy IO opening too many files in integration tests
 (#1917)

When running on macOS, the integration tests open too many file handles,
even when you do not need to run any swarm file tests.
```sh
> cabal run -O0 swarm-integration -- -p editors
swarm-integration: data/scenarios/Challenges/_bucket-brigade/hauler.sw: openFile: resource exhausted (Too many open files)
```
The solution is to get the file paths only and safely open them as needed.
Surprisingly, this even makes the integration test code simpler.

* discovered while fixing failing tests in #1895
---
 src/swarm-util/Swarm/Util.hs | 20 ++++++++++++++------
 test/integration/Main.hs     | 31 +++++++++++++++----------------
 2 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/src/swarm-util/Swarm/Util.hs b/src/swarm-util/Swarm/Util.hs
index 48a1671d6..ffdb9b100 100644
--- a/src/swarm-util/Swarm/Util.hs
+++ b/src/swarm-util/Swarm/Util.hs
@@ -36,6 +36,7 @@ module Swarm.Util (
   -- * Directory utilities
   readFileMay,
   readFileMayT,
+  findAllWithExt,
   acquireAllWithExt,
 
   -- * Text utilities
@@ -310,19 +311,26 @@ readFileMayT :: FilePath -> IO (Maybe Text)
 readFileMayT = catchIO . T.readFile
 
 -- | Recursively acquire all files in the given directory with the
---   given extension, and their contents.
-acquireAllWithExt :: FilePath -> String -> IO [(FilePath, String)]
-acquireAllWithExt dir ext = do
+--   given extension, but does not read or open the file like 'acquireAllWithExt'.
+findAllWithExt :: FilePath -> String -> IO [FilePath]
+findAllWithExt dir ext = do
   paths <- listDirectory dir <&> map (dir </>)
   filePaths <- filterM (\path -> doesFileExist path <&> (&&) (hasExt path)) paths
-  children <- mapM (\path -> (,) path <$> readFile path) filePaths
   -- recurse
   sub <- filterM doesDirectoryExist paths
-  transChildren <- concat <$> mapM (`acquireAllWithExt` ext) sub
-  return $ children <> transChildren
+  transChildren <- concat <$> mapM (`findAllWithExt` ext) sub
+  return $ filePaths <> transChildren
  where
   hasExt path = takeExtension path == ("." ++ ext)
 
+-- | Recursively acquire all files in the given directory with the
+--   given extension, and their contents.
+acquireAllWithExt :: FilePath -> String -> IO [(FilePath, String)]
+acquireAllWithExt dir ext = findAllWithExt dir ext >>= mapM addContent
+ where
+  addContent :: FilePath -> IO (FilePath, String)
+  addContent path = (,) path <$> readFile path
+
 -- | Turns any IO error into Nothing.
 catchIO :: IO a -> IO (Maybe a)
 catchIO act = (Just <$> act) `catchIOError` (\_ -> return Nothing)
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
index 455ce7c9f..984551a14 100644
--- a/test/integration/Main.hs
+++ b/test/integration/Main.hs
@@ -78,7 +78,7 @@ import Swarm.TUI.Model (
  )
 import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState)
 import Swarm.TUI.Model.UI (UIState)
-import Swarm.Util (acquireAllWithExt)
+import Swarm.Util (findAllWithExt)
 import Swarm.Util.RingBuffer qualified as RB
 import Swarm.Util.Yaml (decodeFileEitherE)
 import System.FilePath.Posix (splitDirectories)
@@ -87,15 +87,15 @@ import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)
 import Witch (into)
 
-isUnparseableTest :: (FilePath, String) -> Bool
-isUnparseableTest (fp, _) = "_Validation" `elem` splitDirectories fp
+isUnparseableTest :: FilePath -> Bool
+isUnparseableTest fp = "_Validation" `elem` splitDirectories fp
 
 main :: IO ()
 main = do
-  examplePaths <- acquireAllWithExt "example" "sw"
-  scenarioPaths <- acquireAllWithExt "data/scenarios" "yaml"
+  examplePaths <- findAllWithExt "example" "sw"
+  scenarioPaths <- findAllWithExt "data/scenarios" "yaml"
   let (unparseableScenarios, parseableScenarios) = partition isUnparseableTest scenarioPaths
-  scenarioPrograms <- acquireAllWithExt "data/scenarios" "sw"
+  scenarioPrograms <- findAllWithExt "data/scenarios" "sw"
   (rs, ui) <- do
     out <- runM . runThrow @SystemFailure $ initPersistentState defaultAppOpts
     either (assertFailure . prettyString) return out
@@ -127,23 +127,22 @@ checkNoRuntimeErrors r =
 isError :: LogEntry -> Bool
 isError = (>= Warning) . view leSeverity
 
-exampleTests :: [(FilePath, String)] -> TestTree
+exampleTests :: [FilePath] -> TestTree
 exampleTests inputs = testGroup "Test example" (map exampleTest inputs)
 
-exampleTest :: (FilePath, String) -> TestTree
-exampleTest (path, fileContent) =
+exampleTest :: FilePath -> TestTree
+exampleTest path =
   testCase ("processTerm for contents of " ++ show path) $ do
-    either (assertFailure . into @String) (const . return $ ()) value
- where
-  value = processTerm $ into @Text fileContent
+    value <- processTerm <$> T.readFile path
+    either (assertFailure . into @String) (\_ -> return ()) value
 
-scenarioParseTests :: ScenarioInputs -> [(FilePath, String)] -> TestTree
+scenarioParseTests :: ScenarioInputs -> [FilePath] -> TestTree
 scenarioParseTests scenarioInputs inputs =
   testGroup
     "Test scenarios parse"
     (map (scenarioTest Parsed scenarioInputs) inputs)
 
-scenarioParseInvalidTests :: ScenarioInputs -> [(FilePath, String)] -> TestTree
+scenarioParseInvalidTests :: ScenarioInputs -> [FilePath] -> TestTree
 scenarioParseInvalidTests scenarioInputs inputs =
   testGroup
     "Test invalid scenarios fail to parse"
@@ -151,8 +150,8 @@ scenarioParseInvalidTests scenarioInputs inputs =
 
 data ParseResult = Parsed | Failed
 
-scenarioTest :: ParseResult -> ScenarioInputs -> (FilePath, String) -> TestTree
-scenarioTest expRes scenarioInputs (path, _) =
+scenarioTest :: ParseResult -> ScenarioInputs -> FilePath -> TestTree
+scenarioTest expRes scenarioInputs path =
   testCase ("parse scenario " ++ show path) (getScenario expRes scenarioInputs path)
 
 getScenario :: ParseResult -> ScenarioInputs -> FilePath -> IO ()