{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Nix
  ( assertNewerVersion,
    assertOldVersionOn,
    binPath,
    build,
    getAttr,
    getChangelog,
    getDerivationFile,
    getDescription,
    getDrvAttr,
    getHash,
    getHashFromBuild,
    getHomepage,
    getHomepageET,
    getIsBroken,
    getMaintainers,
    getOldHash,
    getOutpaths,
    getPatches,
    getSrcUrl,
    getSrcUrls,
    hasPatchNamed,
    hasUpdateScript,
    lookupAttrPath,
    nixEvalET,
    numberOfFetchers,
    numberOfHashes,
    parseStringList,
    resultLink,
    runUpdateScript,
    sha256Zero,
    version,
    Raw (..),
  )
where

import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Vector as V
import Language.Haskell.TH.Env (envQ)
import OurPrelude
import qualified Polysemy.Error as Error
import qualified System.Process.Typed as TP
import qualified Process
import qualified Process as P
import System.Exit
import Text.Parsec (parse)
import Text.Parser.Combinators
import Text.Parser.Token
import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, srcOrMain)
import Prelude hiding (log)

binPath :: String
binPath :: String
binPath = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ($$(envQ "NIX") :: Maybe String) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin"

data Env = Env [(String, String)]

data Raw
  = Raw
  | NoRaw

data EvalOptions = EvalOptions Raw Env

rawOpt :: Raw -> [String]
rawOpt :: Raw -> [String]
rawOpt Raw
Raw = [String
"--raw"]
rawOpt Raw
NoRaw = []

nixEvalSem ::
  Members '[P.Process, Error Text] r =>
  EvalOptions ->
  Text ->
  Sem r (Text, Text)
nixEvalSem :: EvalOptions -> Text -> Sem r (Text, Text)
nixEvalSem (EvalOptions Raw
raw (Env [(String, String)]
env)) Text
expr =
  (\(Text
stdout, Text
stderr) -> (Text -> Text
T.strip Text
stdout, Text -> Text
T.strip Text
stderr))
    ((Text, Text) -> (Text, Text))
-> Sem r (Text, Text) -> Sem r (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> Sem r (Text, Text)
forall (r :: [(* -> *) -> * -> *]) stdin stdoutIgnored
       stderrIgnored.
Members '[Process] r =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> Sem r (Text, Text)
ourReadProcess_Sem
      ([(String, String)]
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String, String)]
env (String -> [String] -> ProcessConfig () () ()
proc (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix") ([String
"eval", String
"-f", String
"."] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Raw -> [String]
rawOpt Raw
raw [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Text -> String
T.unpack Text
expr])))

nixEvalET :: MonadIO m => EvalOptions -> Text -> ExceptT Text m Text
nixEvalET :: EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (EvalOptions Raw
raw (Env [(String, String)]
env)) Text
expr =
  ProcessConfig () () () -> ExceptT Text m (Text, Text)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> ExceptT Text m (Text, Text)
ourReadProcess_
    ([(String, String)]
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String, String)]
env (String -> [String] -> ProcessConfig () () ()
proc (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix") ([String
"eval", String
"-f", String
"."] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Raw -> [String]
rawOpt Raw
raw [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Text -> String
T.unpack Text
expr])))
    ExceptT Text m (Text, Text)
-> (ExceptT Text m (Text, Text) -> ExceptT Text m Text)
-> ExceptT Text m Text
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> Text)
-> ExceptT Text m (Text, Text) -> ExceptT Text m Text
forall (m :: * -> *) a b l.
Monad m =>
(a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> Text) -> (Text, Text) -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text
T.strip)

-- Error if the "new version" is actually newer according to nix
assertNewerVersion :: MonadIO m => UpdateEnv -> ExceptT Text m ()
assertNewerVersion :: UpdateEnv -> ExceptT Text m ()
assertNewerVersion UpdateEnv
updateEnv = do
  Text
versionComparison <-
    EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
      (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
      ( Text
"(builtins.compareVersions \""
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UpdateEnv -> Text
newVersion UpdateEnv
updateEnv
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" \""
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UpdateEnv -> Text
oldVersion UpdateEnv
updateEnv
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")"
      )
  case Text
versionComparison of
    Text
"1" -> () -> ExceptT Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Text
a ->
      Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
        ( UpdateEnv -> Text
newVersion UpdateEnv
updateEnv
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not newer than "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UpdateEnv -> Text
oldVersion UpdateEnv
updateEnv
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" according to Nix; versionComparison: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
        )

-- This is extremely slow but gives us the best results we know of
lookupAttrPath :: MonadIO m => UpdateEnv -> ExceptT Text m Text
lookupAttrPath :: UpdateEnv -> ExceptT Text m Text
lookupAttrPath UpdateEnv
updateEnv =
  String -> [String] -> ProcessConfig () () ()
proc
    (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix-env")
    ( [ String
"-qa",
        (UpdateEnv -> Text
packageName UpdateEnv
updateEnv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UpdateEnv -> Text
oldVersion UpdateEnv
updateEnv) Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack,
        String
"-f",
        String
".",
        String
"--attr-path"
      ]
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
nixCommonOptions
    )
    ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text m (Text, Text))
-> ExceptT Text m (Text, Text)
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text m (Text, Text)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> ExceptT Text m (Text, Text)
ourReadProcess_
    ExceptT Text m (Text, Text)
-> (ExceptT Text m (Text, Text) -> ExceptT Text m Text)
-> ExceptT Text m Text
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> Text)
-> ExceptT Text m (Text, Text) -> ExceptT Text m Text
forall (m :: * -> *) a b l.
Monad m =>
(a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> Text) -> (Text, Text) -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text]
T.lines (Text -> [Text]) -> ([Text] -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (Text -> Text) -> [Text] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text]
T.words (Text -> [Text]) -> ([Text] -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> Text
forall a. [a] -> a
head)

getDerivationFile :: MonadIO m => Text -> ExceptT Text m FilePath
getDerivationFile :: Text -> ExceptT Text m String
getDerivationFile Text
attrPath =
  String -> [String] -> ProcessConfig () () ()
proc String
"env" [String
"EDITOR=echo", (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix"), String
"edit", Text
attrPath Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack, String
"-f", String
"."]
    ProcessConfig () () ()
-> (ProcessConfig () () () -> ExceptT Text m (Text, Text))
-> ExceptT Text m (Text, Text)
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> ExceptT Text m (Text, Text)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> ExceptT Text m (Text, Text)
ourReadProcess_
    ExceptT Text m (Text, Text)
-> (ExceptT Text m (Text, Text) -> ExceptT Text m String)
-> ExceptT Text m String
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> String)
-> ExceptT Text m (Text, Text) -> ExceptT Text m String
forall (m :: * -> *) a b l.
Monad m =>
(a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (Text -> String) -> (Text, Text) -> String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text
T.strip (Text -> Text) -> (Text -> String) -> Text -> String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> String
T.unpack)

getDrvAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
getDrvAttr :: Text -> Text -> ExceptT Text m Text
getDrvAttr Text
drvAttr =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain
    (\Text
attrPath -> EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
Raw ([(String, String)] -> Env
Env [])) (Text
"pkgs." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".drvAttrs." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
drvAttr))

-- Get an attribute that can be evaluated off a derivation, as in:
-- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21
getAttr :: MonadIO m => Raw -> Text -> Text -> ExceptT Text m Text
getAttr :: Raw -> Text -> Text -> ExceptT Text m Text
getAttr Raw
raw Text
attr =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain
    (\Text
attrPath -> EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
raw ([(String, String)] -> Env
Env [])) (Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr))

getHash :: MonadIO m => Text -> ExceptT Text m Text
getHash :: Text -> ExceptT Text m Text
getHash =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain
    (\Text
attrPath -> EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
Raw ([(String, String)] -> Env
Env [])) (Text
"pkgs." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".drvAttrs.outputHash"))

getOldHash :: MonadIO m => Text -> ExceptT Text m Text
getOldHash :: Text -> ExceptT Text m Text
getOldHash Text
attrPath =
  Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
getHash Text
attrPath

getMaintainers :: MonadIO m => Text -> ExceptT Text m Text
getMaintainers :: Text -> ExceptT Text m Text
getMaintainers Text
attrPath =
  EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
    (Raw -> Env -> EvalOptions
EvalOptions Raw
Raw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".meta.maintainers or []))))"
    )

parseStringList :: MonadIO m => Text -> ExceptT Text m (Vector Text)
parseStringList :: Text -> ExceptT Text m (Vector Text)
parseStringList Text
list =
  Parsec Text () (Vector Text)
-> String -> Text -> Either ParseError (Vector Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () (Vector Text)
forall (m :: * -> *). TokenParsing m => m (Vector Text)
nixStringList (String
"nix list " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
list) Text
list Either ParseError (Vector Text)
-> (Either ParseError (Vector Text) -> Either Text (Vector Text))
-> Either Text (Vector Text)
forall a b. a -> (a -> b) -> b
& (ParseError -> Text)
-> Either ParseError (Vector Text) -> Either Text (Vector Text)
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL ParseError -> Text
forall a. Show a => a -> Text
tshow
    Either Text (Vector Text)
-> (Either Text (Vector Text) -> ExceptT Text m (Vector Text))
-> ExceptT Text m (Vector Text)
forall a b. a -> (a -> b) -> b
& Either Text (Vector Text) -> ExceptT Text m (Vector Text)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither

nixStringList :: TokenParsing m => m (Vector Text)
nixStringList :: m (Vector Text)
nixStringList = [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList ([Text] -> Vector Text) -> m [Text] -> m (Vector Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Text] -> m [Text]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
brackets (m Text -> m [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m Text
forall (m :: * -> *) s. (TokenParsing m, IsString s) => m s
stringLiteral)

getOutpaths :: MonadIO m => Text -> ExceptT Text m (Vector Text)
getOutpaths :: Text -> ExceptT Text m (Vector Text)
getOutpaths Text
attrPath = do
  Text
list <- EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env [(String
"GC_INITIAL_HEAP_SIZE", String
"10g")])) (Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".outputs")
  Vector Text
outputs <- Text -> ExceptT Text m (Vector Text)
forall (m :: * -> *).
MonadIO m =>
Text -> ExceptT Text m (Vector Text)
parseStringList Text
list
  Vector (ExceptT Text m Text) -> ExceptT Text m (Vector Text)
forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
V.sequence (Vector (ExceptT Text m Text) -> ExceptT Text m (Vector Text))
-> Vector (ExceptT Text m Text) -> ExceptT Text m (Vector Text)
forall a b. (a -> b) -> a -> b
$ (Text -> ExceptT Text m Text)
-> Vector Text -> Vector (ExceptT Text m Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
o -> EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
Raw ([(String, String)] -> Env
Env [])) (Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o)) Vector Text
outputs

readNixBool :: MonadIO m => ExceptT Text m Text -> ExceptT Text m Bool
readNixBool :: ExceptT Text m Text -> ExceptT Text m Bool
readNixBool ExceptT Text m Text
t = do
  Text
text <- ExceptT Text m Text
t
  case Text
text of
    Text
"true" -> Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Text
"false" -> Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Text
a -> Text -> ExceptT Text m Bool
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text
"Failed to read expected nix boolean " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")

getIsBroken :: MonadIO m => Text -> ExceptT Text m Bool
getIsBroken :: Text -> ExceptT Text m Bool
getIsBroken Text
attrPath =
  EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
    (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; in pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".meta.broken or false)"
    )
    ExceptT Text m Text
-> (ExceptT Text m Text -> ExceptT Text m Bool)
-> ExceptT Text m Bool
forall a b. a -> (a -> b) -> b
& ExceptT Text m Text -> ExceptT Text m Bool
forall (m :: * -> *).
MonadIO m =>
ExceptT Text m Text -> ExceptT Text m Bool
readNixBool

getChangelog :: MonadIO m => Text -> ExceptT Text m Text
getChangelog :: Text -> ExceptT Text m Text
getChangelog Text
attrPath =
  EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
    (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; in pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".meta.changelog or \"\")"
    )

getDescription :: MonadIO m => Text -> ExceptT Text m Text
getDescription :: Text -> ExceptT Text m Text
getDescription Text
attrPath =
  EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
    (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; in pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".meta.description or \"\")"
    )

getHomepage ::
  Members '[P.Process, Error Text] r =>
  Text ->
  Sem r Text
getHomepage :: Text -> Sem r Text
getHomepage Text
attrPath =
  (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> Sem r (Text, Text) -> Sem r Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalOptions -> Text -> Sem r (Text, Text)
forall (r :: [(* -> *) -> * -> *]).
Members '[Process, Error Text] r =>
EvalOptions -> Text -> Sem r (Text, Text)
nixEvalSem
    (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; in pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".meta.homepage or \"\")"
    )

getHomepageET :: MonadIO m => Text -> ExceptT Text m Text
getHomepageET :: Text -> ExceptT Text m Text
getHomepageET Text
attrPath =
  m (Either Text Text) -> ExceptT Text m Text
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
    (m (Either Text Text) -> ExceptT Text m Text)
-> (Sem '[Process, Error Text, Embed IO, Final IO] Text
    -> m (Either Text Text))
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> ExceptT Text m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Text Text) -> m (Either Text Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Either Text Text) -> m (Either Text Text))
-> (Sem '[Process, Error Text, Embed IO, Final IO] Text
    -> IO (Either Text Text))
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> m (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Final IO] (Either Text Text) -> IO (Either Text Text)
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal
    (Sem '[Final IO] (Either Text Text) -> IO (Either Text Text))
-> (Sem '[Process, Error Text, Embed IO, Final IO] Text
    -> Sem '[Final IO] (Either Text Text))
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> IO (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed IO, Final IO] (Either Text Text)
-> Sem '[Final IO] (Either Text Text)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal
    (Sem '[Embed IO, Final IO] (Either Text Text)
 -> Sem '[Final IO] (Either Text Text))
-> (Sem '[Process, Error Text, Embed IO, Final IO] Text
    -> Sem '[Embed IO, Final IO] (Either Text Text))
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> Sem '[Final IO] (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Error Text, Embed IO, Final IO] Text
-> Sem '[Embed IO, Final IO] (Either Text Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
Error.runError
    (Sem '[Error Text, Embed IO, Final IO] Text
 -> Sem '[Embed IO, Final IO] (Either Text Text))
-> (Sem '[Process, Error Text, Embed IO, Final IO] Text
    -> Sem '[Error Text, Embed IO, Final IO] Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> Sem '[Embed IO, Final IO] (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Process, Error Text, Embed IO, Final IO] Text
-> Sem '[Error Text, Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (Process : r) a -> Sem r a
Process.runIO
    (Sem '[Process, Error Text, Embed IO, Final IO] Text
 -> ExceptT Text m Text)
-> Sem '[Process, Error Text, Embed IO, Final IO] Text
-> ExceptT Text m Text
forall a b. (a -> b) -> a -> b
$ Text -> Sem '[Process, Error Text, Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]).
Members '[Process, Error Text] r =>
Text -> Sem r Text
getHomepage Text
attrPath

getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
getSrcUrl :: Text -> ExceptT Text m Text
getSrcUrl =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain
    ( \Text
attrPath ->
        EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
          (Raw -> Env -> EvalOptions
EvalOptions Raw
Raw ([(String, String)] -> Env
Env []))
          ( Text
"(let pkgs = import ./. {}; in builtins.elemAt pkgs."
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".drvAttrs.urls 0)"
          )
    )

getSrcAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
getSrcAttr :: Text -> Text -> ExceptT Text m Text
getSrcAttr Text
attr =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain (\Text
attrPath -> EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env [])) (Text
"pkgs." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr))

getSrcUrls :: MonadIO m => Text -> ExceptT Text m Text
getSrcUrls :: Text -> ExceptT Text m Text
getSrcUrls = Text -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> ExceptT Text m Text
getSrcAttr Text
"urls"

buildCmd :: Text -> ProcessConfig () () ()
buildCmd :: Text -> ProcessConfig () () ()
buildCmd Text
attrPath =
  ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
silently (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix-build") ([String]
nixBuildOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-A", Text
attrPath Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack])

log :: Text -> ProcessConfig () () ()
log :: Text -> ProcessConfig () () ()
log Text
attrPath = String -> [String] -> ProcessConfig () () ()
proc (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix") [String
"log", String
"-f", String
".", Text
attrPath Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack]

build :: MonadIO m => Text -> ExceptT Text m ()
build :: Text -> ExceptT Text m ()
build Text
attrPath =
  (Text -> ProcessConfig () () ()
buildCmd Text
attrPath ProcessConfig () () ()
-> (ProcessConfig () () () -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
& ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ IO () -> (IO () -> ExceptT Text m ()) -> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> ExceptT Text m a
tryIOTextET)
    ExceptT Text m () -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
            Any
_ <- ExceptT Text m Any
buildFailedLog
            Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"nix log failed trying to get build logs "
        )
  where
    buildFailedLog :: ExceptT Text m Any
buildFailedLog = do
      Text
buildLog <-
        ProcessConfig () () () -> ExceptT Text m Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_ (Text -> ProcessConfig () () ()
log Text
attrPath)
          ExceptT Text m Text
-> (ExceptT Text m Text -> ExceptT Text m Text)
-> ExceptT Text m Text
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> ExceptT Text m Text -> ExceptT Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text]
T.lines (Text -> [Text]) -> ([Text] -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> Text) -> [Text] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
30 ([Text] -> [Text]) -> ([Text] -> Text) -> [Text] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> Text) -> [Text] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> Text
T.unlines)
      Text -> ExceptT Text m Any
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text
"nix build failed.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
buildLog Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")

numberOfFetchers :: Text -> Int
numberOfFetchers :: Text -> Int
numberOfFetchers Text
derivationContents =
  Text -> Int
countUp Text
"fetchurl {" Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
countUp Text
"fetchgit {" Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
countUp Text
"fetchFromGitHub {"
  where
    countUp :: Text -> Int
countUp Text
x = Text -> Text -> Int
T.count Text
x Text
derivationContents

-- Sum the number of things that look like fixed-output derivation hashes
numberOfHashes :: Text -> Int
numberOfHashes :: Text -> Int
numberOfHashes Text
derivationContents =
  [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
countUp [Text
"sha256 =", Text
"sha256=", Text
"cargoSha256 =", Text
"vendorSha256 ="]
  where
    countUp :: Text -> Int
countUp Text
x = Text -> Text -> Int
T.count Text
x Text
derivationContents

assertOldVersionOn ::
  MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m ()
assertOldVersionOn :: UpdateEnv -> Text -> Text -> ExceptT Text m ()
assertOldVersionOn UpdateEnv
updateEnv Text
branchName Text
contents =
  Text -> Bool -> ExceptT Text m ()
forall (m :: * -> *) e. Monad m => e -> Bool -> ExceptT e m ()
tryAssert
    (Text
"Old version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldVersionPattern Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not present in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" derivation file with contents: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents)
    (Text
oldVersionPattern Text -> Text -> Bool
`T.isInfixOf` Text
contents)
  where
    oldVersionPattern :: Text
oldVersionPattern = UpdateEnv -> Text
oldVersion UpdateEnv
updateEnv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

resultLink :: MonadIO m => ExceptT Text m Text
resultLink :: ExceptT Text m Text
resultLink =
  Text -> Text
T.strip
    (Text -> Text) -> ExceptT Text m Text -> ExceptT Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ProcessConfig () () () -> ExceptT Text m Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_ ProcessConfig () () ()
"readlink ./result"
            ExceptT Text m Text -> ExceptT Text m Text -> ExceptT Text m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProcessConfig () () () -> ExceptT Text m Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_ ProcessConfig () () ()
"readlink ./result-bin"
        )
    ExceptT Text m Text -> ExceptT Text m Text -> ExceptT Text m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"Could not find result link. "

sha256Zero :: Text
sha256Zero :: Text
sha256Zero = Text
"0000000000000000000000000000000000000000000000000000"

-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
getHashFromBuild :: Text -> ExceptT Text m Text
getHashFromBuild =
  (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall (m :: * -> *) a.
MonadIO m =>
(Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain
    ( \Text
attrPath -> do
        (ExitCode
exitCode, ByteString
_, ByteString
stderr) <- Text -> ProcessConfig () () ()
buildCmd Text
attrPath ProcessConfig () () ()
-> (ProcessConfig () () ()
    -> ExceptT Text m (ExitCode, ByteString, ByteString))
-> ExceptT Text m (ExitCode, ByteString, ByteString)
forall a b. a -> (a -> b) -> b
& ProcessConfig () () ()
-> ExceptT Text m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess
        Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (ExceptT Text m () -> ExceptT Text m ())
-> ExceptT Text m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Text
"build succeeded unexpectedly"
        let stdErrText :: Text
stdErrText = ByteString -> Text
bytestringToText ByteString
stderr
        let firstSplit :: [Text]
firstSplit = Text -> Text -> [Text]
T.splitOn Text
"got:    " Text
stdErrText
        Text
firstSplitSecondPart <-
          Text -> [Text] -> Int -> ExceptT Text m Text
forall (m :: * -> *) e a.
Monad m =>
e -> [a] -> Int -> ExceptT e m a
tryAt
            (Text
"stderr did not split as expected full stderr was: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stdErrText)
            [Text]
firstSplit
            Int
1
        let secondSplit :: [Text]
secondSplit = Text -> Text -> [Text]
T.splitOn Text
"\n" Text
firstSplitSecondPart
        Text -> [Text] -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> [a] -> ExceptT e m a
tryHead
          ( Text
"stderr did not split second part as expected full stderr was: \n"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stdErrText
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nfirstSplitSecondPart:\n"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstSplitSecondPart
          )
          [Text]
secondSplit
    )

version :: MonadIO m => ExceptT Text m Text
version :: ExceptT Text m Text
version = ProcessConfig () () () -> ExceptT Text m Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_ (String -> [String] -> ProcessConfig () () ()
proc (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nix") [String
"--version"])

getPatches :: MonadIO m => Text -> ExceptT Text m Text
getPatches :: Text -> ExceptT Text m Text
getPatches Text
attrPath =
  EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
    (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
    ( Text
"(let pkgs = import ./. {}; in (map (p: p.name) pkgs."
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".patches))"
    )

hasPatchNamed :: MonadIO m => Text -> Text -> ExceptT Text m Bool
hasPatchNamed :: Text -> Text -> ExceptT Text m Bool
hasPatchNamed Text
attrPath Text
name = do
  Text
ps <- Text -> ExceptT Text m Text
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m Text
getPatches Text
attrPath
  Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ExceptT Text m Bool) -> Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Bool
`T.isInfixOf` Text
ps

hasUpdateScript :: MonadIO m => Text -> ExceptT Text m Bool
hasUpdateScript :: Text -> ExceptT Text m Bool
hasUpdateScript Text
attrPath = do
  Text
result <-
    EvalOptions -> Text -> ExceptT Text m Text
forall (m :: * -> *).
MonadIO m =>
EvalOptions -> Text -> ExceptT Text m Text
nixEvalET
      (Raw -> Env -> EvalOptions
EvalOptions Raw
NoRaw ([(String, String)] -> Env
Env []))
      ( Text
"(let pkgs = import ./. {}; in builtins.hasAttr \"updateScript\" pkgs."
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrPath
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      )
  case Text
result of
    Text
"true" -> Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Text
_ -> Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

runUpdateScript :: MonadIO m => Text -> ExceptT Text m (ExitCode, Text)
runUpdateScript :: Text -> ExceptT Text m (ExitCode, Text)
runUpdateScript Text
attrPath = do
  ProcessConfig () () () -> ExceptT Text m (ExitCode, Text)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m (ExitCode, Text)
ourReadProcessInterleaved (ProcessConfig () () () -> ExceptT Text m (ExitCode, Text))
-> ProcessConfig () () () -> ExceptT Text m (ExitCode, Text)
forall a b. (a -> b) -> a -> b
$
    StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
TP.setStdin (ByteString -> StreamSpec 'STInput ()
TP.byteStringInput ByteString
"\n") (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> ProcessConfig () () ()
proc String
"nix-shell" [String
"maintainers/scripts/update.nix", String
"--argstr", String
"package", Text -> String
T.unpack Text
attrPath]