{-# 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)
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
" "
)
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))
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
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"
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]