mirror of
https://github.com/codedownio/sandwich.git
synced 2024-10-05 15:57:10 +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
|
-- * Introduce file from a Nix package
|
||||||
, introduceFileViaNixPackage
|
, introduceFileViaNixPackage
|
||||||
, introduceFileViaNixPackage'
|
, introduceFileViaNixPackage'
|
||||||
|
, introduceFileViaNixPackage''
|
||||||
, getFileViaNixPackage
|
, getFileViaNixPackage
|
||||||
|
|
||||||
-- * Introduce a binary from a Nix derivation
|
-- * Introduce a binary from a Nix derivation
|
||||||
@ -54,12 +55,17 @@ module Test.Sandwich.Contexts.Files (
|
|||||||
-- * Introduce a file from a Nix derivation
|
-- * Introduce a file from a Nix derivation
|
||||||
, introduceFileViaNixDerivation
|
, introduceFileViaNixDerivation
|
||||||
, introduceFileViaNixDerivation'
|
, introduceFileViaNixDerivation'
|
||||||
|
, introduceFileViaNixDerivation''
|
||||||
, getFileViaNixDerivation
|
, getFileViaNixDerivation
|
||||||
|
|
||||||
-- * Get a file
|
-- * Get a file
|
||||||
, askFile
|
, askFile
|
||||||
, askFile'
|
, askFile'
|
||||||
|
|
||||||
|
-- * Helpers for file-finding callbacks
|
||||||
|
, defaultFindFile
|
||||||
|
, findFirstFile
|
||||||
|
|
||||||
-- * Low-level
|
-- * Low-level
|
||||||
, mkFileLabel
|
, mkFileLabel
|
||||||
|
|
||||||
@ -70,6 +76,7 @@ module Test.Sandwich.Contexts.Files (
|
|||||||
|
|
||||||
import Control.Monad.IO.Unlift
|
import Control.Monad.IO.Unlift
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
|
import Control.Monad.Trans.Except
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
import Relude
|
import Relude
|
||||||
@ -153,6 +160,17 @@ type NixPackageName = Text
|
|||||||
-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
|
-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
|
||||||
-- It's recommended to use this with -XTypeApplications.
|
-- It's recommended to use this with -XTypeApplications.
|
||||||
introduceFileViaNixPackage :: forall a context m. (
|
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
|
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
||||||
) =>
|
) =>
|
||||||
-- | Nix package name which contains the desired file.
|
-- | Nix package name which contains the desired file.
|
||||||
@ -165,10 +183,10 @@ introduceFileViaNixPackage :: forall a context m. (
|
|||||||
-> (FilePath -> IO FilePath)
|
-> (FilePath -> IO FilePath)
|
||||||
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
||||||
-> SpecFree context m ()
|
-> SpecFree context m ()
|
||||||
introduceFileViaNixPackage = introduceFileViaNixPackage' (Proxy @a)
|
introduceFileViaNixPackage' = introduceFileViaNixPackage'' (Proxy @a)
|
||||||
|
|
||||||
-- | Same as 'introduceFileViaNixPackage', but allows passing a 'Proxy'.
|
-- | Same as 'introduceFileViaNixPackage'', but allows passing a 'Proxy'.
|
||||||
introduceFileViaNixPackage' :: forall a context m. (
|
introduceFileViaNixPackage'' :: forall a context m. (
|
||||||
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
||||||
) => Proxy a
|
) => Proxy a
|
||||||
-- | Nix package name which contains the desired file.
|
-- | Nix package name which contains the desired file.
|
||||||
@ -180,7 +198,7 @@ introduceFileViaNixPackage' :: forall a context m. (
|
|||||||
-> (FilePath -> IO FilePath)
|
-> (FilePath -> IO FilePath)
|
||||||
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
||||||
-> SpecFree 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
|
where
|
||||||
alloc = buildNixSymlinkJoin [packageName] >>= \p -> EnvironmentFile <$> liftIO (tryFindFile p)
|
alloc = buildNixSymlinkJoin [packageName] >>= \p -> EnvironmentFile <$> liftIO (tryFindFile p)
|
||||||
|
|
||||||
@ -285,6 +303,16 @@ getBinaryViaNixDerivation derivation =
|
|||||||
-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
|
-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
|
||||||
-- It's recommended to use this with -XTypeApplications.
|
-- It's recommended to use this with -XTypeApplications.
|
||||||
introduceFileViaNixDerivation :: forall a context m. (
|
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
|
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
||||||
) =>
|
) =>
|
||||||
-- | Nix derivation as a string.
|
-- | Nix derivation as a string.
|
||||||
@ -293,10 +321,10 @@ introduceFileViaNixDerivation :: forall a context m. (
|
|||||||
-> (FilePath -> IO FilePath)
|
-> (FilePath -> IO FilePath)
|
||||||
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
||||||
-> SpecFree context m ()
|
-> SpecFree context m ()
|
||||||
introduceFileViaNixDerivation = introduceFileViaNixDerivation' (Proxy @a)
|
introduceFileViaNixDerivation' = introduceFileViaNixDerivation'' (Proxy @a)
|
||||||
|
|
||||||
-- | Same as 'introduceFileViaNixDerivation', but allows passing a 'Proxy'.
|
-- | Same as 'introduceFileViaNixDerivation'', but allows passing a 'Proxy'.
|
||||||
introduceFileViaNixDerivation' :: forall a context m. (
|
introduceFileViaNixDerivation'' :: forall a context m. (
|
||||||
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
|
||||||
) => Proxy a
|
) => Proxy a
|
||||||
-- | Nix derivation as a string.
|
-- | Nix derivation as a string.
|
||||||
@ -305,7 +333,7 @@ introduceFileViaNixDerivation' :: forall a context m. (
|
|||||||
-> (FilePath -> IO FilePath)
|
-> (FilePath -> IO FilePath)
|
||||||
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
-> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
|
||||||
-> SpecFree 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
|
where
|
||||||
alloc = EnvironmentFile <$> (buildNixCallPackageDerivation derivation >>= liftIO . tryFindFile)
|
alloc = EnvironmentFile <$> (buildNixCallPackageDerivation derivation >>= liftIO . tryFindFile)
|
||||||
|
|
||||||
@ -327,3 +355,25 @@ tryFindBinary binaryName env = do
|
|||||||
findExecutablesInDirectories [env </> "bin"] binaryName >>= \case
|
findExecutablesInDirectories [env </> "bin"] binaryName >>= \case
|
||||||
(x:_) -> return $ EnvironmentFile x
|
(x:_) -> return $ EnvironmentFile x
|
||||||
_ -> expectationFailure [i|Couldn't find binary '#{binaryName}' in #{env </> "bin"}|]
|
_ -> 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
|
- temporary
|
||||||
- text
|
- text
|
||||||
- time
|
- time
|
||||||
|
- transformers
|
||||||
- unix
|
- unix
|
||||||
- unliftio-core
|
- unliftio-core
|
||||||
- vector
|
- vector
|
||||||
|
@ -75,6 +75,7 @@ library
|
|||||||
, temporary
|
, temporary
|
||||||
, text
|
, text
|
||||||
, time
|
, time
|
||||||
|
, transformers
|
||||||
, unix
|
, unix
|
||||||
, unliftio
|
, unliftio
|
||||||
, unliftio-core
|
, unliftio-core
|
||||||
|
@ -40,10 +40,10 @@ import Control.Monad.IO.Class
|
|||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import qualified Data.List as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import qualified Data.Text as T
|
|
||||||
import Test.Sandwich
|
import Test.Sandwich
|
||||||
import Test.Sandwich.Contexts.Files
|
import Test.Sandwich.Contexts.Files
|
||||||
import Test.Sandwich.Contexts.Nix
|
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.Config as W
|
||||||
import qualified Test.WebDriver.Session as W
|
import qualified Test.WebDriver.Session as W
|
||||||
import UnliftIO.MVar
|
import UnliftIO.MVar
|
||||||
import UnliftIO.Process
|
|
||||||
|
|
||||||
|
|
||||||
-- | This is the main 'introduce' method for creating a WebDriver.
|
-- | 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
|
BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
|
||||||
) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
|
) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
|
||||||
introduceWebDriverViaNix wdOptions =
|
introduceWebDriverViaNix wdOptions =
|
||||||
introduceFileViaNixPackage @"selenium.jar" "selenium-server-standalone" tryFindSeleniumJar
|
introduceFileViaNixPackage' @"selenium.jar" "selenium-server-standalone" (findFirstFile (return . (".jar" `L.isSuffixOf`)))
|
||||||
. introduceBinaryViaNixPackage @"java" "jre"
|
. introduceBinaryViaNixPackage @"java" "jre"
|
||||||
. introduceBrowserDependenciesViaNix
|
. introduceBrowserDependenciesViaNix
|
||||||
. introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
. introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
||||||
@ -82,9 +81,6 @@ introduceWebDriverViaNix wdOptions =
|
|||||||
clo <- getSomeCommandLineOptions
|
clo <- getSomeCommandLineOptions
|
||||||
allocateWebDriver (addCommandLineOptionsToWdOptions clo wdOptions)
|
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'.
|
-- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
|
||||||
introduceWebDriverOptions :: forall context m. (
|
introduceWebDriverOptions :: forall context m. (
|
||||||
BaseMonadContext m context, HasSomeCommandLineOptions context
|
BaseMonadContext m context, HasSomeCommandLineOptions context
|
||||||
|
@ -7,16 +7,17 @@ import Control.Monad.IO.Class
|
|||||||
import Control.Monad.IO.Unlift
|
import Control.Monad.IO.Unlift
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import qualified Data.List as L
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import GHC.Stack
|
import GHC.Stack
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Test.Sandwich
|
import Test.Sandwich
|
||||||
|
import Test.Sandwich.Contexts.Files
|
||||||
import Test.Sandwich.Contexts.Nix
|
import Test.Sandwich.Contexts.Nix
|
||||||
import Test.Sandwich.WebDriver.Internal.Binaries.Common
|
import Test.Sandwich.WebDriver.Internal.Binaries.Common
|
||||||
import Test.Sandwich.WebDriver.Internal.Binaries.Selenium.Types
|
import Test.Sandwich.WebDriver.Internal.Binaries.Selenium.Types
|
||||||
import Test.Sandwich.WebDriver.Internal.Util
|
import Test.Sandwich.WebDriver.Internal.Util
|
||||||
import UnliftIO.Process
|
|
||||||
|
|
||||||
|
|
||||||
type Constraints m = (
|
type Constraints m = (
|
||||||
@ -50,11 +51,8 @@ obtainSelenium (UseSeleniumAt path) = liftIO (doesFileExist path) >>= \case
|
|||||||
False -> expectationFailure [i|Path '#{path}' didn't exist|]
|
False -> expectationFailure [i|Path '#{path}' didn't exist|]
|
||||||
True -> return path
|
True -> return path
|
||||||
obtainSelenium (UseSeleniumFromNixpkgs nixContext) = do
|
obtainSelenium (UseSeleniumFromNixpkgs nixContext) = do
|
||||||
env <- buildNixSymlinkJoin' nixContext ["selenium-server-standalone"]
|
buildNixSymlinkJoin' nixContext ["selenium-server-standalone"] >>=
|
||||||
liftIO (tryFindSeleniumJar env)
|
liftIO . findFirstFile (return . (".jar" `L.isSuffixOf`))
|
||||||
where
|
|
||||||
tryFindSeleniumJar :: FilePath -> IO FilePath
|
|
||||||
tryFindSeleniumJar path = (T.unpack . T.strip . T.pack) <$> readCreateProcess (proc "find" [path, "-name", "*.jar"]) ""
|
|
||||||
|
|
||||||
|
|
||||||
-- * Lower level helpers
|
-- * Lower level helpers
|
||||||
|
Loading…
Reference in New Issue
Block a user