{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Bindings.Cli.Nix
  ( Arg (..)
  , NixBuildConfig (..)
  , nixBuildConfig_common
  , nixBuildConfig_outLink
  , NixCmd (..)
  , nixCmdConfig_args
  , nixCmdConfig_builders
  , nixCmdConfig_target
  , NixCommonConfig (..)
  , NixInstantiateConfig (..)
  , nixInstantiateConfig_eval
  , NixShellConfig (..)
  , nixShellConfig_common
  , nixShellConfig_pure
  , nixShellConfig_run
  , OutLink (..)
  , Target (..)
  , target_attr
  , target_expr
  , target_path

  , boolArg
  , nixCmd
  , nixCmdProc
  , nixCmdProc'
  , rawArg
  , runNixShellConfig
  , strArg

  , nixPrefetchGitPath
  , nixPrefetchUrlPath
  ) where

import Control.Lens
import Control.Monad (guard)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Except (MonadError)
import Control.Monad.Fail
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Log (MonadLog)

import Data.Bool (bool)
import Data.Default
import Data.List (intercalate)
import Data.Maybe
import Data.Monoid ((<>))
import qualified Data.Text as T

import System.Which (staticWhich)

import Cli.Extras

-- | What to build
data Target = Target
  { Target -> Maybe FilePath
_target_path :: Maybe FilePath
  , Target -> Maybe FilePath
_target_attr :: Maybe String
  , Target -> Maybe FilePath
_target_expr :: Maybe String
  }
makeClassy ''Target

instance Default Target where
  def :: Target
def = Target :: Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> Target
Target
    { _target_path :: Maybe FilePath
_target_path = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "."
    , _target_attr :: Maybe FilePath
_target_attr = Maybe FilePath
forall a. Maybe a
Nothing
    , _target_expr :: Maybe FilePath
_target_expr = Maybe FilePath
forall a. Maybe a
Nothing
    }

data Arg
  = Arg_Str String String
  | Arg_Expr String String
  deriving (Arg -> Arg -> Bool
(Arg -> Arg -> Bool) -> (Arg -> Arg -> Bool) -> Eq Arg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c== :: Arg -> Arg -> Bool
Eq, Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> FilePath
(Int -> Arg -> ShowS)
-> (Arg -> FilePath) -> ([Arg] -> ShowS) -> Show Arg
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Arg] -> ShowS
$cshowList :: [Arg] -> ShowS
show :: Arg -> FilePath
$cshow :: Arg -> FilePath
showsPrec :: Int -> Arg -> ShowS
$cshowsPrec :: Int -> Arg -> ShowS
Show)

strArg :: String -> String -> Arg
strArg :: FilePath -> FilePath -> Arg
strArg = FilePath -> FilePath -> Arg
Arg_Str

rawArg :: String -> String -> Arg
rawArg :: FilePath -> FilePath -> Arg
rawArg = FilePath -> FilePath -> Arg
Arg_Expr

boolArg :: String -> Bool -> Arg
boolArg :: FilePath -> Bool -> Arg
boolArg k :: FilePath
k = FilePath -> FilePath -> Arg
Arg_Expr FilePath
k (FilePath -> Arg) -> (Bool -> FilePath) -> Bool -> Arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool "false" "true"

cliFromArgs :: [Arg] -> [String]
cliFromArgs :: [Arg] -> [FilePath]
cliFromArgs = (Arg -> [FilePath]) -> [Arg] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Arg -> [FilePath]) -> [Arg] -> [FilePath])
-> (Arg -> [FilePath]) -> [Arg] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ \case
  Arg_Str k :: FilePath
k v :: FilePath
v -> ["--argstr", FilePath
k, FilePath
v]
  Arg_Expr k :: FilePath
k v :: FilePath
v -> ["--arg", FilePath
k, FilePath
v]

data NixCommonConfig = NixCommonConfig
  { NixCommonConfig -> Target
_nixCmdConfig_target :: Target
  , NixCommonConfig -> [Arg]
_nixCmdConfig_args :: [Arg]
  , NixCommonConfig -> [FilePath]
_nixCmdConfig_builders :: [String]
  }
makeClassy ''NixCommonConfig

instance Default NixCommonConfig where
  def :: NixCommonConfig
def = Target -> [Arg] -> [FilePath] -> NixCommonConfig
NixCommonConfig Target
forall a. Default a => a
def [Arg]
forall a. Monoid a => a
mempty [FilePath]
forall a. Monoid a => a
mempty

runNixCommonConfig :: NixCommonConfig -> [String]
runNixCommonConfig :: NixCommonConfig -> [FilePath]
runNixCommonConfig cfg :: NixCommonConfig
cfg = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat [Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
path, [FilePath]
attrArg, [FilePath]
exprArg, [FilePath]
args, [FilePath]
buildersArg]
  where
    path :: Maybe FilePath
path = Target -> Maybe FilePath
_target_path (Target -> Maybe FilePath) -> Target -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    attr :: Maybe FilePath
attr = Target -> Maybe FilePath
_target_attr (Target -> Maybe FilePath) -> Target -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    expr :: Maybe FilePath
expr = Target -> Maybe FilePath
_target_expr (Target -> Maybe FilePath) -> Target -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    attrArg :: [FilePath]
attrArg = case Maybe FilePath
attr of
      Nothing -> []
      Just a :: FilePath
a -> ["-A", FilePath
a]
    exprArg :: [FilePath]
exprArg = case Maybe FilePath
expr of
      Nothing -> []
      Just a :: FilePath
a -> ["-E", FilePath
a]
    args :: [FilePath]
args = [Arg] -> [FilePath]
cliFromArgs ([Arg] -> [FilePath]) -> [Arg] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> [Arg]
_nixCmdConfig_args NixCommonConfig
cfg
    buildersArg :: [FilePath]
buildersArg = case NixCommonConfig -> [FilePath]
_nixCmdConfig_builders NixCommonConfig
cfg of
      [] -> []
      builders :: [FilePath]
builders -> ["--builders", FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate ";" [FilePath]
builders]

-- | Where to put nix-build output
data OutLink
  = OutLink_Default
  | OutLink_None
  | OutLink_IndirectRoot FilePath

instance Default OutLink where
  def :: OutLink
def = OutLink
OutLink_Default

data NixBuildConfig = NixBuildConfig
  { NixBuildConfig -> NixCommonConfig
_nixBuildConfig_common :: NixCommonConfig
  , NixBuildConfig -> OutLink
_nixBuildConfig_outLink :: OutLink
  }
makeLenses ''NixBuildConfig

instance HasNixCommonConfig NixBuildConfig where
  nixCommonConfig :: (NixCommonConfig -> f NixCommonConfig)
-> NixBuildConfig -> f NixBuildConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixBuildConfig -> f NixBuildConfig
Lens' NixBuildConfig NixCommonConfig
nixBuildConfig_common

instance Default NixBuildConfig where
  def :: NixBuildConfig
def = NixCommonConfig -> OutLink -> NixBuildConfig
NixBuildConfig NixCommonConfig
forall a. Default a => a
def OutLink
forall a. Default a => a
def

runNixBuildConfig :: NixBuildConfig -> [String]
runNixBuildConfig :: NixBuildConfig -> [FilePath]
runNixBuildConfig cfg :: NixBuildConfig
cfg = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [FilePath]
runNixCommonConfig (NixCommonConfig -> [FilePath]) -> NixCommonConfig -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NixBuildConfig
cfg NixBuildConfig
-> Getting NixCommonConfig NixBuildConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixBuildConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
nixCommonConfig
  , case NixBuildConfig -> OutLink
_nixBuildConfig_outLink NixBuildConfig
cfg of
      OutLink_Default -> []
      OutLink_None -> ["--no-out-link"]
      OutLink_IndirectRoot l :: FilePath
l -> ["--out-link", FilePath
l]
  ]

data NixInstantiateConfig = NixInstantiateConfig
  { NixInstantiateConfig -> NixCommonConfig
_nixInstantiateConfig_common :: NixCommonConfig
  , NixInstantiateConfig -> Bool
_nixInstantiateConfig_eval :: Bool
  }
makeLenses ''NixInstantiateConfig

instance HasNixCommonConfig NixInstantiateConfig where
  nixCommonConfig :: (NixCommonConfig -> f NixCommonConfig)
-> NixInstantiateConfig -> f NixInstantiateConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixInstantiateConfig -> f NixInstantiateConfig
Lens' NixInstantiateConfig NixCommonConfig
nixInstantiateConfig_common

instance Default NixInstantiateConfig where
  def :: NixInstantiateConfig
def = NixCommonConfig -> Bool -> NixInstantiateConfig
NixInstantiateConfig NixCommonConfig
forall a. Default a => a
def Bool
False

runNixInstantiateConfig :: NixInstantiateConfig -> [String]
runNixInstantiateConfig :: NixInstantiateConfig -> [FilePath]
runNixInstantiateConfig cfg :: NixInstantiateConfig
cfg = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [FilePath]
runNixCommonConfig (NixCommonConfig -> [FilePath]) -> NixCommonConfig -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NixInstantiateConfig
cfg NixInstantiateConfig
-> Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
nixCommonConfig
  , "--eval" FilePath -> [()] -> [FilePath]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (NixInstantiateConfig -> Bool
_nixInstantiateConfig_eval NixInstantiateConfig
cfg)
  ]

data NixShellConfig = NixShellConfig
  { NixShellConfig -> NixCommonConfig
_nixShellConfig_common :: NixCommonConfig
  , NixShellConfig -> Bool
_nixShellConfig_pure :: Bool
  , NixShellConfig -> Maybe FilePath
_nixShellConfig_run :: Maybe String
  }

makeLenses ''NixShellConfig

instance HasNixCommonConfig NixShellConfig where
  nixCommonConfig :: (NixCommonConfig -> f NixCommonConfig)
-> NixShellConfig -> f NixShellConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixShellConfig -> f NixShellConfig
Lens' NixShellConfig NixCommonConfig
nixShellConfig_common

instance Default NixShellConfig where
  def :: NixShellConfig
def = NixCommonConfig -> Bool -> Maybe FilePath -> NixShellConfig
NixShellConfig NixCommonConfig
forall a. Default a => a
def Bool
False Maybe FilePath
forall a. Maybe a
Nothing

data NixCmd
  = NixCmd_Build NixBuildConfig
  | NixCmd_Instantiate NixInstantiateConfig

instance Default NixCmd where
  def :: NixCmd
def = NixBuildConfig -> NixCmd
NixCmd_Build NixBuildConfig
forall a. Default a => a
def

runNixShellConfig :: NixShellConfig -> [String]
runNixShellConfig :: NixShellConfig -> [FilePath]
runNixShellConfig cfg :: NixShellConfig
cfg = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [FilePath]
runNixCommonConfig (NixCommonConfig -> [FilePath]) -> NixCommonConfig -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NixShellConfig
cfg NixShellConfig
-> Getting NixCommonConfig NixShellConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixShellConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
nixCommonConfig
  , [ "--pure" | NixShellConfig
cfg NixShellConfig -> Getting Bool NixShellConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool NixShellConfig Bool
Lens' NixShellConfig Bool
nixShellConfig_pure ]
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat [
    ["--run", FilePath
run] | FilePath
run <- Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (Maybe FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NixShellConfig
cfg NixShellConfig
-> Getting (Maybe FilePath) NixShellConfig (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) NixShellConfig (Maybe FilePath)
Lens' NixShellConfig (Maybe FilePath)
nixShellConfig_run
  ]

nixCmdProc :: NixCmd -> ProcessSpec
nixCmdProc :: NixCmd -> ProcessSpec
nixCmdProc = (ProcessSpec, Text) -> ProcessSpec
forall a b. (a, b) -> a
fst ((ProcessSpec, Text) -> ProcessSpec)
-> (NixCmd -> (ProcessSpec, Text)) -> NixCmd -> ProcessSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixCmd -> (ProcessSpec, Text)
nixCmdProc'

nixCmdProc' :: NixCmd -> (ProcessSpec, T.Text)
nixCmdProc' :: NixCmd -> (ProcessSpec, Text)
nixCmdProc' cmdCfg :: NixCmd
cmdCfg = (FilePath -> [FilePath] -> ProcessSpec
proc (Text -> FilePath
T.unpack Text
cmd) [FilePath]
options, Text
cmd)
  where
    (cmd :: Text
cmd, options :: [FilePath]
options) = case NixCmd
cmdCfg of
      NixCmd_Build cfg' :: NixBuildConfig
cfg' ->
        ( "nix-build"
        , NixBuildConfig -> [FilePath]
runNixBuildConfig NixBuildConfig
cfg'
        )
      NixCmd_Instantiate cfg' :: NixInstantiateConfig
cfg' ->
        ( "nix-instantiate"
        , NixInstantiateConfig -> [FilePath]
runNixInstantiateConfig NixInstantiateConfig
cfg'
        )

nixCmd
  :: ( MonadIO m
     , MonadMask m
     , MonadLog Output m
     , HasCliConfig e m
     , MonadError e m
     , AsProcessFailure e
     , MonadFail m
     )
  => NixCmd
  -> m FilePath
nixCmd :: NixCmd -> m FilePath
nixCmd cmdCfg :: NixCmd
cmdCfg = Text -> Maybe (FilePath -> Text) -> m FilePath -> m FilePath
forall (m :: * -> *) e a.
(MonadIO m, MonadMask m, CliLog m, HasCliConfig e m) =>
Text -> Maybe (a -> Text) -> m a -> m a
withSpinner' ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ "Running" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
cmd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
desc) ((FilePath -> Text) -> Maybe (FilePath -> Text)
forall a. a -> Maybe a
Just ((FilePath -> Text) -> Maybe (FilePath -> Text))
-> (FilePath -> Text) -> Maybe (FilePath -> Text)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> Text
forall a b. a -> b -> a
const (Text -> FilePath -> Text) -> Text -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ "Built" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
desc) (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
  Text
output <- Severity -> ProcessSpec -> m Text
forall (m :: * -> *) e.
(MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e,
 MonadMask m) =>
Severity -> ProcessSpec -> m Text
readProcessAndLogStderr Severity
Debug ProcessSpec
cmdProc
  -- Remove final newline that Nix appends
  Just (outPath :: Text
outPath, '\n') <- Maybe (Text, Char) -> m (Maybe (Text, Char))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, Char) -> m (Maybe (Text, Char)))
-> Maybe (Text, Char) -> m (Maybe (Text, Char))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Text, Char)
T.unsnoc Text
output
  FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
outPath
  where
    (cmdProc :: ProcessSpec
cmdProc, cmd :: Text
cmd) = NixCmd -> (ProcessSpec, Text)
nixCmdProc' NixCmd
cmdCfg
    commonCfg :: NixCommonConfig
commonCfg = case NixCmd
cmdCfg of
      NixCmd_Build cfg' :: NixBuildConfig
cfg' -> NixBuildConfig
cfg' NixBuildConfig
-> Getting NixCommonConfig NixBuildConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixBuildConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
nixCommonConfig
      NixCmd_Instantiate cfg' :: NixInstantiateConfig
cfg' -> NixInstantiateConfig
cfg' NixInstantiateConfig
-> Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
nixCommonConfig
    path :: Maybe FilePath
path = NixCommonConfig
commonCfg NixCommonConfig
-> Getting (Maybe FilePath) NixCommonConfig (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. (Target -> Const (Maybe FilePath) Target)
-> NixCommonConfig -> Const (Maybe FilePath) NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c Target
nixCmdConfig_target ((Target -> Const (Maybe FilePath) Target)
 -> NixCommonConfig -> Const (Maybe FilePath) NixCommonConfig)
-> ((Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
    -> Target -> Const (Maybe FilePath) Target)
-> Getting (Maybe FilePath) NixCommonConfig (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
-> Target -> Const (Maybe FilePath) Target
forall c. HasTarget c => Lens' c (Maybe FilePath)
target_path
    desc :: [Text]
desc = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe [Text]] -> [[Text]]
forall a. [Maybe a] -> [a]
catMaybes
      [ (\x :: FilePath
x -> ["on", FilePath -> Text
T.pack FilePath
x]) (FilePath -> [Text]) -> Maybe FilePath -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
path
      , (\a :: FilePath
a -> ["[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"]) (FilePath -> [Text]) -> Maybe FilePath -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixCommonConfig
commonCfg NixCommonConfig
-> Getting (Maybe FilePath) NixCommonConfig (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. (Target -> Const (Maybe FilePath) Target)
-> NixCommonConfig -> Const (Maybe FilePath) NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c Target
nixCmdConfig_target ((Target -> Const (Maybe FilePath) Target)
 -> NixCommonConfig -> Const (Maybe FilePath) NixCommonConfig)
-> ((Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
    -> Target -> Const (Maybe FilePath) Target)
-> Getting (Maybe FilePath) NixCommonConfig (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
-> Target -> Const (Maybe FilePath) Target
forall c. HasTarget c => Lens' c (Maybe FilePath)
target_attr)
      ]

-- | Statically determined (at build-time) path to @nix-prefetch-git@.
nixPrefetchGitPath :: FilePath
nixPrefetchGitPath :: FilePath
nixPrefetchGitPath = $(staticWhich "nix-prefetch-git")

-- | Statically determined (at build-time) path to @nix-prefetch-url@.
nixPrefetchUrlPath :: FilePath
nixPrefetchUrlPath :: FilePath
nixPrefetchUrlPath = $(staticWhich "nix-prefetch-url")