{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-}
module Nix.Effects.Derivation ( defaultDerivationStrict ) where
import Nix.Utils
import Data.Char ( isAscii
, isAlphaNum
)
import qualified Data.HashMap.Lazy as M
import qualified Data.HashMap.Strict as MS ( insert )
import qualified Data.HashSet as S
import Data.Foldable ( foldl )
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified "cryptonite" Crypto.Hash as Hash
import Nix.Atoms
import Nix.Convert
import Nix.Effects
import Nix.Exec ( MonadNix
, callFunc
)
import Nix.Frames
import Nix.Json ( nvalueToJSONNixString )
import Nix.Render
import Nix.String
import Nix.String.Coerce
import Nix.Value
import Nix.Value.Monad
import qualified System.Nix.ReadonlyStore as Store
import qualified System.Nix.Hash as Store
import qualified System.Nix.StorePath as Store
import Prelude hiding (readFile)
data Derivation = Derivation
{ Derivation -> Text
name :: Text
, Derivation -> Map Text Text
outputs :: Map Text Text
, Derivation -> (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
, Derivation -> Text
platform :: Text
, Derivation -> Text
builder :: Text
, Derivation -> [Text]
args :: [ Text ]
, Derivation -> Map Text Text
env :: Map Text Text
, Derivation -> Maybe SomeNamedDigest
mFixed :: Maybe Store.SomeNamedDigest
, Derivation -> HashMode
hashMode :: HashMode
, Derivation -> Bool
useJson :: Bool
}
deriving Int -> Derivation -> ShowS
[Derivation] -> ShowS
Derivation -> String
(Int -> Derivation -> ShowS)
-> (Derivation -> String)
-> ([Derivation] -> ShowS)
-> Show Derivation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Derivation] -> ShowS
$cshowList :: [Derivation] -> ShowS
show :: Derivation -> String
$cshow :: Derivation -> String
showsPrec :: Int -> Derivation -> ShowS
$cshowsPrec :: Int -> Derivation -> ShowS
Show
data HashMode = Flat | Recursive
deriving (Int -> HashMode -> ShowS
[HashMode] -> ShowS
HashMode -> String
(Int -> HashMode -> ShowS)
-> (HashMode -> String) -> ([HashMode] -> ShowS) -> Show HashMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashMode] -> ShowS
$cshowList :: [HashMode] -> ShowS
show :: HashMode -> String
$cshow :: HashMode -> String
showsPrec :: Int -> HashMode -> ShowS
$cshowsPrec :: Int -> HashMode -> ShowS
Show, HashMode -> HashMode -> Bool
(HashMode -> HashMode -> Bool)
-> (HashMode -> HashMode -> Bool) -> Eq HashMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashMode -> HashMode -> Bool
$c/= :: HashMode -> HashMode -> Bool
== :: HashMode -> HashMode -> Bool
$c== :: HashMode -> HashMode -> Bool
Eq)
makeStorePathName :: (Framed e m) => Text -> m Store.StorePathName
makeStorePathName :: Text -> m StorePathName
makeStorePathName Text
name = case Text -> Either String StorePathName
Store.makeStorePathName Text
name of
Left String
err -> ErrorCall -> m StorePathName
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m StorePathName) -> ErrorCall -> m StorePathName
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Invalid name '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' for use in a store path: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
Right StorePathName
spname -> StorePathName -> m StorePathName
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorePathName
spname
parsePath :: (Framed e m) => Text -> m Store.StorePath
parsePath :: Text -> m StorePath
parsePath Text
p = case String -> ByteString -> Either String StorePath
Store.parsePath String
"/nix/store" (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
p) of
Left String
err -> ErrorCall -> m StorePath
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m StorePath) -> ErrorCall -> m StorePath
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse store path " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall b a. (Show a, IsString b) => a -> b
show String
err
Right StorePath
path -> StorePath -> m StorePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorePath
path
writeDerivation :: (Framed e m, MonadStore m) => Derivation -> m Store.StorePath
writeDerivation :: Derivation -> m StorePath
writeDerivation drv :: Derivation
drv@Derivation{(Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs :: Derivation -> (Set Text, Map Text [Text])
inputs, Text
name :: Text
name :: Derivation -> Text
name} = do
let (Set Text
inputSrcs, Map Text [Text]
inputDrvs) = (Set Text, Map Text [Text])
inputs
Set StorePath
references <- [StorePath] -> Set StorePath
forall a. Ord a => [a] -> Set a
Set.fromList ([StorePath] -> Set StorePath)
-> m [StorePath] -> m (Set StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> m StorePath) -> [Text] -> m [StorePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> m StorePath
forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text
inputSrcs Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (Map Text [Text] -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text [Text]
inputDrvs))
StorePath
path <- Text -> Text -> StorePathSet -> Bool -> m StorePath
forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Text -> Text -> StorePathSet -> Bool -> m StorePath
addTextToStore (Text -> Text -> Text
Text.append Text
name Text
".drv") (Derivation -> Text
unparseDrv Derivation
drv) ([StorePath] -> StorePathSet
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([StorePath] -> StorePathSet) -> [StorePath] -> StorePathSet
forall a b. (a -> b) -> a -> b
$ Set StorePath -> [StorePath]
forall a. Set a -> [a]
Set.toList Set StorePath
references) Bool
False
Text -> m StorePath
forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath (Text -> m StorePath) -> Text -> m StorePath
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorePath -> String
unStorePath StorePath
path
hashDerivationModulo :: (MonadNix e t f m, MonadState (b, AttrSet Text) m) => Derivation -> m (Hash.Digest Hash.SHA256)
hashDerivationModulo :: Derivation -> m (Digest SHA256)
hashDerivationModulo
Derivation
{ mFixed :: Derivation -> Maybe SomeNamedDigest
mFixed = Just (Store.SomeDigest (Digest a
digest :: Hash.Digest hashType))
, Map Text Text
outputs :: Map Text Text
outputs :: Derivation -> Map Text Text
outputs
, HashMode
hashMode :: HashMode
hashMode :: Derivation -> HashMode
hashMode
} =
case Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
outputs of
[(Text
"out", Text
path)] -> Digest SHA256 -> m (Digest SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Digest SHA256 -> m (Digest SHA256))
-> Digest SHA256 -> m (Digest SHA256)
forall a b. (a -> b) -> a -> b
$
(ByteArrayAccess ByteString, HashAlgorithm SHA256) =>
ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash @ByteString @Hash.SHA256 (ByteString -> Digest SHA256) -> ByteString -> Digest SHA256
forall a b. (a -> b) -> a -> b
$
Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
Text
"fixed:out"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if HashMode
hashMode HashMode -> HashMode -> Bool
forall a. Eq a => a -> a -> Bool
== HashMode
Recursive then Text
":r" else Text
"")
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (NamedAlgo a => Text
forall a. NamedAlgo a => Text
Store.algoName @hashType)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BaseEncoding -> Digest a -> Text
forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 Digest a
digest
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
[(Text, Text)]
_outputsList -> ErrorCall -> m (Digest SHA256)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (Digest SHA256)) -> ErrorCall -> m (Digest SHA256)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"This is weird. A fixed output drv should only have one output named 'out'. Got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> String
forall b a. (Show a, IsString b) => a -> b
show [(Text, Text)]
_outputsList
hashDerivationModulo
drv :: Derivation
drv@Derivation
{ inputs :: Derivation -> (Set Text, Map Text [Text])
inputs = ( Set Text
inputSrcs
, Map Text [Text]
inputDrvs
)
} =
do
HashMap Text Text
cache <- ((b, HashMap Text Text) -> HashMap Text Text)
-> m (HashMap Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (b, HashMap Text Text) -> HashMap Text Text
forall a b. (a, b) -> b
snd
Map Text [Text]
inputsModulo <-
[(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> Map Text [Text])
-> m [(Text, [Text])] -> m (Map Text [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
((Text, [Text]) -> m (Text, [Text]))
-> [(Text, [Text])] -> m [(Text, [Text])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(\(Text
path, [Text]
outs) ->
m (Text, [Text])
-> (Text -> m (Text, [Text])) -> Maybe Text -> m (Text, [Text])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(do
Derivation
drv' <- String -> m Derivation
forall e (m :: * -> *).
(Framed e m, MonadFile m) =>
String -> m Derivation
readDerivation (String -> m Derivation) -> String -> m Derivation
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
path
Text
hash <- BaseEncoding -> Digest SHA256 -> Text
forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 (Digest SHA256 -> Text) -> m (Digest SHA256) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Derivation -> m (Digest SHA256)
forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, HashMap Text Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo Derivation
drv'
pure (Text
hash, [Text]
outs)
)
(\ Text
hash -> (Text, [Text]) -> m (Text, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
hash, [Text]
outs))
(Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
path HashMap Text Text
cache)
)
(Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Text]
inputDrvs)
pure $ (ByteArrayAccess ByteString, HashAlgorithm SHA256) =>
ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash @ByteString @Hash.SHA256 (ByteString -> Digest SHA256) -> ByteString -> Digest SHA256
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Derivation -> Text
unparseDrv (Derivation -> Text) -> Derivation -> Text
forall a b. (a -> b) -> a -> b
$ Derivation
drv {inputs :: (Set Text, Map Text [Text])
inputs = (Set Text
inputSrcs, Map Text [Text]
inputsModulo)}
unparseDrv :: Derivation -> Text
unparseDrv :: Derivation -> Text
unparseDrv Derivation{Bool
[Text]
Maybe SomeNamedDigest
(Set Text, Map Text [Text])
Text
Map Text Text
HashMode
useJson :: Bool
hashMode :: HashMode
mFixed :: Maybe SomeNamedDigest
env :: Map Text Text
args :: [Text]
builder :: Text
platform :: Text
inputs :: (Set Text, Map Text [Text])
outputs :: Map Text Text
name :: Text
useJson :: Derivation -> Bool
hashMode :: Derivation -> HashMode
mFixed :: Derivation -> Maybe SomeNamedDigest
env :: Derivation -> Map Text Text
args :: Derivation -> [Text]
builder :: Derivation -> Text
platform :: Derivation -> Text
inputs :: Derivation -> (Set Text, Map Text [Text])
outputs :: Derivation -> Map Text Text
name :: Derivation -> Text
..} =
Text -> Text -> Text
Text.append
Text
"Derive"
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
parens
[
[Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
(Text, Text) -> Text
produceOutputInfo ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
outputs
,
[Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
(\(Text
path, [Text]
outs) ->
[Text] -> Text
parens [Text -> Text
s Text
path, [Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
s (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
outs]
) ((Text, [Text]) -> Text) -> [(Text, [Text])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList ((Set Text, Map Text [Text]) -> Map Text [Text]
forall a b. (a, b) -> b
snd (Set Text, Map Text [Text])
inputs)
,
[Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
s (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> [Text]
forall a. Set a -> [a]
Set.toList ((Set Text, Map Text [Text]) -> Set Text
forall a b. (a, b) -> a
fst (Set Text, Map Text [Text])
inputs)
, Text -> Text
s Text
platform
, Text -> Text
s Text
builder
,
[Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
s (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args
,
[Text] -> Text
serializeList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\(Text
k, Text
v) -> [Text] -> Text
parens [Text -> Text
s Text
k, Text -> Text
s Text
v]) ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
env
]
where
produceOutputInfo :: (Text, Text) -> Text
produceOutputInfo (Text
outputName, Text
outputPath) =
let prefix :: Text
prefix = if HashMode
hashMode HashMode -> HashMode -> Bool
forall a. Eq a => a -> a -> Bool
== HashMode
Recursive then Text
"r:" else Text
"" in
[Text] -> Text
parens ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text
s (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([Text
outputName, Text
outputPath] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
[Text]
-> (SomeNamedDigest -> [Text]) -> Maybe SomeNamedDigest -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[Text
forall a. Monoid a => a
mempty, Text
forall a. Monoid a => a
mempty]
(\ (Store.SomeDigest (Digest a
digest :: Hash.Digest hashType)) ->
[Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NamedAlgo a => Text
forall a. NamedAlgo a => Text
Store.algoName @hashType, BaseEncoding -> Digest a -> Text
forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 Digest a
digest]
)
Maybe SomeNamedDigest
mFixed
parens :: [Text] -> Text
parens :: [Text] -> Text
parens [Text]
ts = [Text] -> Text
Text.concat [Text
"(", Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
ts, Text
")"]
serializeList :: [Text] -> Text
serializeList :: [Text] -> Text
serializeList [Text]
ls = [Text] -> Text
Text.concat [Text
"[", Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
ls, Text
"]"]
s :: Text -> Text
s = Char -> Text -> Text
Text.cons Char
'\"' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text
`Text.snoc` Char
'\"') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
escape
escape :: Char -> Text
escape :: Char -> Text
escape Char
'\\' = Text
"\\\\"
escape Char
'\"' = Text
"\\\""
escape Char
'\n' = Text
"\\n"
escape Char
'\r' = Text
"\\r"
escape Char
'\t' = Text
"\\t"
escape Char
c = OneItem Text -> Text
forall x. One x => OneItem x -> x
one Char
OneItem Text
c
readDerivation :: (Framed e m, MonadFile m) => FilePath -> m Derivation
readDerivation :: String -> m Derivation
readDerivation String
path = do
Text
content <- ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). MonadFile m => String -> m ByteString
readFile String
path
(ParseErrorBundle Text () -> m Derivation)
-> (Derivation -> m Derivation)
-> Either (ParseErrorBundle Text ()) Derivation
-> m Derivation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ ParseErrorBundle Text ()
err -> ErrorCall -> m Derivation
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Derivation) -> ErrorCall -> m Derivation
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall b a. (Show a, IsString b) => a -> b
show String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text () -> String
forall b a. (Show a, IsString b) => a -> b
show ParseErrorBundle Text ()
err)
Derivation -> m Derivation
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Parsec () Text Derivation
-> String -> Text -> Either (ParseErrorBundle Text ()) Derivation
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec () Text Derivation
derivationParser String
path Text
content)
derivationParser :: Parsec () Text Derivation
derivationParser :: Parsec () Text Derivation
derivationParser = do
Text
_ <- ParsecT () Text Identity Text
"Derive("
[(Text, Text, Text, Text)]
fullOutputs <- ParsecT () Text Identity (Text, Text, Text, Text)
-> ParsecT () Text Identity [(Text, Text, Text, Text)]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList (ParsecT () Text Identity (Text, Text, Text, Text)
-> ParsecT () Text Identity [(Text, Text, Text, Text)])
-> ParsecT () Text Identity (Text, Text, Text, Text)
-> ParsecT () Text Identity [(Text, Text, Text, Text)]
forall a b. (a -> b) -> a -> b
$
(\[Text
n, Text
p, Text
ht, Text
h] -> (Text
n, Text
p, Text
ht, Text
h)) ([Text] -> (Text, Text, Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text, Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Map Text [Text]
inputDrvs <- [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> Map Text [Text])
-> ParsecT () Text Identity [(Text, [Text])]
-> ParsecT () Text Identity (Map Text [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity (Text, [Text])
-> ParsecT () Text Identity [(Text, [Text])]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList
((Text -> [Text] -> (Text, [Text]))
-> ParsecT () Text Identity Text
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, [Text])
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (ParsecT () Text Identity Text
"(" ParsecT () Text Identity Text
-> ParsecT () Text Identity Text -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity Text
s ParsecT () Text Identity Text
-> ParsecT () Text Identity Text -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
",") (ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s ParsecT () Text Identity [Text]
-> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
")"))
Text
_ <- ParsecT () Text Identity Text
","
Set Text
inputSrcs <- [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text)
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Text
platform <- ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Text
builder <- ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
[Text]
args <- ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Map Text Text
env <- ([(Text, Text)] -> Map Text Text)
-> ParsecT () Text Identity [(Text, Text)]
-> ParsecT () Text Identity (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (ParsecT () Text Identity [(Text, Text)]
-> ParsecT () Text Identity (Map Text Text))
-> ParsecT () Text Identity [(Text, Text)]
-> ParsecT () Text Identity (Map Text Text)
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity (Text, Text)
-> ParsecT () Text Identity [(Text, Text)]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList (ParsecT () Text Identity (Text, Text)
-> ParsecT () Text Identity [(Text, Text)])
-> ParsecT () Text Identity (Text, Text)
-> ParsecT () Text Identity [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (\[Text
a, Text
b] -> (Text
a, Text
b)) ([Text] -> (Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
")"
ParsecT () Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
let outputs :: Map Text Text
outputs = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (\(Text
a, Text
b, Text
_, Text
_) -> (Text
a, Text
b)) ((Text, Text, Text, Text) -> (Text, Text))
-> [(Text, Text, Text, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text, Text, Text)]
fullOutputs
let (Maybe SomeNamedDigest
mFixed, HashMode
hashMode) = [(Text, Text, Text, Text)] -> (Maybe SomeNamedDigest, HashMode)
parseFixed [(Text, Text, Text, Text)]
fullOutputs
let name :: Text
name = Text
""
let useJson :: Bool
useJson = [Text
"__json"] [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text Text -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text Text
env
pure $ Derivation :: Text
-> Map Text Text
-> (Set Text, Map Text [Text])
-> Text
-> Text
-> [Text]
-> Map Text Text
-> Maybe SomeNamedDigest
-> HashMode
-> Bool
-> Derivation
Derivation {inputs :: (Set Text, Map Text [Text])
inputs = (Set Text
inputSrcs, Map Text [Text]
inputDrvs), Bool
[Text]
Maybe SomeNamedDigest
Text
Map Text Text
HashMode
useJson :: Bool
name :: Text
hashMode :: HashMode
mFixed :: Maybe SomeNamedDigest
outputs :: Map Text Text
env :: Map Text Text
args :: [Text]
builder :: Text
platform :: Text
useJson :: Bool
hashMode :: HashMode
mFixed :: Maybe SomeNamedDigest
env :: Map Text Text
args :: [Text]
builder :: Text
platform :: Text
outputs :: Map Text Text
name :: Text
..}
where
s :: Parsec () Text Text
s :: ParsecT () Text Identity Text
s = (String -> Text)
-> ParsecT () Text Identity String -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. ToText a => a -> Text
toText (ParsecT () Text Identity String -> ParsecT () Text Identity Text)
-> ParsecT () Text Identity String -> ParsecT () Text Identity Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"" ParsecT () Text Identity Text
-> ParsecT () Text Identity String
-> ParsecT () Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity Char
-> ParsecT () Text Identity Text -> ParsecT () Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT () Text Identity Char
escaped ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT () Text Identity Char
ParsecT () Text Identity (Token Text)
regular) (Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
escaped :: ParsecT () Text Identity Char
escaped = Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( Char
'\n' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"n"
ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\r' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"r"
ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\t' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"t"
ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT () Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
)
regular :: ParsecT () Text Identity (Token Text)
regular = [Token Text] -> ParsecT () Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\\', Char
'"']
wrap :: Tokens s -> Tokens s -> f a -> f [a]
wrap Tokens s
o Tokens s
c f a
p =
Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
o f (Tokens s) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a -> f (Tokens s) -> f [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy f a
p (Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
",") f [a] -> f (Tokens s) -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
c
parens :: Parsec () Text a -> Parsec () Text [a]
parens :: Parsec () Text a -> Parsec () Text [a]
parens Parsec () Text a
p = Tokens Text
-> Tokens Text -> Parsec () Text a -> Parsec () Text [a]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
Tokens s -> Tokens s -> f a -> f [a]
wrap Tokens Text
"(" Tokens Text
")" Parsec () Text a
p
serializeList :: f a -> f [a]
serializeList f a
p = Tokens s -> Tokens s -> f a -> f [a]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
Tokens s -> Tokens s -> f a -> f [a]
wrap Tokens s
"[" Tokens s
"]" f a
p
parseFixed :: [(Text, Text, Text, Text)] -> (Maybe Store.SomeNamedDigest, HashMode)
parseFixed :: [(Text, Text, Text, Text)] -> (Maybe SomeNamedDigest, HashMode)
parseFixed [(Text, Text, Text, Text)]
fullOutputs = case [(Text, Text, Text, Text)]
fullOutputs of
[(Text
"out", Text
_path, Text
rht, Text
hash)] | Text
rht Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& Text
hash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" ->
let
(Text
hashType, HashMode
hashMode) = case Text -> Text -> [Text]
Text.splitOn Text
":" Text
rht of
[Text
"r", Text
ht] -> (Text
ht, HashMode
Recursive)
[Text
ht] -> (Text
ht, HashMode
Flat)
[Text]
_ -> Text -> (Text, HashMode)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Text, HashMode)) -> Text -> (Text, HashMode)
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported hash type for output of fixed-output derivation in .drv file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Text, Text, Text)] -> Text
forall b a. (Show a, IsString b) => a -> b
show [(Text, Text, Text, Text)]
fullOutputs
in
(String -> (Maybe SomeNamedDigest, HashMode))
-> (SomeNamedDigest -> (Maybe SomeNamedDigest, HashMode))
-> Either String SomeNamedDigest
-> (Maybe SomeNamedDigest, HashMode)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ String
err -> Text -> (Maybe SomeNamedDigest, HashMode)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Maybe SomeNamedDigest, HashMode))
-> Text -> (Maybe SomeNamedDigest, HashMode)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall b a. (Show a, IsString b) => a -> b
show (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Unsupported hash " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show (Text
hashType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hash) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"in .drv file: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err)
(\ SomeNamedDigest
digest -> (SomeNamedDigest -> Maybe SomeNamedDigest
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeNamedDigest
digest, HashMode
hashMode))
(Text -> Text -> Either String SomeNamedDigest
Store.mkNamedDigest Text
hashType Text
hash)
[(Text, Text, Text, Text)]
_ -> (Maybe SomeNamedDigest
forall a. Maybe a
Nothing, HashMode
Flat)
defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, AttrSet Text) m) => NValue t f m -> m (NValue t f m)
defaultDerivationStrict :: NValue t f m -> m (NValue t f m)
defaultDerivationStrict NValue t f m
val = do
AttrSet (NValue t f m)
s <- NValue t f m -> m (AttrSet (NValue t f m))
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue @(AttrSet (NValue t f m)) NValue t f m
val
(Derivation
drv, HashSet StringContext
ctx) <- WithStringContextT m Derivation
-> m (Derivation, HashSet StringContext)
forall (m :: * -> *) a.
Monad m =>
WithStringContextT m a -> m (a, HashSet StringContext)
runWithStringContextT' (WithStringContextT m Derivation
-> m (Derivation, HashSet StringContext))
-> WithStringContextT m Derivation
-> m (Derivation, HashSet StringContext)
forall a b. (a -> b) -> a -> b
$ AttrSet (NValue t f m) -> WithStringContextT m Derivation
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext AttrSet (NValue t f m)
s
StorePathName
drvName <- Text -> m StorePathName
forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName (Text -> m StorePathName) -> Text -> m StorePathName
forall a b. (a -> b) -> a -> b
$ Derivation -> Text
name Derivation
drv
let
inputs :: (Set Text, Map Text [Text])
inputs = HashSet StringContext -> (Set Text, Map Text [Text])
forall (t :: * -> *).
Foldable t =>
t StringContext -> (Set Text, Map Text [Text])
toStorePaths HashSet StringContext
ctx
ifNotJsonModEnv :: (Map Text Text -> Map Text Text) -> Map Text Text
ifNotJsonModEnv Map Text Text -> Map Text Text
f =
(Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Bool
-> Map Text Text
-> Map Text Text
forall a. a -> a -> Bool -> a
bool Map Text Text -> Map Text Text
f Map Text Text -> Map Text Text
forall a. a -> a
id (Derivation -> Bool
useJson Derivation
drv)
(Derivation -> Map Text Text
env Derivation
drv)
Derivation
drv' <- case Derivation -> Maybe SomeNamedDigest
mFixed Derivation
drv of
Just (Store.SomeDigest Digest a
digest) -> do
let
out :: Text
out = StorePath -> Text
pathToText (StorePath -> Text) -> StorePath -> Text
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Digest a -> StorePathName -> StorePath
forall hashAlgo.
NamedAlgo hashAlgo =>
String -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
Store.makeFixedOutputPath String
"/nix/store" (Derivation -> HashMode
hashMode Derivation
drv HashMode -> HashMode -> Bool
forall a. Eq a => a -> a -> Bool
== HashMode
Recursive) Digest a
digest StorePathName
drvName
env' :: Map Text Text
env' = (Map Text Text -> Map Text Text) -> Map Text Text
ifNotJsonModEnv ((Map Text Text -> Map Text Text) -> Map Text Text)
-> (Map Text Text -> Map Text Text) -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"out" Text
out
Derivation -> m Derivation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Derivation -> m Derivation) -> Derivation -> m Derivation
forall a b. (a -> b) -> a -> b
$ Derivation
drv { (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs, env :: Map Text Text
env = Map Text Text
env', outputs :: Map Text Text
outputs = OneItem (Map Text Text) -> Map Text Text
forall x. One x => OneItem x -> x
one (Text
"out", Text
out) }
Maybe SomeNamedDigest
Nothing -> do
Digest SHA256
hash <- Derivation -> m (Digest SHA256)
forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, HashMap Text Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo (Derivation -> m (Digest SHA256))
-> Derivation -> m (Digest SHA256)
forall a b. (a -> b) -> a -> b
$ Derivation
drv
{ (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs
, env :: Map Text Text
env =
(Map Text Text -> Map Text Text) -> Map Text Text
ifNotJsonModEnv
(\ Map Text Text
baseEnv ->
(Map Text Text -> Text -> Map Text Text)
-> Map Text Text -> [Text] -> Map Text Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(\Map Text Text
m Text
k -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k Text
"" Map Text Text
m)
Map Text Text
baseEnv
(Map Text Text -> [Text]
forall k a. Map k a -> [k]
Map.keys (Map Text Text -> [Text]) -> Map Text Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Derivation -> Map Text Text
outputs Derivation
drv)
)
}
Map Text Text
outputs' <- Map Text (m Text) -> m (Map Text Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Map Text (m Text) -> m (Map Text Text))
-> Map Text (m Text) -> m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> m Text) -> Map Text Text -> Map Text (m Text)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Text
o Text
_ -> Text -> Digest SHA256 -> StorePathName -> m Text
forall (f :: * -> *) e h.
(MonadReader e f, Has e Frames, MonadThrow f, NamedAlgo h) =>
Text -> Digest h -> StorePathName -> f Text
makeOutputPath Text
o Digest SHA256
hash StorePathName
drvName) (Map Text Text -> Map Text (m Text))
-> Map Text Text -> Map Text (m Text)
forall a b. (a -> b) -> a -> b
$ Derivation -> Map Text Text
outputs Derivation
drv
pure $ Derivation
drv
{ (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
inputs
, outputs :: Map Text Text
outputs = Map Text Text
outputs'
, env :: Map Text Text
env = (Map Text Text -> Map Text Text) -> Map Text Text
ifNotJsonModEnv ((Map Text Text -> Map Text Text) -> Map Text Text)
-> (Map Text Text -> Map Text Text) -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (Map Text Text
outputs' Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>)
}
Text
drvPath <- StorePath -> Text
pathToText (StorePath -> Text) -> m StorePath -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Derivation -> m StorePath
forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Derivation -> m StorePath
writeDerivation Derivation
drv'
Text
drvHash <- BaseEncoding -> Digest SHA256 -> Text
forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 (Digest SHA256 -> Text) -> m (Digest SHA256) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Derivation -> m (Digest SHA256)
forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, HashMap Text Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo Derivation
drv'
((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ())
-> ((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ()
forall a b. (a -> b) -> a -> b
$ (HashMap Text Text -> HashMap Text Text)
-> (b, HashMap Text Text) -> (b, HashMap Text Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((HashMap Text Text -> HashMap Text Text)
-> (b, HashMap Text Text) -> (b, HashMap Text Text))
-> (HashMap Text Text -> HashMap Text Text)
-> (b, HashMap Text Text)
-> (b, HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
MS.insert Text
drvPath Text
drvHash
let
outputsWithContext :: Map Text NixString
outputsWithContext =
(Text -> Text -> NixString) -> Map Text Text -> Map Text NixString
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
(\Text
out Text
path -> Text -> StringContext -> NixString
makeNixStringWithSingletonContext Text
path (StringContext -> NixString) -> StringContext -> NixString
forall a b. (a -> b) -> a -> b
$ Text -> ContextFlavor -> StringContext
StringContext Text
drvPath (ContextFlavor -> StringContext) -> ContextFlavor -> StringContext
forall a b. (a -> b) -> a -> b
$ Text -> ContextFlavor
DerivationOutput Text
out)
(Derivation -> Map Text Text
outputs Derivation
drv')
drvPathWithContext :: NixString
drvPathWithContext = Text -> StringContext -> NixString
makeNixStringWithSingletonContext Text
drvPath (StringContext -> NixString) -> StringContext -> NixString
forall a b. (a -> b) -> a -> b
$ Text -> ContextFlavor -> StringContext
StringContext Text
drvPath ContextFlavor
AllOutputs
attrSet :: HashMap Text (NValue t f m)
attrSet = NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
nvStr (NixString -> NValue t f m)
-> HashMap Text NixString -> HashMap Text (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, NixString)] -> HashMap Text NixString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ((Text
"drvPath", NixString
drvPathWithContext) (Text, NixString) -> [(Text, NixString)] -> [(Text, NixString)]
forall a. a -> [a] -> [a]
: Map Text NixString -> [(Text, NixString)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text NixString
outputsWithContext)
NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
nvSet AttrSet SourcePos
forall a. Monoid a => a
mempty AttrSet (NValue t f m)
forall t (m :: * -> *). HashMap Text (NValue t f m)
attrSet
where
pathToText :: StorePath -> Text
pathToText = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (StorePath -> ByteString) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> ByteString
Store.storePathToRawFilePath
makeOutputPath :: Text -> Digest h -> StorePathName -> f Text
makeOutputPath Text
o Digest h
h StorePathName
n = do
StorePathName
name <- Text -> f StorePathName
forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName (Text -> f StorePathName) -> Text -> f StorePathName
forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
Store.unStorePathName StorePathName
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text
o Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"out" then Text
"" else Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o
pure $ StorePath -> Text
pathToText (StorePath -> Text) -> StorePath -> Text
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Digest h -> StorePathName -> StorePath
forall h.
NamedAlgo h =>
String -> ByteString -> Digest h -> StorePathName -> StorePath
Store.makeStorePath String
"/nix/store" (ByteString
"output:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
o) Digest h
h StorePathName
name
toStorePaths :: t StringContext -> (Set Text, Map Text [Text])
toStorePaths t StringContext
ctx = ((Set Text, Map Text [Text])
-> StringContext -> (Set Text, Map Text [Text]))
-> (Set Text, Map Text [Text])
-> t StringContext
-> (Set Text, Map Text [Text])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((StringContext
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text]))
-> (Set Text, Map Text [Text])
-> StringContext
-> (Set Text, Map Text [Text])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StringContext
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
forall (p :: * -> * -> *).
Bifunctor p =>
StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs) (Set Text
forall a. Monoid a => a
mempty, Map Text [Text]
forall a. Monoid a => a
mempty) t StringContext
ctx
addToInputs :: StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs (StringContext Text
path ContextFlavor
kind) = case ContextFlavor
kind of
ContextFlavor
DirectPath -> (Set Text -> Set Text)
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
path)
DerivationOutput Text
o -> (Map Text [Text] -> Map Text [Text])
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Text] -> [Text] -> [Text])
-> Text -> [Text] -> Map Text [Text] -> Map Text [Text]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) Text
path [Text
o])
ContextFlavor
AllOutputs ->
Text
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Not implemented: derivations depending on a .drv file are not yet supported."
buildDerivationWithContext :: forall e t f m. (MonadNix e t f m) => AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext :: AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext AttrSet (NValue t f m)
drvAttrs = do
Text
drvName <- Text
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
"name" ((NixString -> WithStringContextT m Text)
-> WithStringContextT m Text)
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m Text
Text -> WithStringContextT m Text
assertDrvStoreName (Text -> WithStringContextT m Text)
-> (NixString -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString
NixLevel
-> ErrorCall
-> WithStringContextT m Derivation
-> WithStringContextT m Derivation
forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
Info (String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"While evaluating derivation " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
drvName) (WithStringContextT m Derivation
-> WithStringContextT m Derivation)
-> WithStringContextT m Derivation
-> WithStringContextT m Derivation
forall a b. (a -> b) -> a -> b
$ do
Bool
useJson <- Text
-> Bool
-> (Bool -> WithStringContextT m Bool)
-> WithStringContextT m Bool
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"__structuredAttrs" Bool
False Bool -> WithStringContextT m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Bool
ignoreNulls <- Text
-> Bool
-> (Bool -> WithStringContextT m Bool)
-> WithStringContextT m Bool
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"__ignoreNulls" Bool
False Bool -> WithStringContextT m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[Text]
args <- Text
-> [Text]
-> ([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text]
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"args" [Text]
forall a. Monoid a => a
mempty (([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text])
-> ([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text]
forall a b. (a -> b) -> a -> b
$ (NValue t f m -> WithStringContextT m Text)
-> [NValue t f m] -> WithStringContextT m [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString (NixString -> WithStringContextT m Text)
-> (NValue t f m -> WithStringContextT m NixString)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> WithStringContextT m NixString
forall a.
(FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) =>
NValue t f m -> WithStringContextT m a
fromValue')
Text
builder <- Text
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
"builder" NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString
Text
platform <- Text
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
"system" ((NixString -> WithStringContextT m Text)
-> WithStringContextT m Text)
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m Text
Text -> WithStringContextT m Text
assertNonNull (Text -> WithStringContextT m Text)
-> (NixString -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx
Maybe Text
mHash <- Text
-> Maybe Text
-> (NixString -> WithStringContextT m (Maybe Text))
-> WithStringContextT m (Maybe Text)
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"outputHash" Maybe Text
forall a. Monoid a => a
mempty ((NixString -> WithStringContextT m (Maybe Text))
-> WithStringContextT m (Maybe Text))
-> (NixString -> WithStringContextT m (Maybe Text))
-> WithStringContextT m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> WithStringContextT m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> WithStringContextT m (Maybe Text))
-> (Text -> Maybe Text)
-> Text
-> WithStringContextT m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Text -> WithStringContextT m (Maybe Text))
-> (NixString -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx
HashMode
hashMode <- Text
-> HashMode
-> (NixString -> WithStringContextT m HashMode)
-> WithStringContextT m HashMode
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"outputHashMode" HashMode
Flat ((NixString -> WithStringContextT m HashMode)
-> WithStringContextT m HashMode)
-> (NixString -> WithStringContextT m HashMode)
-> WithStringContextT m HashMode
forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m HashMode
Text -> WithStringContextT m HashMode
parseHashMode (Text -> WithStringContextT m HashMode)
-> (NixString -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m HashMode
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx
[Text]
outputs <- Text
-> [Text]
-> ([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text]
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
"outputs" [Text
"out"] (([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text])
-> ([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text]
forall a b. (a -> b) -> a -> b
$ (NValue t f m -> WithStringContextT m Text)
-> [NValue t f m] -> WithStringContextT m [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx (NixString -> WithStringContextT m Text)
-> (NValue t f m -> WithStringContextT m NixString)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> WithStringContextT m NixString
forall a.
(FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) =>
NValue t f m -> WithStringContextT m a
fromValue')
Maybe SomeNamedDigest
mFixedOutput <-
WithStringContextT m (Maybe SomeNamedDigest)
-> (Text -> WithStringContextT m (Maybe SomeNamedDigest))
-> Maybe Text
-> WithStringContextT m (Maybe SomeNamedDigest)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe SomeNamedDigest
-> WithStringContextT m (Maybe SomeNamedDigest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeNamedDigest
forall a. Maybe a
Nothing)
(\ Text
hash -> do
Bool -> WithStringContextT m () -> WithStringContextT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
outputs [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text
"out"]) (WithStringContextT m () -> WithStringContextT m ())
-> WithStringContextT m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ m () -> WithStringContextT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithStringContextT m ())
-> m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m ()
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m ()) -> ErrorCall -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Multiple outputs are not supported for fixed-output derivations"
Text
hashType <- Text
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
"outputHashAlgo" MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx
SomeNamedDigest
digest <- m SomeNamedDigest -> WithStringContextT m SomeNamedDigest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SomeNamedDigest -> WithStringContextT m SomeNamedDigest)
-> m SomeNamedDigest -> WithStringContextT m SomeNamedDigest
forall a b. (a -> b) -> a -> b
$ (String -> m SomeNamedDigest)
-> (SomeNamedDigest -> m SomeNamedDigest)
-> Either String SomeNamedDigest
-> m SomeNamedDigest
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorCall -> m SomeNamedDigest
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m SomeNamedDigest)
-> (String -> ErrorCall) -> String -> m SomeNamedDigest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall) SomeNamedDigest -> m SomeNamedDigest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SomeNamedDigest -> m SomeNamedDigest)
-> Either String SomeNamedDigest -> m SomeNamedDigest
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Either String SomeNamedDigest
Store.mkNamedDigest Text
hashType Text
hash
pure $ SomeNamedDigest -> Maybe SomeNamedDigest
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeNamedDigest
digest)
Maybe Text
mHash
AttrSet (NValue t f m)
attrs <-
m (AttrSet (NValue t f m))
-> WithStringContextT m (AttrSet (NValue t f m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (AttrSet (NValue t f m))
-> WithStringContextT m (AttrSet (NValue t f m)))
-> m (AttrSet (NValue t f m))
-> WithStringContextT m (AttrSet (NValue t f m))
forall a b. (a -> b) -> a -> b
$
m (AttrSet (NValue t f m))
-> m (AttrSet (NValue t f m)) -> Bool -> m (AttrSet (NValue t f m))
forall a. a -> a -> Bool -> a
bool
(AttrSet (NValue t f m) -> m (AttrSet (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet (NValue t f m)
drvAttrs)
((Maybe (NValue t f m) -> Maybe (NValue t f m))
-> HashMap Text (Maybe (NValue t f m)) -> AttrSet (NValue t f m)
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
M.mapMaybe Maybe (NValue t f m) -> Maybe (NValue t f m)
forall a. a -> a
id (HashMap Text (Maybe (NValue t f m)) -> AttrSet (NValue t f m))
-> m (HashMap Text (Maybe (NValue t f m)))
-> m (AttrSet (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(NValue t f m -> m (Maybe (NValue t f m)))
-> AttrSet (NValue t f m)
-> m (HashMap Text (Maybe (NValue t f m)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
((NValue t f m -> Maybe (NValue t f m))
-> m (NValue t f m) -> m (Maybe (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\case
NVConstant NAtom
NNull -> Maybe (NValue t f m)
forall a. Maybe a
Nothing
NValue t f m
_value -> NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
_value
)
(m (NValue t f m) -> m (Maybe (NValue t f m)))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (Maybe (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
)
AttrSet (NValue t f m)
drvAttrs
)
Bool
ignoreNulls
Map Text Text
env <- if Bool
useJson
then do
NixString
jsonString :: NixString <- m NixString -> WithStringContextT m NixString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NixString -> WithStringContextT m NixString)
-> m NixString -> WithStringContextT m NixString
forall a b. (a -> b) -> a -> b
$ NValue t f m -> m NixString
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m NixString
nvalueToJSONNixString (NValue t f m -> m NixString) -> NValue t f m -> m NixString
forall a b. (a -> b) -> a -> b
$ AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
nvSet AttrSet SourcePos
forall a. Monoid a => a
mempty (AttrSet (NValue t f m) -> NValue t f m)
-> AttrSet (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$
[Text] -> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
forall a. [Text] -> AttrSet a -> AttrSet a
deleteKeys [ Text
"args", Text
"__ignoreNulls", Text
"__structuredAttrs" ] AttrSet (NValue t f m)
attrs
Text
rawString :: Text <- NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString NixString
jsonString
pure $ OneItem (Map Text Text) -> Map Text Text
forall x. One x => OneItem x -> x
one (Text
"__json", Text
rawString)
else
(NValue t f m -> WithStringContextT m Text)
-> Map Text (NValue t f m) -> WithStringContextT m (Map Text Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString (NixString -> WithStringContextT m Text)
-> (NValue t f m -> WithStringContextT m NixString)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m NixString -> WithStringContextT m NixString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NixString -> WithStringContextT m NixString)
-> (NValue t f m -> m NixString)
-> NValue t f m
-> WithStringContextT m NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
forall e (m :: * -> *) t (f :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
coerceToString NValue t f m -> NValue t f m -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc CopyToStoreMode
CopyToStore CoercionLevel
CoerceAny) (Map Text (NValue t f m) -> WithStringContextT m (Map Text Text))
-> Map Text (NValue t f m) -> WithStringContextT m (Map Text Text)
forall a b. (a -> b) -> a -> b
$
[(Text, NValue t f m)] -> Map Text (NValue t f m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, NValue t f m)] -> Map Text (NValue t f m))
-> [(Text, NValue t f m)] -> Map Text (NValue t f m)
forall a b. (a -> b) -> a -> b
$ AttrSet (NValue t f m) -> [(Text, NValue t f m)]
forall k v. HashMap k v -> [(k, v)]
M.toList (AttrSet (NValue t f m) -> [(Text, NValue t f m)])
-> AttrSet (NValue t f m) -> [(Text, NValue t f m)]
forall a b. (a -> b) -> a -> b
$ [Text] -> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
forall a. [Text] -> AttrSet a -> AttrSet a
deleteKeys [ Text
"args", Text
"__ignoreNulls" ] AttrSet (NValue t f m)
attrs
pure $ Derivation :: Text
-> Map Text Text
-> (Set Text, Map Text [Text])
-> Text
-> Text
-> [Text]
-> Map Text Text
-> Maybe SomeNamedDigest
-> HashMode
-> Bool
-> Derivation
Derivation { Text
platform :: Text
platform :: Text
platform, Text
builder :: Text
builder :: Text
builder, [Text]
args :: [Text]
args :: [Text]
args, Map Text Text
env :: Map Text Text
env :: Map Text Text
env, HashMode
hashMode :: HashMode
hashMode :: HashMode
hashMode, Bool
useJson :: Bool
useJson :: Bool
useJson
, name :: Text
name = Text
drvName
, outputs :: Map Text Text
outputs = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (, Text
forall a. Monoid a => a
mempty) (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
outputs
, mFixed :: Maybe SomeNamedDigest
mFixed = Maybe SomeNamedDigest
mFixedOutput
, inputs :: (Set Text, Map Text [Text])
inputs = (Set Text
forall a. Monoid a => a
mempty, Map Text [Text]
forall a. Monoid a => a
mempty)
}
where
fromValue' :: (FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) => NValue t f m -> WithStringContextT m a
fromValue' :: NValue t f m -> WithStringContextT m a
fromValue' = m a -> WithStringContextT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithStringContextT m a)
-> (NValue t f m -> m a) -> NValue t f m -> WithStringContextT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> m a
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue
withFrame' :: (Framed e m, Exception s) => NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' :: NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
level s
f = WithStringContextT m (WithStringContextT m a)
-> WithStringContextT m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (WithStringContextT m (WithStringContextT m a)
-> WithStringContextT m a)
-> (WithStringContextT m a
-> WithStringContextT m (WithStringContextT m a))
-> WithStringContextT m a
-> WithStringContextT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (WithStringContextT m a)
-> WithStringContextT m (WithStringContextT m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (WithStringContextT m a)
-> WithStringContextT m (WithStringContextT m a))
-> (WithStringContextT m a -> m (WithStringContextT m a))
-> WithStringContextT m a
-> WithStringContextT m (WithStringContextT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixLevel
-> s -> m (WithStringContextT m a) -> m (WithStringContextT m a)
forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
level s
f (m (WithStringContextT m a) -> m (WithStringContextT m a))
-> (WithStringContextT m a -> m (WithStringContextT m a))
-> WithStringContextT m a
-> m (WithStringContextT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithStringContextT m a -> m (WithStringContextT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
getAttrOr' :: forall v a. (MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m)))
=> Text -> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' :: Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' Text
n m a
d v -> WithStringContextT m a
f = case Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
n AttrSet (NValue t f m)
drvAttrs of
Maybe (NValue t f m)
Nothing -> m a -> WithStringContextT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
d
Just NValue t f m
v -> NixLevel
-> ErrorCall -> WithStringContextT m a -> WithStringContextT m a
forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
Info (String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"While evaluating attribute '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'") (WithStringContextT m a -> WithStringContextT m a)
-> WithStringContextT m a -> WithStringContextT m a
forall a b. (a -> b) -> a -> b
$
v -> WithStringContextT m a
f (v -> WithStringContextT m a)
-> WithStringContextT m v -> WithStringContextT m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> WithStringContextT m v
forall a.
(FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) =>
NValue t f m -> WithStringContextT m a
fromValue' NValue t f m
v
getAttrOr :: Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
n a
d v -> WithStringContextT m a
f = Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
forall v a.
(MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m))) =>
Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' Text
n (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
d) v -> WithStringContextT m a
f
getAttr :: Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
n = Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
forall v a.
(MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m))) =>
Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' Text
n (ErrorCall -> m a
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m a) -> ErrorCall -> m a
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Required attribute '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' not found.")
assertDrvStoreName :: MonadNix e t f m => Text -> WithStringContextT m Text
assertDrvStoreName :: Text -> WithStringContextT m Text
assertDrvStoreName Text
name = m Text -> WithStringContextT m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text -> WithStringContextT m Text)
-> m Text -> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ do
let invalid :: Char -> Bool
invalid Char
c = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
"+-._?=" :: String))
let failWith :: String -> m a
failWith String
reason = ErrorCall -> m a
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m a) -> ErrorCall -> m a
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Store name " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
reason
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"." Text -> Text -> Bool
`Text.isPrefixOf` Text
name) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e (m :: * -> *) a.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"cannot start with a period"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
Text.length Text
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
211) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e (m :: * -> *) a.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"must be no longer than 211 characters"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
invalid Text
name) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e (m :: * -> *) a.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"contains some invalid character"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
".drv" Text -> Text -> Bool
`Text.isSuffixOf` Text
name) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e (m :: * -> *) a.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"is not allowed to end in '.drv'"
pure Text
name
extractNoCtx :: MonadNix e t f m => NixString -> WithStringContextT m Text
extractNoCtx :: NixString -> WithStringContextT m Text
extractNoCtx NixString
ns =
WithStringContextT m Text
-> (Text -> WithStringContextT m Text)
-> Maybe Text
-> WithStringContextT m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(m Text -> WithStringContextT m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text -> WithStringContextT m Text)
-> m Text -> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m Text
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Text) -> ErrorCall -> m Text
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"The string " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NixString -> String
forall b a. (Show a, IsString b) => a -> b
show NixString
ns String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not allowed to have a context.")
Text -> WithStringContextT m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(NixString -> Maybe Text
getStringNoContext NixString
ns)
assertNonNull :: MonadNix e t f m => Text -> WithStringContextT m Text
assertNonNull :: Text -> WithStringContextT m Text
assertNonNull Text
t = do
Bool -> WithStringContextT m () -> WithStringContextT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
t) (WithStringContextT m () -> WithStringContextT m ())
-> WithStringContextT m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ m () -> WithStringContextT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithStringContextT m ())
-> m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m ()
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m ()) -> ErrorCall -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Value must not be empty"
pure Text
t
parseHashMode :: MonadNix e t f m => Text -> WithStringContextT m HashMode
parseHashMode :: Text -> WithStringContextT m HashMode
parseHashMode = \case
Text
"flat" -> HashMode -> WithStringContextT m HashMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMode
Flat
Text
"recursive" -> HashMode -> WithStringContextT m HashMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMode
Recursive
Text
other -> m HashMode -> WithStringContextT m HashMode
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m HashMode -> WithStringContextT m HashMode)
-> m HashMode -> WithStringContextT m HashMode
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m HashMode
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m HashMode) -> ErrorCall -> m HashMode
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Hash mode " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
other String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not valid. It must be either 'flat' or 'recursive'"
deleteKeys :: [Text] -> AttrSet a -> AttrSet a
deleteKeys :: [Text] -> AttrSet a -> AttrSet a
deleteKeys [Text]
keys AttrSet a
attrSet = (AttrSet a -> Text -> AttrSet a)
-> AttrSet a -> [Text] -> AttrSet a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> AttrSet a -> AttrSet a) -> AttrSet a -> Text -> AttrSet a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> AttrSet a -> AttrSet a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete) AttrSet a
attrSet [Text]
keys