mirror of
https://github.com/codedownio/sandwich.git
synced 2024-07-14 15:10:30 +03:00
Don't shell out to find
This commit is contained in:
parent
809c9ea997
commit
735f0b8752
@ -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)
|
||||
|
@ -67,6 +67,7 @@ library:
|
||||
- temporary
|
||||
- text
|
||||
- time
|
||||
- transformers
|
||||
- unix
|
||||
- unliftio-core
|
||||
- vector
|
||||
|
@ -75,6 +75,7 @@ library
|
||||
, temporary
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
, unix
|
||||
, unliftio
|
||||
, unliftio-core
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user