Don't shell out to find

sandwich-contexts/lib/Test/Sandwich/Contexts/Files.hs

@@ -44,6 +44,7 @@ module Test.Sandwich.Contexts.Files (
   -- * Introduce file from a Nix package
   , introduceFileViaNixPackage
   , introduceFileViaNixPackage'
+  , introduceFileViaNixPackage''
   , getFileViaNixPackage
 
   -- * Introduce a binary from a Nix derivation
@@ -54,12 +55,17 @@ module Test.Sandwich.Contexts.Files (
   -- * Introduce a file from a Nix derivation
   , introduceFileViaNixDerivation
   , introduceFileViaNixDerivation'
+  , introduceFileViaNixDerivation''
   , getFileViaNixDerivation
 
   -- * Get a file
   , askFile
   , askFile'
 
+  -- * Helpers for file-finding callbacks
+  , defaultFindFile
+  , findFirstFile
+
   -- * Low-level
   , mkFileLabel
 
@@ -70,6 +76,7 @@ module Test.Sandwich.Contexts.Files (
 
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger
+import Control.Monad.Trans.Except
 import Data.String.Interpolate
 import GHC.TypeLits
 import Relude
@@ -153,6 +160,17 @@ type NixPackageName = Text
 -- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
 -- It's recommended to use this with -XTypeApplications.
 introduceFileViaNixPackage :: forall a context m. (
+  HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
+  ) =>
+    -- | Nix package name which contains the desired file.
+    -- This package will be evaluated using the configured Nixpkgs version of the 'NixContext'.
+    NixPackageName
+    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
+    -> SpecFree context m ()
+introduceFileViaNixPackage name = introduceFileViaNixPackage' @a name (defaultFindFile (symbolVal (Proxy @a)))
+
+-- | Same as 'introduceFileViaNixPackage', but allows you to customize the search callback.
+introduceFileViaNixPackage' :: forall a context m. (
   HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
   ) =>
     -- | Nix package name which contains the desired file.
@@ -165,10 +183,10 @@ introduceFileViaNixPackage :: forall a context m. (
     -> (FilePath -> IO FilePath)
     -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
     -> SpecFree context m ()
-introduceFileViaNixPackage = introduceFileViaNixPackage' (Proxy @a)
+introduceFileViaNixPackage' = introduceFileViaNixPackage'' (Proxy @a)
 
--- | Same as 'introduceFileViaNixPackage', but allows passing a 'Proxy'.
-introduceFileViaNixPackage' :: forall a context m. (
+-- | Same as 'introduceFileViaNixPackage'', but allows passing a 'Proxy'.
+introduceFileViaNixPackage'' :: forall a context m. (
   HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
   ) => Proxy a
     -- | Nix package name which contains the desired file.
@@ -180,7 +198,7 @@ introduceFileViaNixPackage' :: forall a context m. (
     -> (FilePath -> IO FilePath)
     -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
     -> SpecFree context m ()
-introduceFileViaNixPackage' proxy packageName tryFindFile = introduce [i|#{symbolVal proxy} (file via Nix package #{packageName})|] (mkFileLabel @a) alloc (const $ return ())
+introduceFileViaNixPackage'' proxy packageName tryFindFile = introduce [i|#{symbolVal proxy} (file via Nix package #{packageName})|] (mkFileLabel @a) alloc (const $ return ())
   where
     alloc = buildNixSymlinkJoin [packageName] >>= \p -> EnvironmentFile <$> liftIO (tryFindFile p)
 
@@ -285,6 +303,16 @@ getBinaryViaNixDerivation derivation =
 -- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
 -- It's recommended to use this with -XTypeApplications.
 introduceFileViaNixDerivation :: forall a context m. (
+  HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
+  ) =>
+    -- | Nix derivation as a string.
+    Text
+    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
+    -> SpecFree context m ()
+introduceFileViaNixDerivation derivation = introduceFileViaNixDerivation' @a derivation (defaultFindFile (symbolVal (Proxy @a)))
+
+-- | Same as 'introduceFileViaNixDerivation', but allows configuring the file finding callback.
+introduceFileViaNixDerivation' :: forall a context m. (
   HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
   ) =>
     -- | Nix derivation as a string.
@@ -293,10 +321,10 @@ introduceFileViaNixDerivation :: forall a context m. (
     -> (FilePath -> IO FilePath)
     -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
     -> SpecFree context m ()
-introduceFileViaNixDerivation = introduceFileViaNixDerivation' (Proxy @a)
+introduceFileViaNixDerivation' = introduceFileViaNixDerivation'' (Proxy @a)
 
--- | Same as 'introduceFileViaNixDerivation', but allows passing a 'Proxy'.
-introduceFileViaNixDerivation' :: forall a context m. (
+-- | Same as 'introduceFileViaNixDerivation'', but allows passing a 'Proxy'.
+introduceFileViaNixDerivation'' :: forall a context m. (
   HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
   ) => Proxy a
     -- | Nix derivation as a string.
@@ -305,7 +333,7 @@ introduceFileViaNixDerivation' :: forall a context m. (
     -> (FilePath -> IO FilePath)
     -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
     -> SpecFree context m ()
-introduceFileViaNixDerivation' proxy derivation tryFindFile = introduce [i|#{symbolVal proxy} (file via Nix derivation)|] (mkFileLabel @a) alloc (const $ return ())
+introduceFileViaNixDerivation'' proxy derivation tryFindFile = introduce [i|#{symbolVal proxy} (file via Nix derivation)|] (mkFileLabel @a) alloc (const $ return ())
   where
     alloc = EnvironmentFile <$> (buildNixCallPackageDerivation derivation >>= liftIO . tryFindFile)
 
@@ -327,3 +355,25 @@ tryFindBinary binaryName env = do
   findExecutablesInDirectories [env </> "bin"] binaryName >>= \case
     (x:_) -> return $ EnvironmentFile x
     _ -> expectationFailure [i|Couldn't find binary '#{binaryName}' in #{env </> "bin"}|]
+
+-- | Find a file whose name exactly matches a string, using 'findFirstFile'.
+-- This calls 'takeFileName', so it only matches against the name, not the relative path.
+defaultFindFile :: String -> FilePath -> IO FilePath
+defaultFindFile name root = findFirstFile (\x -> return (takeFileName x == name)) root
+
+-- | Find the first file under the given directory (recursively) which matches the predicate.
+-- Note that the callback receives the full relative path to the file from the root dir.
+-- Throws using 'expectationFailure' when the file is not found.
+findFirstFile :: (FilePath -> IO Bool) -> FilePath -> IO FilePath
+findFirstFile predicate dir = runExceptT (go dir) >>= \case
+  Left x -> return x
+  Right () -> expectationFailure [i|Couldn't find file in '#{dir}'|]
+  where
+    go :: FilePath -> ExceptT FilePath IO ()
+    go currentDir = do
+      contents <- liftIO $ listDirectory currentDir
+      forM_ contents $ \name -> do
+        let path = currentDir </> name
+        doesDirectoryExist path >>= \case
+          True -> go path
+          False -> whenM (liftIO $ predicate path) (throwE path)

sandwich-contexts/package.yaml

@@ -67,6 +67,7 @@ library:
   - temporary
   - text
   - time
+  - transformers
   - unix
   - unliftio-core
   - vector

sandwich-contexts/sandwich-contexts.cabal

@@ -75,6 +75,7 @@ library
     , temporary
     , text
     , time
+    , transformers
     , unix
     , unliftio
     , unliftio-core

sandwich-webdriver/src/Test/Sandwich/WebDriver.hs

@@ -40,10 +40,10 @@ import Control.Monad.IO.Class
 import Control.Monad.Logger
 import Control.Monad.Reader
 import Data.IORef
+import qualified Data.List as L
 import qualified Data.Map as M
 import Data.Maybe
 import Data.String.Interpolate
-import qualified Data.Text as T
 import Test.Sandwich
 import Test.Sandwich.Contexts.Files
 import Test.Sandwich.Contexts.Nix
@@ -60,7 +60,6 @@ import qualified Test.WebDriver as W
 import qualified Test.WebDriver.Config as W
 import qualified Test.WebDriver.Session as W
 import UnliftIO.MVar
-import UnliftIO.Process
 
 
 -- | This is the main 'introduce' method for creating a WebDriver.
@@ -73,7 +72,7 @@ introduceWebDriverViaNix :: forall m context. (
   BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
   ) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
 introduceWebDriverViaNix wdOptions =
-  introduceFileViaNixPackage @"selenium.jar" "selenium-server-standalone" tryFindSeleniumJar
+  introduceFileViaNixPackage' @"selenium.jar" "selenium-server-standalone" (findFirstFile (return . (".jar" `L.isSuffixOf`)))
   . introduceBinaryViaNixPackage @"java" "jre"
   . introduceBrowserDependenciesViaNix
   . introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
@@ -82,9 +81,6 @@ introduceWebDriverViaNix wdOptions =
       clo <- getSomeCommandLineOptions
       allocateWebDriver (addCommandLineOptionsToWdOptions clo wdOptions)
 
-    tryFindSeleniumJar :: FilePath -> IO FilePath
-    tryFindSeleniumJar path = (T.unpack . T.strip . T.pack) <$> readCreateProcess (proc "find" [path, "-name", "*.jar"]) ""
-
 -- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
 introduceWebDriverOptions :: forall context m. (
   BaseMonadContext m context, HasSomeCommandLineOptions context

sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs

@@ -7,16 +7,17 @@ import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger
 import Control.Monad.Reader
+import qualified Data.List as L
 import Data.String.Interpolate
 import qualified Data.Text as T
 import GHC.Stack
 import System.Directory
 import Test.Sandwich
+import Test.Sandwich.Contexts.Files
 import Test.Sandwich.Contexts.Nix
 import Test.Sandwich.WebDriver.Internal.Binaries.Common
 import Test.Sandwich.WebDriver.Internal.Binaries.Selenium.Types
 import Test.Sandwich.WebDriver.Internal.Util
-import UnliftIO.Process
 
 
 type Constraints m = (
@@ -50,11 +51,8 @@ obtainSelenium (UseSeleniumAt path) = liftIO (doesFileExist path) >>= \case
   False -> expectationFailure [i|Path '#{path}' didn't exist|]
   True -> return path
 obtainSelenium (UseSeleniumFromNixpkgs nixContext) = do
-  env <- buildNixSymlinkJoin' nixContext ["selenium-server-standalone"]
-  liftIO (tryFindSeleniumJar env)
-  where
-    tryFindSeleniumJar :: FilePath -> IO FilePath
-    tryFindSeleniumJar path = (T.unpack . T.strip . T.pack) <$> readCreateProcess (proc "find" [path, "-name", "*.jar"]) ""
+  buildNixSymlinkJoin' nixContext ["selenium-server-standalone"] >>=
+    liftIO . findFirstFile (return . (".jar" `L.isSuffixOf`))
 
 
 -- * Lower level helpers