{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{-|

This module contains tools for introducing files and making them available to tests. It uses type-level strings, and is mostly intended to be used with -XTypeApplications.

For example:

@
introduceFile \@"grep" "\/path\/to\/grep" $ do
  it "uses grep for something" $ do
    grep <- askFile \@"grep"
    results <- readCreateProcess (proc grep ["foo"]) ""
    todo -- Do something with results
@

For reproducibility, you can leverage a 'NixContext' that's already been introduced to introduce binaries, either by specifying a Nixpkgs package name or by writing out a full derivation.

-}

module Test.Sandwich.Contexts.Files (
  -- * Introduce a file directly
  introduceFile
  , introduceFile'

  -- * Introduce a binary from the environment
  , introduceBinaryViaEnvironment
  , introduceBinaryViaEnvironment'

  -- * Introduce a binary from a Nix package
  , introduceBinaryViaNixPackage
  , introduceBinaryViaNixPackage'
  , getBinaryViaNixPackage
  , getBinaryViaNixPackage'

  -- * Introduce file from a Nix package
  , introduceFileViaNixPackage
  , introduceFileViaNixPackage'
  , introduceFileViaNixPackage''
  , getFileViaNixPackage

  -- * Introduce a binary from a Nix derivation
  , introduceBinaryViaNixDerivation
  , introduceBinaryViaNixDerivation'
  , getBinaryViaNixDerivation
  , getBinaryViaNixDerivation'

  -- * 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
  , defaultFileContextVisibilityThreshold

  -- * Types
  , EnvironmentFile(..)
  , HasFile
  , FileValue
  ) where

import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.Trans.Except
import Data.String.Interpolate
import GHC.TypeLits
import Relude
import System.FilePath
import Test.Sandwich
import Test.Sandwich.Contexts.Files.Types
import Test.Sandwich.Contexts.Nix
import UnliftIO.Directory


-- | Introduce a file by providing its path.
introduceFile :: forall a context m. (
  MonadUnliftIO m, KnownSymbol a
  )
  -- | Path to the file
  => FilePath
  -- | Child spec
  -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceFile :: forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
FilePath
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFile FilePath
path = NodeOptions
-> FilePath
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
NodeOptions
-> FilePath
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFile' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold }) FilePath
path

-- | Same as 'introduceFile', but allows passing custom 'NodeOptions'.
introduceFile' :: forall a context m. (
  MonadUnliftIO m, KnownSymbol a
  )
  => NodeOptions
  -> FilePath
  -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
  -> SpecFree context m ()
introduceFile' :: forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
NodeOptions
-> FilePath
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFile' NodeOptions
nodeOptions FilePath
path = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (binary from PATH)|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) (EnvironmentFile a -> ExampleT context m (EnvironmentFile a)
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnvironmentFile a -> ExampleT context m (EnvironmentFile a))
-> EnvironmentFile a -> ExampleT context m (EnvironmentFile a)
forall a b. (a -> b) -> a -> b
$ FilePath -> EnvironmentFile a
forall {k} (a :: k). FilePath -> EnvironmentFile a
EnvironmentFile FilePath
path) (ExampleT context m () -> EnvironmentFile a -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m ()
 -> EnvironmentFile a -> ExampleT context m ())
-> ExampleT context m ()
-> EnvironmentFile a
-> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    -- Saw a bug where we couldn't embed "symbolVal proxy" directly in the quasi-quote above.
    -- Failed with "Couldn't match kind ‘Bool’ with ‘Symbol’"
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

-- | Introduce a file from the PATH, which must be present when tests are run.
-- Useful when you want to set up your own environment with binaries etc. to use in tests.
-- Throws an exception if the desired file is not available.
introduceBinaryViaEnvironment :: forall a context m. (
  MonadUnliftIO m, KnownSymbol a
  )
  -- | Parent spec
  => SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
  -- | Child spec
  -> SpecFree context m ()
introduceBinaryViaEnvironment :: forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
SpecFree
  (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
   :> context)
  m
  ()
-> SpecFree context m ()
introduceBinaryViaEnvironment = NodeOptions
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
NodeOptions
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaEnvironment' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceBinaryViaEnvironment', but allows you to pass custom 'NodeOptions'.
introduceBinaryViaEnvironment' :: forall a context m. (
  MonadUnliftIO m, KnownSymbol a
  )
  => NodeOptions
  -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
  -> SpecFree context m ()
introduceBinaryViaEnvironment' :: forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
NodeOptions
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaEnvironment' NodeOptions
nodeOptions = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (binary from PATH)|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) ExampleT context m (EnvironmentFile a)
forall {k} {a :: k}. ExampleT context m (EnvironmentFile a)
alloc HasCallStack => EnvironmentFile a -> ExampleT context m ()
EnvironmentFile a -> ExampleT context m ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
cleanup
  where
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

    alloc :: ExampleT context m (EnvironmentFile a)
alloc = do
      IO (Maybe FilePath) -> ExampleT context m (Maybe FilePath)
forall a. IO a -> ExampleT context m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findExecutable FilePath
binaryName) ExampleT context m (Maybe FilePath)
-> (Maybe FilePath -> ExampleT context m (EnvironmentFile a))
-> ExampleT context m (EnvironmentFile a)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe FilePath
Nothing -> FilePath -> ExampleT context m (EnvironmentFile a)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure [i|Couldn't find binary '#{binaryName}' on PATH|]
        Just FilePath
path -> EnvironmentFile a -> ExampleT context m (EnvironmentFile a)
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnvironmentFile a -> ExampleT context m (EnvironmentFile a))
-> EnvironmentFile a -> ExampleT context m (EnvironmentFile a)
forall a b. (a -> b) -> a -> b
$ FilePath -> EnvironmentFile a
forall {k} (a :: k). FilePath -> EnvironmentFile a
EnvironmentFile FilePath
path

    cleanup :: p -> m ()
cleanup p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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 :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixPackage NixPackageName
name = forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixPackage' @a NixPackageName
name (FilePath -> FilePath -> IO FilePath
defaultFindFile (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
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.
    -- This package will be evaluated using the configured Nixpkgs version of the 'NixContext'.
    NixPackageName
    -- | Callback to find the desired file within the Nix derivation path.
    -- It will be passed the derivation path, and should return the file. For example,
    -- tryFindFile "\/nix\/store\/...selenium-server-standalone-3.141.59" may return
    -- "\/nix\/store\/...selenium-server-standalone-3.141.59\/share\/lib\/selenium-server-standalone-3.141.59\/selenium-server-standalone-3.141.59.jar".
    -> (FilePath -> IO FilePath)
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceFileViaNixPackage' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixPackage' = NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixPackage'' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceFileViaNixPackage'', but allows passing custom 'NodeOptions'.
introduceFileViaNixPackage'' :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
  ) => NodeOptions
    -- | Nix package name which contains the desired file.
    -> NixPackageName
    -- | Callback to find the desired file within the Nix derivation path.
    -- It will be passed the derivation path, and should return the file. For example,
    -- tryFindFile "\/nix\/store\/...selenium-server-standalone-3.141.59" may return
    -- "\/nix\/store\/...selenium-server-standalone-3.141.59\/share\/lib\/selenium-server-standalone-3.141.59\/selenium-server-standalone-3.141.59.jar".
    -> (FilePath -> IO FilePath)
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceFileViaNixPackage'' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixPackage'' NodeOptions
nodeOptions NixPackageName
packageName FilePath -> IO FilePath
tryFindFile = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (file via Nix package #{packageName})|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) ExampleT context m (EnvironmentFile a)
alloc (ExampleT context m () -> EnvironmentFile a -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m ()
 -> EnvironmentFile a -> ExampleT context m ())
-> ExampleT context m ()
-> EnvironmentFile a
-> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

    alloc :: ExampleT context m (EnvironmentFile a)
alloc = [NixPackageName] -> ExampleT context m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[NixPackageName] -> m FilePath
buildNixSymlinkJoin [NixPackageName
packageName] ExampleT context m FilePath
-> (FilePath -> ExampleT context m (EnvironmentFile a))
-> ExampleT context m (EnvironmentFile a)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
p -> FilePath -> EnvironmentFile a
forall {k} (a :: k). FilePath -> EnvironmentFile a
EnvironmentFile (FilePath -> EnvironmentFile a)
-> ExampleT context m FilePath
-> ExampleT context m (EnvironmentFile a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> ExampleT context m FilePath
forall a. IO a -> ExampleT context m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
tryFindFile FilePath
p)

-- | Lower-level version of 'introduceFileViaNixPackage'.
getFileViaNixPackage :: forall context m. (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLoggerIO m
  ) =>
    -- | Nix package name which contains the desired file.
    NixPackageName
    -- | Callback to find the desired file, as in 'introduceFileViaNixPackage'.
    -> (FilePath -> IO FilePath)
    -> m FilePath
getFileViaNixPackage :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLoggerIO m) =>
NixPackageName -> (FilePath -> IO FilePath) -> m FilePath
getFileViaNixPackage NixPackageName
packageName FilePath -> IO FilePath
tryFindFile = [NixPackageName] -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[NixPackageName] -> m FilePath
buildNixSymlinkJoin [NixPackageName
packageName] m FilePath -> (FilePath -> m FilePath) -> m FilePath
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
tryFindFile

-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
-- It's recommended to use this with -XTypeApplications.
introduceBinaryViaNixPackage :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
  ) =>
    -- | Nix package name which contains the desired binary.
    -- This package will be evaluated using the configured Nixpkgs version of the 'NixContext'.
    -- For example, you can use the "hello" binary from the "hello" package like this:
    --
    -- introduceBinaryViaNixPackage' @"hello" "hello"
    NixPackageName
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceBinaryViaNixPackage :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixPackage = forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixPackage' @a (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceBinaryViaNixPackage', but allows passing custom 'NodeOptions'.
introduceBinaryViaNixPackage' :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, KnownSymbol a
  ) => NodeOptions
    -- | Nix package name which contains the desired binary.
    -> NixPackageName
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceBinaryViaNixPackage' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixPackage' NodeOptions
nodeOptions NixPackageName
packageName = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (binary via Nix package #{packageName})|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) ExampleT context m (EnvironmentFile a)
alloc (ExampleT context m () -> EnvironmentFile a -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m ()
 -> EnvironmentFile a -> ExampleT context m ())
-> ExampleT context m ()
-> EnvironmentFile a
-> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

    alloc :: ExampleT context m (EnvironmentFile a)
alloc = [NixPackageName] -> ExampleT context m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[NixPackageName] -> m FilePath
buildNixSymlinkJoin [NixPackageName
packageName] ExampleT context m FilePath
-> (FilePath -> ExampleT context m (EnvironmentFile a))
-> ExampleT context m (EnvironmentFile a)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> ExampleT context m (EnvironmentFile a)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary FilePath
binaryName

-- | Lower-level version of 'introduceBinaryViaNixPackage'.
getBinaryViaNixPackage :: forall a context m. (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLoggerIO m, KnownSymbol a
  ) =>
    -- | Nix package name which contains the desired binary.
    NixPackageName
    -> m FilePath
getBinaryViaNixPackage :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLoggerIO m, KnownSymbol a) =>
NixPackageName -> m FilePath
getBinaryViaNixPackage NixPackageName
packageName = do
  EnvironmentFile Any -> FilePath
forall {k} (a :: k). EnvironmentFile a -> FilePath
unEnvironmentFile (EnvironmentFile Any -> FilePath)
-> m (EnvironmentFile Any) -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([NixPackageName] -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[NixPackageName] -> m FilePath
buildNixSymlinkJoin [NixPackageName
packageName] m FilePath
-> (FilePath -> m (EnvironmentFile Any)) -> m (EnvironmentFile Any)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> m (EnvironmentFile Any)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)))

-- | Lower-level version of 'introduceBinaryViaNixPackage'.
getBinaryViaNixPackage' :: forall a context m. (
  HasBaseContext context, MonadReader context m
  , MonadLogger m, MonadUnliftIO m, KnownSymbol a
  ) =>
    -- | 'NixContext' to use.
    NixContext
    -- | Nix package name which contains the desired binary.
    -> NixPackageName
    -> m FilePath
getBinaryViaNixPackage' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, MonadReader context m, MonadLogger m,
 MonadUnliftIO m, KnownSymbol a) =>
NixContext -> NixPackageName -> m FilePath
getBinaryViaNixPackage' NixContext
nc NixPackageName
packageName = do
  EnvironmentFile Any -> FilePath
forall {k} (a :: k). EnvironmentFile a -> FilePath
unEnvironmentFile (EnvironmentFile Any -> FilePath)
-> m (EnvironmentFile Any) -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixContext -> [NixPackageName] -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> [NixPackageName] -> m FilePath
buildNixSymlinkJoin' NixContext
nc [NixPackageName
packageName] m FilePath
-> (FilePath -> m (EnvironmentFile Any)) -> m (EnvironmentFile Any)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> m (EnvironmentFile Any)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)))

-- | Introduce a given 'EnvironmentFile' from the 'NixContext' in scope.
-- It's recommended to use this with -XTypeApplications.
introduceBinaryViaNixDerivation :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, MonadMask m, KnownSymbol a
  ) =>
    -- | Nix derivation as a string.
    Text
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceBinaryViaNixDerivation :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixDerivation = NodeOptions
-> NixPackageName
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixDerivation' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceBinaryViaNixDerivation', but allows passing custom 'NodeOptions'.
introduceBinaryViaNixDerivation' :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, MonadMask m, KnownSymbol a
  ) => NodeOptions
    -- | Nix derivation as a string.
    -> Text
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceBinaryViaNixDerivation' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixDerivation' NodeOptions
nodeOptions NixPackageName
derivation = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (binary via Nix derivation)|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) ExampleT context m (EnvironmentFile a)
alloc (ExampleT context m () -> EnvironmentFile a -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m ()
 -> EnvironmentFile a -> ExampleT context m ())
-> ExampleT context m ()
-> EnvironmentFile a
-> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

    alloc :: ExampleT context m (EnvironmentFile a)
alloc = NixPackageName -> ExampleT context m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m, MonadMask m) =>
NixPackageName -> m FilePath
buildNixCallPackageDerivation NixPackageName
derivation ExampleT context m FilePath
-> (FilePath -> ExampleT context m (EnvironmentFile a))
-> ExampleT context m (EnvironmentFile a)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> ExampleT context m (EnvironmentFile a)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary FilePath
binaryName

-- | Lower-level version of 'introduceBinaryViaNixDerivation'.
getBinaryViaNixDerivation :: forall a context m. (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLoggerIO m, MonadMask m, KnownSymbol a
  ) =>
    -- | Nix derivation as a string.
    Text
    -> m FilePath
getBinaryViaNixDerivation :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLoggerIO m, MonadMask m, KnownSymbol a) =>
NixPackageName -> m FilePath
getBinaryViaNixDerivation NixPackageName
derivation =
  EnvironmentFile Any -> FilePath
forall {k} (a :: k). EnvironmentFile a -> FilePath
unEnvironmentFile (EnvironmentFile Any -> FilePath)
-> m (EnvironmentFile Any) -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixPackageName -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m, MonadMask m) =>
NixPackageName -> m FilePath
buildNixCallPackageDerivation NixPackageName
derivation m FilePath
-> (FilePath -> m (EnvironmentFile Any)) -> m (EnvironmentFile Any)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> m (EnvironmentFile Any)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)))

-- | Lower-level version of 'getBinaryViaNixDerivation'.
getBinaryViaNixDerivation' :: forall a context m. (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLoggerIO m, MonadMask m, KnownSymbol a
  )
  -- | Nix context.
  => NixContext
  -- | Nix derivation as a string.
  -> Text
  -> m FilePath
getBinaryViaNixDerivation' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLoggerIO m,
 MonadMask m, KnownSymbol a) =>
NixContext -> NixPackageName -> m FilePath
getBinaryViaNixDerivation' NixContext
nc NixPackageName
derivation =
  EnvironmentFile Any -> FilePath
forall {k} (a :: k). EnvironmentFile a -> FilePath
unEnvironmentFile (EnvironmentFile Any -> FilePath)
-> m (EnvironmentFile Any) -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixContext -> NixPackageName -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m,
 MonadMask m) =>
NixContext -> NixPackageName -> m FilePath
buildNixCallPackageDerivation' NixContext
nc NixPackageName
derivation m FilePath
-> (FilePath -> m (EnvironmentFile Any)) -> m (EnvironmentFile Any)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> m (EnvironmentFile Any)
forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)))

-- | 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, MonadMask m, KnownSymbol a
  ) =>
    -- | Nix derivation as a string.
    Text
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceFileViaNixDerivation :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NixPackageName
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixDerivation NixPackageName
derivation = forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixDerivation' @a NixPackageName
derivation (FilePath -> FilePath -> IO FilePath
defaultFindFile (Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)))

-- | Same as 'introduceFileViaNixDerivation', but allows configuring the file finding callback.
introduceFileViaNixDerivation' :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, MonadMask m, KnownSymbol a
  ) =>
    -- | Nix derivation as a string.
    Text
    -- | Callback to find the desired file.
    -> (FilePath -> IO FilePath)
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceFileViaNixDerivation' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixDerivation' = NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixDerivation'' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceFileViaNixDerivation'', but allows passing custom 'NodeOptions'.
introduceFileViaNixDerivation'' :: forall a context m. (
  HasBaseContext context, HasNixContext context, MonadUnliftIO m, MonadMask m, KnownSymbol a
  ) => NodeOptions
    -- | Nix derivation as a string.
    -> Text
    -- | Callback to find the desired file.
    -> (FilePath -> IO FilePath)
    -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m ()
    -> SpecFree context m ()
introduceFileViaNixDerivation'' :: forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 MonadMask m, KnownSymbol a) =>
NodeOptions
-> NixPackageName
-> (FilePath -> IO FilePath)
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFileViaNixDerivation'' NodeOptions
nodeOptions NixPackageName
derivation FilePath -> IO FilePath
tryFindFile = NodeOptions
-> FilePath
-> Label (AppendSymbol "file-" a) (EnvironmentFile a)
-> ExampleT context m (EnvironmentFile a)
-> (HasCallStack => EnvironmentFile a -> ExampleT context m ())
-> Free
     (SpecCommand
        (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
         :> context)
        m)
     ()
-> Free (SpecCommand context m) ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> FilePath
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions [i|#{binaryName} (file via Nix derivation)|] (forall (a :: Symbol).
Label (AppendSymbol "file-" a) (EnvironmentFile a)
mkFileLabel @a) ExampleT context m (EnvironmentFile a)
alloc (ExampleT context m () -> EnvironmentFile a -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m ()
 -> EnvironmentFile a -> ExampleT context m ())
-> ExampleT context m ()
-> EnvironmentFile a
-> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    binaryName :: String
    binaryName :: FilePath
binaryName = Proxy a -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)

    alloc :: ExampleT context m (EnvironmentFile a)
alloc = FilePath -> EnvironmentFile a
forall {k} (a :: k). FilePath -> EnvironmentFile a
EnvironmentFile (FilePath -> EnvironmentFile a)
-> ExampleT context m FilePath
-> ExampleT context m (EnvironmentFile a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixPackageName -> ExampleT context m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m, MonadMask m) =>
NixPackageName -> m FilePath
buildNixCallPackageDerivation NixPackageName
derivation ExampleT context m FilePath
-> (FilePath -> ExampleT context m FilePath)
-> ExampleT context m FilePath
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath -> ExampleT context m FilePath
forall a. IO a -> ExampleT context m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExampleT context m FilePath)
-> (FilePath -> IO FilePath)
-> FilePath
-> ExampleT context m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
tryFindFile)

-- | Lower-level version of 'introduceFileViaNixDerivation'.
getFileViaNixDerivation :: forall context m. (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLoggerIO m, MonadMask m
  ) =>
    -- | Nix derivation as a string.
    Text
    -- | Callback to find the desired file.
    -> (FilePath -> IO FilePath)
    -> m FilePath
getFileViaNixDerivation :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLoggerIO m, MonadMask m) =>
NixPackageName -> (FilePath -> IO FilePath) -> m FilePath
getFileViaNixDerivation NixPackageName
derivation FilePath -> IO FilePath
tryFindFile = NixPackageName -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m, MonadMask m) =>
NixPackageName -> m FilePath
buildNixCallPackageDerivation NixPackageName
derivation m FilePath -> (FilePath -> m FilePath) -> m FilePath
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
tryFindFile


tryFindBinary :: (MonadIO m) => String -> FilePath -> m (EnvironmentFile a)
tryFindBinary :: forall {k} (m :: * -> *) (a :: k).
MonadIO m =>
FilePath -> FilePath -> m (EnvironmentFile a)
tryFindBinary FilePath
binaryName FilePath
env = do
  [FilePath] -> FilePath -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
[FilePath] -> FilePath -> m [FilePath]
findExecutablesInDirectories [FilePath
env FilePath -> FilePath -> FilePath
</> FilePath
"bin"] FilePath
binaryName m [FilePath]
-> ([FilePath] -> m (EnvironmentFile a)) -> m (EnvironmentFile a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FilePath
x:[FilePath]
_) -> EnvironmentFile a -> m (EnvironmentFile a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnvironmentFile a -> m (EnvironmentFile a))
-> EnvironmentFile a -> m (EnvironmentFile a)
forall a b. (a -> b) -> a -> b
$ FilePath -> EnvironmentFile a
forall {k} (a :: k). FilePath -> EnvironmentFile a
EnvironmentFile FilePath
x
    [FilePath]
_ -> FilePath -> m (EnvironmentFile a)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
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 :: FilePath -> FilePath -> IO FilePath
defaultFindFile FilePath
name = (FilePath -> IO Bool) -> FilePath -> IO FilePath
findFirstFile (\FilePath
x -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
takeFileName FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name))

-- | 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 :: (FilePath -> IO Bool) -> FilePath -> IO FilePath
findFirstFile FilePath -> IO Bool
predicate FilePath
dir = ExceptT FilePath IO () -> IO (Either FilePath ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (FilePath -> ExceptT FilePath IO ()
go FilePath
dir) IO (Either FilePath ())
-> (Either FilePath () -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left FilePath
x -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
  Right () -> FilePath -> IO FilePath
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure [i|Couldn't find file in '#{dir}'|]
  where
    go :: FilePath -> ExceptT FilePath IO ()
    go :: FilePath -> ExceptT FilePath IO ()
go FilePath
currentDir = do
      [FilePath]
contents <- IO [FilePath] -> ExceptT FilePath IO [FilePath]
forall a. IO a -> ExceptT FilePath IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> ExceptT FilePath IO [FilePath])
-> IO [FilePath] -> ExceptT FilePath IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory FilePath
currentDir
      [FilePath]
-> (FilePath -> ExceptT FilePath IO ()) -> ExceptT FilePath IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents ((FilePath -> ExceptT FilePath IO ()) -> ExceptT FilePath IO ())
-> (FilePath -> ExceptT FilePath IO ()) -> ExceptT FilePath IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
        let path :: FilePath
path = FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
name
        FilePath -> ExceptT FilePath IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
path ExceptT FilePath IO Bool
-> (Bool -> ExceptT FilePath IO ()) -> ExceptT FilePath IO ()
forall a b.
ExceptT FilePath IO a
-> (a -> ExceptT FilePath IO b) -> ExceptT FilePath IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> FilePath -> ExceptT FilePath IO ()
go FilePath
path
          Bool
False -> ExceptT FilePath IO Bool
-> ExceptT FilePath IO () -> ExceptT FilePath IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> ExceptT FilePath IO Bool
forall a. IO a -> ExceptT FilePath IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT FilePath IO Bool)
-> IO Bool -> ExceptT FilePath IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
predicate FilePath
path) (FilePath -> ExceptT FilePath IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE FilePath
path)