{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

{-|

This module contains tools for working with Nix, in order to provide Nix-built artifacts to tests.

The Nix package set (Nixpkgs) is one of the largest package sets in the world, and can be a great way to get artifacts reproducibly. All you need is a @nix@ binary available on the PATH.

For example, the following will build a Nix environment based on Nixpkgs release 24.05, containing Emacs and Firefox.

@
introduceNixContext nixpkgsRelease2405 $
  introduceNixEnvironment ["emacs", "firefox"] $ do
    it "uses the environment" $ do
      envPath <- getContext nixEnvironment

      emacsVersion <- readCreateProcess (proc (envPath <\/\> "bin" <\/\> "emacs") ["--version"]) ""
      info [i|Emacs version: #{emacsVersion}|]

      firefoxVersion <- readCreateProcess (proc (envPath <\/\> "bin" <\/\> "firefox") ["--version"]) ""
      info [i|Firefox version: #{firefoxVersion}|]
@

-}

module Test.Sandwich.Contexts.Nix (
  -- * Nix contexts
  introduceNixContext
  , introduceNixContext'
  , introduceNixContext''
  , makeNixContext
  , makeNixContext'

  -- * Nix environments
  , introduceNixEnvironment
  , introduceNixEnvironment'
  , buildNixPackage
  , buildNixPackage'
  , buildNixSymlinkJoin
  , buildNixSymlinkJoin'
  , buildNixExpression
  , buildNixExpression'
  , buildNixCallPackageDerivation
  , buildNixCallPackageDerivation'

  -- * Nixpkgs releases #releases#
  , nixpkgsReleaseDefault
  , nixpkgsMaster
  , nixpkgsRelease2505
  , nixpkgsRelease2411
  , nixpkgsRelease2405
  , nixpkgsRelease2311

  -- * Types
  , nixContext
  , NixContext(..)
  , HasNixContext

  , nixEnvironment
  , HasNixEnvironment

  , NixpkgsDerivation(..)

  , defaultFileContextVisibilityThreshold
  ) where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Data.Aeson as A
import qualified Data.Map as M
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import Relude
import System.FilePath
import System.IO.Temp (createTempDirectory)
import Test.Sandwich
import Test.Sandwich.Contexts.Files.Types
import Test.Sandwich.Contexts.Util.Aeson
import qualified Text.Show
import UnliftIO.Async
import UnliftIO.Directory
import UnliftIO.Environment
import UnliftIO.MVar (modifyMVar)
import UnliftIO.Process
import UnliftIO.Temporary

-- * Types

nixContext :: Label "nixContext" NixContext
nixContext :: Label "nixContext" NixContext
nixContext = Label "nixContext" NixContext
forall {k} (l :: Symbol) (a :: k). Label l a
Label

data NixContext = NixContext {
  NixContext -> FilePath
nixContextNixBinary :: FilePath
  , NixContext -> NixpkgsDerivation
nixContextNixpkgsDerivation :: NixpkgsDerivation
  , NixContext -> MVar (Map Text (Async FilePath))
nixContextBuildCache :: MVar (Map Text (Async FilePath))
  }
instance Show NixContext where
  show :: NixContext -> FilePath
show (NixContext {}) = FilePath
"<NixContext>"

type HasNixContext context = HasLabel context "nixContext" NixContext

nixEnvironment :: Label "nixEnvironment" FilePath
nixEnvironment :: Label "nixEnvironment" FilePath
nixEnvironment = Label "nixEnvironment" FilePath
forall {k} (l :: Symbol) (a :: k). Label l a
Label

type HasNixEnvironment context = HasLabel context "nixEnvironment" FilePath

defaultFileContextVisibilityThreshold :: Int
defaultFileContextVisibilityThreshold :: Int
defaultFileContextVisibilityThreshold = Int
150

data NixpkgsDerivation =
  NixpkgsDerivationFetchFromGitHub {
    NixpkgsDerivation -> Text
nixpkgsDerivationOwner :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationRev :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: Text

    -- | Set the environment variable NIXPKGS_ALLOW_UNFREE=1 when building with this derivation.
    -- Useful when you want to use packages with unfree licenses, like @google-chrome@.
    , NixpkgsDerivation -> Bool
nixpkgsDerivationAllowUnfree :: Bool
    } deriving (Int -> NixpkgsDerivation -> ShowS
[NixpkgsDerivation] -> ShowS
NixpkgsDerivation -> FilePath
(Int -> NixpkgsDerivation -> ShowS)
-> (NixpkgsDerivation -> FilePath)
-> ([NixpkgsDerivation] -> ShowS)
-> Show NixpkgsDerivation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixpkgsDerivation -> ShowS
showsPrec :: Int -> NixpkgsDerivation -> ShowS
$cshow :: NixpkgsDerivation -> FilePath
show :: NixpkgsDerivation -> FilePath
$cshowList :: [NixpkgsDerivation] -> ShowS
showList :: [NixpkgsDerivation] -> ShowS
Show, NixpkgsDerivation -> NixpkgsDerivation -> Bool
(NixpkgsDerivation -> NixpkgsDerivation -> Bool)
-> (NixpkgsDerivation -> NixpkgsDerivation -> Bool)
-> Eq NixpkgsDerivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
== :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
$c/= :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
/= :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
Eq)

-- | Nixpkgs master, accessed 6\/6\/2025.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev master
nixpkgsMaster :: NixpkgsDerivation
nixpkgsMaster :: NixpkgsDerivation
nixpkgsMaster = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"067a39e41a125985e061199452c900b0305f4c42"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-N57WqGFUUDJ7QVR4YPRttp4YuTA4oN/KdXHY4OEXGFk="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Nixpkgs release 25.05, accessed 6\/6\/2025.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-25.05
nixpkgsRelease2505 :: NixpkgsDerivation
nixpkgsRelease2505 :: NixpkgsDerivation
nixpkgsRelease2505 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"8217c6edf391991f07ecacf3d31ba6eb01d733b1"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-aaeXPG9zVvi+aKTp0dMUYOeMuhDXQejRPh2CfK23nf8="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Nixpkgs release 24.11, accessed 6\/6\/2025.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-24.11
nixpkgsRelease2411 :: NixpkgsDerivation
nixpkgsRelease2411 :: NixpkgsDerivation
nixpkgsRelease2411 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"5908ad2494520214a309e74d5c3f33623a593ecd"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-0q80SLtfhrtZAzLGpwAQjqaTE+HAwmOjoX4Q3M5mB/s="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Nixpkgs release 24.05, accessed 11\/9\/2024.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-24.05
nixpkgsRelease2405 :: NixpkgsDerivation
nixpkgsRelease2405 :: NixpkgsDerivation
nixpkgsRelease2405 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"bb824c634c812feede9d398c000526401028c0e7"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-xYnWv9kyJyF8rEZ1uJaSek2fmaIowkk/ovE6+MwcP2E="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Nixpkgs release 23.11, accessed 2\/19\/2023.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-23.11
nixpkgsRelease2311 :: NixpkgsDerivation
nixpkgsRelease2311 :: NixpkgsDerivation
nixpkgsRelease2311 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"cc86e0769882886f7831de9c9373b62ea2c06e3f"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-1eAZINWjTTA8nWJiN979JVSwvCYzUWnMpzMHGUCLgZk="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Currently set to 'nixpkgsRelease2405'.
nixpkgsReleaseDefault :: NixpkgsDerivation
nixpkgsReleaseDefault :: NixpkgsDerivation
nixpkgsReleaseDefault = NixpkgsDerivation
nixpkgsRelease2405

-- | Introduce a 'NixContext', which contains information about where to find Nix and what
-- version of Nixpkgs to use. This can be leveraged to introduce Nix packages in tests.
--
-- The 'NixContext' contains a build cache, so if you build a given derivation more than
-- once in your tests under this node, runs after the first one will be fast.
--
-- This function requires a @nix@ binary to be in the PATH and will throw an exception if it
-- isn't found.
introduceNixContext :: (
  MonadUnliftIO m, MonadThrow m
  )
  -- | Nixpkgs derivation to use
  => NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext = NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceNixContext', but allows passing custom 'NodeOptions'.
introduceNixContext' :: (
  MonadUnliftIO m, MonadThrow m
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | Nixpkgs derivation to use
  -> NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext' :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext' NodeOptions
nodeOptions NixpkgsDerivation
nixpkgsDerivation = NodeOptions
-> FilePath
-> Label "nixContext" NixContext
-> ExampleT context m NixContext
-> (HasCallStack => NixContext -> ExampleT context m ())
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree 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 FilePath
"Introduce Nix context" Label "nixContext" NixContext
nixContext (NixpkgsDerivation -> ExampleT context m NixContext
forall (m :: * -> *).
MonadIO m =>
NixpkgsDerivation -> m NixContext
makeNixContext NixpkgsDerivation
nixpkgsDerivation) (ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> NixContext -> ExampleT context m ())
-> ExampleT context m () -> NixContext -> 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 ())

-- | Same as 'introduceNixContext'', but allows specifying the Nix binary via 'HasFile'.
introduceNixContext'' :: (
  MonadUnliftIO m
  , MonadThrow m
  , HasFile context "nix"
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | Nixpkgs derivation to use
  -> NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext'' :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m, HasFile context "nix") =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext'' NodeOptions
nodeOptions NixpkgsDerivation
nixpkgsDerivation = NodeOptions
-> FilePath
-> Label "nixContext" NixContext
-> ExampleT context m NixContext
-> (HasCallStack => NixContext -> ExampleT context m ())
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree 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 FilePath
"Introduce Nix context" Label "nixContext" NixContext
nixContext (NixpkgsDerivation -> ExampleT context m NixContext
forall (m :: * -> *) ctx.
(MonadIO m, MonadReader ctx m, HasFile ctx "nix") =>
NixpkgsDerivation -> m NixContext
makeNixContext' NixpkgsDerivation
nixpkgsDerivation) (ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> NixContext -> ExampleT context m ())
-> ExampleT context m () -> NixContext -> 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 ())

-- | Build a 'NixContext' directly. Throws an exception if the @nix@ binary is not found.
makeNixContext :: (MonadIO m) => NixpkgsDerivation -> m NixContext
makeNixContext :: forall (m :: * -> *).
MonadIO m =>
NixpkgsDerivation -> m NixContext
makeNixContext NixpkgsDerivation
nixpkgsDerivation = FilePath -> m (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findExecutable FilePath
"nix" m (Maybe FilePath)
-> (Maybe FilePath -> m NixContext) -> m NixContext
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe FilePath
Nothing -> FilePath -> m NixContext
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure [i|Couldn't find "nix" binary when introducing Nix context. A Nix binary and store must already be available in the environment.|]
  Just FilePath
p -> do
    -- TODO: make sure the Nixpkgs derivation works
    MVar (Map Text (Async FilePath))
buildCache <- Map Text (Async FilePath) -> m (MVar (Map Text (Async FilePath)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map Text (Async FilePath)
forall a. Monoid a => a
mempty
    NixContext -> m NixContext
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
-> NixpkgsDerivation
-> MVar (Map Text (Async FilePath))
-> NixContext
NixContext FilePath
p NixpkgsDerivation
nixpkgsDerivation MVar (Map Text (Async FilePath))
buildCache)

-- | Build a 'NixContext' directly, specifying the Nix binary via 'HasFile'.
makeNixContext' :: (MonadIO m, MonadReader ctx m, HasFile ctx "nix") => NixpkgsDerivation -> m NixContext
makeNixContext' :: forall (m :: * -> *) ctx.
(MonadIO m, MonadReader ctx m, HasFile ctx "nix") =>
NixpkgsDerivation -> m NixContext
makeNixContext' NixpkgsDerivation
nixpkgsDerivation = do
  FilePath
nix <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m FilePath
askFile @"nix"
  MVar (Map Text (Async FilePath))
buildCache <- Map Text (Async FilePath) -> m (MVar (Map Text (Async FilePath)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map Text (Async FilePath)
forall a. Monoid a => a
mempty
  NixContext -> m NixContext
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
-> NixpkgsDerivation
-> MVar (Map Text (Async FilePath))
-> NixContext
NixContext FilePath
nix NixpkgsDerivation
nixpkgsDerivation MVar (Map Text (Async FilePath))
buildCache)

-- | Introduce a Nix environment containing the given list of packages, using the current 'NixContext'.
-- These packages are mashed together using the Nix @symlinkJoin@ function. Their binaries will generally
-- be found in @\<environment path\>\/bin@.
introduceNixEnvironment :: (
  HasBaseContext context, HasNixContext context
  , MonadUnliftIO m
  )
  -- | List of package names to include in the Nix environment
  => [Text]
  -> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
  -> SpecFree context m ()
introduceNixEnvironment :: forall context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m) =>
[Text]
-> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment = NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
-> SpecFree context m ()
forall context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m) =>
NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceNixEnvironment', but allows passing custom 'NodeOptions'.
introduceNixEnvironment' :: (
  HasBaseContext context, HasNixContext context
  , MonadUnliftIO m
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | List of package names to include in the Nix environment
  -> [Text]
  -> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
  -> SpecFree context m ()
introduceNixEnvironment' :: forall context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m) =>
NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment' NodeOptions
nodeOptions [Text]
packageNames = NodeOptions
-> FilePath
-> Label "nixEnvironment" FilePath
-> ExampleT context m FilePath
-> (HasCallStack => FilePath -> ExampleT context m ())
-> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
-> SpecFree 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 FilePath
"Introduce Nix environment" Label "nixEnvironment" FilePath
nixEnvironment ([Text] -> ExampleT context m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[Text] -> m FilePath
buildNixSymlinkJoin [Text]
packageNames) (ExampleT context m () -> FilePath -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> FilePath -> ExampleT context m ())
-> ExampleT context m () -> FilePath -> 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 ())

-- | Build a single Nix package name from Nixpkgs
buildNixPackage :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Package name.
  => Text
  -> m FilePath
buildNixPackage :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m FilePath
buildNixPackage Text
packageName = do
  NixContext
nc <- Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext
  NixContext -> Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixPackage' NixContext
nc Text
packageName

-- | Lower-level version of 'buildNixCallPackageDerivation'
buildNixPackage' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix context.
  => NixContext
  -- | Package name.
  -> Text
  -> m FilePath
buildNixPackage' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixPackage' NixContext
nc Text
packageName = NixContext -> Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixCallPackageDerivation' NixContext
nc Text
expr
  where
    expr :: Text
expr = [i|{ pkgs }: pkgs."#{packageName}"|]

-- | Build a Nix environment, as in 'introduceNixEnvironment'.
buildNixSymlinkJoin :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Package names
  => [Text] -> m FilePath
buildNixSymlinkJoin :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[Text] -> m FilePath
buildNixSymlinkJoin [Text]
packageNames = do
  NixContext {FilePath
MVar (Map Text (Async FilePath))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> FilePath
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async FilePath))
nixContextNixBinary :: FilePath
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async FilePath))
..} <- Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext
  Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m FilePath
buildNixExpression (Text -> m FilePath) -> Text -> m FilePath
forall a b. (a -> b) -> a -> b
$ NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin NixpkgsDerivation
nixContextNixpkgsDerivation [Text]
packageNames

-- | Lower-level version of 'buildNixSymlinkJoin'.
buildNixSymlinkJoin' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix context
  => NixContext
  -- | Package names
  -> [Text]
  -> m FilePath
buildNixSymlinkJoin' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> [Text] -> m FilePath
buildNixSymlinkJoin' nc :: NixContext
nc@(NixContext {FilePath
MVar (Map Text (Async FilePath))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> FilePath
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async FilePath))
nixContextNixBinary :: FilePath
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async FilePath))
..}) [Text]
packageNames = do
  NixContext -> Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixExpression' NixContext
nc (Text -> m FilePath) -> Text -> m FilePath
forall a b. (a -> b) -> a -> b
$ NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin NixpkgsDerivation
nixContextNixpkgsDerivation [Text]
packageNames

-- | Build a Nix environment expressed as a derivation expecting a list of dependencies, as in the
-- Nix "callPackage" design pattern. I.e.
-- "{ git, gcc, stdenv, ... }: stdenv.mkDerivation {...}"
buildNixCallPackageDerivation :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix derivation
  => Text
  -> m FilePath
buildNixCallPackageDerivation :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m FilePath
buildNixCallPackageDerivation Text
derivation = do
  NixContext
nc <- Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext
  NixContext -> Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixCallPackageDerivation' NixContext
nc Text
derivation

-- | Lower-level version of 'buildNixCallPackageDerivation'
buildNixCallPackageDerivation' :: forall context m. (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix context.
  => NixContext
  -- | Nix derivation.
  -> Text
  -> m FilePath
buildNixCallPackageDerivation' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixCallPackageDerivation' nc :: NixContext
nc@(NixContext {FilePath
MVar (Map Text (Async FilePath))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> FilePath
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async FilePath))
nixContextNixBinary :: FilePath
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async FilePath))
..}) Text
derivation = do
  Async FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait (Async FilePath -> m FilePath) -> m (Async FilePath) -> m FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar (Map Text (Async FilePath))
-> (Map Text (Async FilePath)
    -> m (Map Text (Async FilePath), Async FilePath))
-> m (Async FilePath)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Text (Async FilePath))
nixContextBuildCache (\Map Text (Async FilePath)
m ->
    case Text -> Map Text (Async FilePath) -> Maybe (Async FilePath)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
derivation Map Text (Async FilePath)
m of
      Just Async FilePath
x -> (Map Text (Async FilePath), Async FilePath)
-> m (Map Text (Async FilePath), Async FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Async FilePath)
m, Async FilePath
x)
      Maybe (Async FilePath)
Nothing -> do
        Async FilePath
asy <- m FilePath -> m (Async FilePath)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m FilePath -> m (Async FilePath))
-> m FilePath -> m (Async FilePath)
forall a b. (a -> b) -> a -> b
$ do
          Maybe FilePath
maybeNixExpressionDir <- m (Maybe FilePath)
forall context (m :: * -> *).
HasBaseContextMonad context m =>
m (Maybe FilePath)
getCurrentFolder m (Maybe FilePath)
-> (Maybe FilePath -> m (Maybe FilePath)) -> m (Maybe FilePath)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FilePath
dir -> (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m FilePath -> m (Maybe FilePath))
-> m FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> 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) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO FilePath
createTempDirectory FilePath
dir FilePath
"nix-expression"
            Maybe FilePath
Nothing -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

          Maybe FilePath -> (FilePath -> m FilePath) -> m FilePath
forall a. Maybe FilePath -> (FilePath -> m a) -> m a
withDerivationPath Maybe FilePath
maybeNixExpressionDir ((FilePath -> m FilePath) -> m FilePath)
-> (FilePath -> m FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
derivationPath -> do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
derivationPath Text
derivation
            NixContext -> Text -> Maybe FilePath -> m FilePath
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe FilePath -> m FilePath
runNixBuild' NixContext
nc (NixpkgsDerivation -> FilePath -> Text
renderCallPackageDerivation NixpkgsDerivation
nixContextNixpkgsDerivation FilePath
derivationPath) ((FilePath -> ShowS
</> FilePath
"gcroot") ShowS -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
maybeNixExpressionDir)

        (Map Text (Async FilePath), Async FilePath)
-> m (Map Text (Async FilePath), Async FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> Async FilePath
-> Map Text (Async FilePath)
-> Map Text (Async FilePath)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
derivation Async FilePath
asy Map Text (Async FilePath)
m, Async FilePath
asy)
    )
  where
    withDerivationPath :: Maybe FilePath -> (FilePath -> m a) -> m a
    withDerivationPath :: forall a. Maybe FilePath -> (FilePath -> m a) -> m a
withDerivationPath (Just FilePath
nixExpressionDir) FilePath -> m a
action = FilePath -> m a
action (FilePath
nixExpressionDir FilePath -> ShowS
</> FilePath
"default.nix")
    withDerivationPath Maybe FilePath
Nothing FilePath -> m a
action = FilePath -> (FilePath -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"nix-expression" ((FilePath -> m a) -> m a) -> (FilePath -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> FilePath -> m a
action (FilePath
dir FilePath -> ShowS
</> FilePath
"default.nix")


-- | Build a Nix environment containing the given list of packages, using the current 'NixContext'.
-- These packages are mashed together using the Nix "symlinkJoin" function. Their binaries will generally
-- be found in "\<environment path\>\/bin".
buildNixExpression :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix expression
  => Text -> m FilePath
buildNixExpression :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m FilePath
buildNixExpression Text
expr = Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext m NixContext -> (NixContext -> 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
>>= (NixContext -> Text -> m FilePath
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
`buildNixExpression'` Text
expr)

-- | Lower-level version of 'buildNixExpression'.
buildNixExpression' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix expression
  => NixContext -> Text -> m FilePath
buildNixExpression' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m FilePath
buildNixExpression' nc :: NixContext
nc@(NixContext {FilePath
MVar (Map Text (Async FilePath))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> FilePath
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async FilePath))
nixContextNixBinary :: FilePath
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async FilePath))
..}) Text
expr = do
  Async FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait (Async FilePath -> m FilePath) -> m (Async FilePath) -> m FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar (Map Text (Async FilePath))
-> (Map Text (Async FilePath)
    -> m (Map Text (Async FilePath), Async FilePath))
-> m (Async FilePath)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Text (Async FilePath))
nixContextBuildCache (\Map Text (Async FilePath)
m ->
    case Text -> Map Text (Async FilePath) -> Maybe (Async FilePath)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
expr Map Text (Async FilePath)
m of
      Just Async FilePath
x -> (Map Text (Async FilePath), Async FilePath)
-> m (Map Text (Async FilePath), Async FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Async FilePath)
m, Async FilePath
x)
      Maybe (Async FilePath)
Nothing -> do
        Async FilePath
asy <- m FilePath -> m (Async FilePath)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m FilePath -> m (Async FilePath))
-> m FilePath -> m (Async FilePath)
forall a b. (a -> b) -> a -> b
$ do
          Maybe FilePath
maybeNixExpressionDir <- m (Maybe FilePath)
forall context (m :: * -> *).
HasBaseContextMonad context m =>
m (Maybe FilePath)
getCurrentFolder m (Maybe FilePath)
-> (Maybe FilePath -> m (Maybe FilePath)) -> m (Maybe FilePath)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FilePath
dir -> (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m FilePath -> m (Maybe FilePath))
-> m FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> 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) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO FilePath
createTempDirectory FilePath
dir FilePath
"nix-expression"
            Maybe FilePath
Nothing -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
          NixContext -> Text -> Maybe FilePath -> m FilePath
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe FilePath -> m FilePath
runNixBuild' NixContext
nc Text
expr ((FilePath -> ShowS
</> FilePath
"gcroot") ShowS -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
maybeNixExpressionDir)

        (Map Text (Async FilePath), Async FilePath)
-> m (Map Text (Async FilePath), Async FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> Async FilePath
-> Map Text (Async FilePath)
-> Map Text (Async FilePath)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
expr Async FilePath
asy Map Text (Async FilePath)
m, Async FilePath
asy)
    )

-- runNixBuild :: (MonadUnliftIO m, MonadLogger m, MonadReader context m, HasNixContext context) => Text -> String -> m String
-- runNixBuild expr outputPath = do
--   nc <- getContext nixContext
--   runNixBuild' nc expr outputPath

runNixBuild' :: (MonadUnliftIO m, MonadLogger m) => NixContext -> Text -> Maybe String -> m String
runNixBuild' :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe FilePath -> m FilePath
runNixBuild' (NixContext {NixpkgsDerivation
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextNixpkgsDerivation}) Text
expr Maybe FilePath
maybeOutputPath = do
  Maybe [(FilePath, FilePath)]
maybeEnv <- case NixpkgsDerivation -> Bool
nixpkgsDerivationAllowUnfree NixpkgsDerivation
nixContextNixpkgsDerivation of
    Bool
False -> Maybe [(FilePath, FilePath)] -> m (Maybe [(FilePath, FilePath)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    Bool
True -> do
      [(FilePath, FilePath)]
env <- m [(FilePath, FilePath)]
forall (m :: * -> *). MonadIO m => m [(FilePath, FilePath)]
getEnvironment
      Maybe [(FilePath, FilePath)] -> m (Maybe [(FilePath, FilePath)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(FilePath, FilePath)] -> m (Maybe [(FilePath, FilePath)]))
-> Maybe [(FilePath, FilePath)] -> m (Maybe [(FilePath, FilePath)])
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just ((FilePath
"NIXPKGS_ALLOW_UNFREE", FilePath
"1") (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
env)

  -- TODO: switch this to using nix-build so we can avoid the "--impure" flag?
  FilePath
output <- CreateProcess -> FilePath -> m FilePath
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> FilePath -> m FilePath
readCreateProcessWithLogging (
    (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"nix" ([FilePath
"build"
                 , FilePath
"--impure"
                 , FilePath
"--extra-experimental-features", FilePath
"nix-command"
                 , FilePath
"--expr", Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
expr
                 , FilePath
"--json"
                 ] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (case Maybe FilePath
maybeOutputPath of Maybe FilePath
Nothing -> [FilePath
"--no-link"]; Just FilePath
p -> [FilePath
"-o", FilePath
p])
                )) { env = maybeEnv }
    ) FilePath
""

  case ByteString -> Either FilePath Value
forall a. FromJSON a => ByteString -> Either FilePath a
A.eitherDecodeStrict (FilePath -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 FilePath
output) of
    Right (A.Array (Array -> [Value]
forall a. Vector a -> [a]
V.toList -> ((A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"outputs" -> Just (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"out" -> Just (A.String Text
p))))):[Value]
_))) -> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
p)
    Right (A.Array (Array -> [Value]
forall a. Vector a -> [a]
V.toList -> ((A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"outputs" -> Just (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"bin" -> Just (A.String Text
p))))):[Value]
_))) -> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
p)
    Either FilePath Value
x -> FilePath -> m FilePath
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure [i|Couldn't parse Nix build JSON output: #{x} (output was #{A.encode output})|]

renderNixSymlinkJoin :: NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin :: NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin (NixpkgsDerivationFetchFromGitHub {Bool
Text
nixpkgsDerivationOwner :: NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: NixpkgsDerivation -> Text
nixpkgsDerivationRev :: NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: NixpkgsDerivation -> Text
nixpkgsDerivationAllowUnfree :: NixpkgsDerivation -> Bool
nixpkgsDerivationOwner :: Text
nixpkgsDerivationRepo :: Text
nixpkgsDerivationRev :: Text
nixpkgsDerivationSha256 :: Text
nixpkgsDerivationAllowUnfree :: Bool
..}) [Text]
packageNames = [i|
\# Use the ambient <nixpkgs> channel to bootstrap
with {
  inherit (import (<nixpkgs>) {})
  fetchgit fetchFromGitHub;
};

let
  nixpkgs = fetchFromGitHub {
    owner = "#{nixpkgsDerivationOwner}";
    repo = "#{nixpkgsDerivationRepo}";
    rev = "#{nixpkgsDerivationRev}";
    sha256 = "#{nixpkgsDerivationSha256}";
  };

  pkgs = import nixpkgs {};
in

pkgs.symlinkJoin { name = "test-contexts-environment"; paths = with pkgs; [#{T.intercalate " " packageNames}]; }
|]

renderDerivationWithPkgs :: NixpkgsDerivation -> Text -> Text
renderDerivationWithPkgs :: NixpkgsDerivation -> Text -> Text
renderDerivationWithPkgs (NixpkgsDerivationFetchFromGitHub {Bool
Text
nixpkgsDerivationOwner :: NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: NixpkgsDerivation -> Text
nixpkgsDerivationRev :: NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: NixpkgsDerivation -> Text
nixpkgsDerivationAllowUnfree :: NixpkgsDerivation -> Bool
nixpkgsDerivationOwner :: Text
nixpkgsDerivationRepo :: Text
nixpkgsDerivationRev :: Text
nixpkgsDerivationSha256 :: Text
nixpkgsDerivationAllowUnfree :: Bool
..}) Text
expr = [i|
\# Use the ambient <nixpkgs> channel to bootstrap
with {
  inherit (import (<nixpkgs>) {})
  fetchgit fetchFromGitHub;
};

let
  nixpkgs = fetchFromGitHub {
    owner = "#{nixpkgsDerivationOwner}";
    repo = "#{nixpkgsDerivationRepo}";
    rev = "#{nixpkgsDerivationRev}";
    sha256 = "#{nixpkgsDerivationSha256}";
  };

  pkgs = import nixpkgs {};
in

#{expr}
|]

renderCallPackageDerivation :: NixpkgsDerivation -> FilePath -> Text
renderCallPackageDerivation :: NixpkgsDerivation -> FilePath -> Text
renderCallPackageDerivation NixpkgsDerivation
nixpkgsDerivation FilePath
derivationPath =
  NixpkgsDerivation -> Text -> Text
renderDerivationWithPkgs NixpkgsDerivation
nixpkgsDerivation Text
expr
  where
    expr :: Text
expr = [i|pkgs.callPackage #{show derivationPath :: String} {}|]