{-# language DataKinds #-}
{-# language NamedFieldPuns #-}
{-# language RecordWildCards #-}
{-# language PackageImports #-}
module Nix.Effects.Derivation ( defaultDerivationStrict ) where
import Nix.Prelude hiding ( readFile )
import GHC.Exception ( ErrorCall(ErrorCall) )
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.Expr.Types hiding ( Recursive )
import Nix.Convert
import Nix.Effects
import Nix.Exec ( MonadNix
, callFunc
)
import Nix.Frames
import Nix.Json ( toJSONNixString )
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
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
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
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
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 :: forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName Text
name = case Text -> Either String StorePathName
Store.makeStorePathName Text
name of
Left String
err -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Invalid name '" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
name forall a. Semigroup a => a -> a -> a
<> String
"' for use in a store path: " forall a. Semigroup a => a -> a -> a
<> String
err
Right StorePathName
spname -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StorePathName
spname
parsePath :: (Framed e m) => Text -> m Store.StorePath
parsePath :: forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath Text
p = case String -> ByteString -> Either String StorePath
Store.parsePath String
"/nix/store" (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
p) of
Left String
err -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Cannot parse store path " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
p forall a. Semigroup a => a -> a -> a
<> String
":\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show String
err
Right StorePath
path -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StorePath
path
writeDerivation :: (Framed e m, MonadStore m) => Derivation -> m Store.StorePath
writeDerivation :: forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
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 <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath (forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ Set Text
inputSrcs forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList (forall k a. Map k a -> [k]
Map.keys Map Text [Text]
inputDrvs))
StorePath
path <- 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) (forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set StorePath
references) Bool
False
forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce StorePath
path
hashDerivationModulo :: (MonadNix e t f m, MonadState (b, KeyMap Text) m) => Derivation -> m (Hash.Digest Hash.SHA256)
hashDerivationModulo :: forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, KeyMap Text) m) =>
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 forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
outputs of
[(Text
"out", Text
path)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash @ByteString @Hash.SHA256 forall a b. (a -> b) -> a -> b
$
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$
Text
"fixed:out"
forall a. Semigroup a => a -> a -> a
<> (if HashMode
hashMode forall a. Eq a => a -> a -> Bool
== HashMode
Recursive then Text
":r" else forall a. Monoid a => a
mempty)
forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> (forall a. NamedAlgo a => Text
Store.algoName @hashType)
forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 Digest a
digest
forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
path
[(Text, Text)]
_outputsList -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"This is weird. A fixed output drv should only have one output named 'out'. Got " forall a. Semigroup a => a -> a -> a
<> 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
KeyMap Text
cache <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a, b) -> b
snd
Map Text [Text]
inputsModulo <-
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(\(Text
path, [Text]
outs) ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(do
Derivation
drv' <- forall e (m :: * -> *).
(Framed e m, MonadFile m) =>
Path -> m Derivation
readDerivation forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString Text
path
Text
hash <- forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, KeyMap Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo Derivation
drv'
pure (Text
hash, [Text]
outs)
)
(\ Text
hash -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
hash, [Text]
outs))
(forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
path KeyMap Text
cache)
)
(forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Text]
inputDrvs)
pure $ forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash @ByteString @Hash.SHA256 forall a b. (a -> b) -> a -> b
$ forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Derivation -> Text
unparseDrv 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"
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
parens
[
[Text] -> Text
serializeList forall a b. (a -> b) -> a -> b
$
(Text, Text) -> Text
produceOutputInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
outputs
,
[Text] -> Text
serializeList forall a b. (a -> b) -> a -> b
$
(\(Text
path, [Text]
outs) ->
[Text] -> Text
parens [Text -> Text
s Text
path, [Text] -> Text
serializeList forall a b. (a -> b) -> a -> b
$ Text -> Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ord a => [a] -> [a]
sort [Text]
outs]
) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList (forall a b. (a, b) -> b
snd (Set Text, Map Text [Text])
inputs)
,
[Text] -> Text
serializeList forall a b. (a -> b) -> a -> b
$ Text -> Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList (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 forall a b. (a -> b) -> a -> b
$ Text -> Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args
,
[Text] -> Text
serializeList forall a b. (a -> b) -> a -> b
$ (\(Text
k, Text
v) -> [Text] -> Text
parens [Text -> Text
s Text
k, Text -> Text
s Text
v]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== HashMode
Recursive then Text
"r:" else forall a. Monoid a => a
mempty in
[Text] -> Text
parens forall a b. (a -> b) -> a -> b
$ (Text -> Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$ ([Text
outputName, Text
outputPath] forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty]
(\ (Store.SomeDigest (Digest a
digest :: Hash.Digest hashType)) ->
[Text
prefix forall a. Semigroup a => a -> a -> a
<> forall a. NamedAlgo a => Text
Store.algoName @hashType, 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
'\"' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text
`Text.snoc` Char
'\"') 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 = forall x. One x => OneItem x -> x
one Char
c
readDerivation :: (Framed e m, MonadFile m) => Path -> m Derivation
readDerivation :: forall e (m :: * -> *).
(Framed e m, MonadFile m) =>
Path -> m Derivation
readDerivation Path
path = do
Text
content <- forall (m :: * -> *). MonadFile m => Path -> m Text
readFile Path
path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ ParseErrorBundle Text ()
err -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Failed to parse " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Path
path forall a. Semigroup a => a -> a -> a
<> String
":\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show ParseErrorBundle Text ()
err)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec () Text Derivation
derivationParser (coerce :: forall a b. Coercible a b => a -> b
coerce Path
path) Text
content)
derivationParser :: Parsec () Text Derivation
derivationParser :: Parsec () Text Derivation
derivationParser = do
Text
_ <- ParsecT () Text Identity Text
"Derive("
[(Text, Text, Text, Text)]
fullOutputs <- forall a. Parsec () Text a -> Parsec () Text [a]
serializeList forall a b. (a -> b) -> a -> b
$
(\[Text
n, Text
p, Text
ht, Text
h] -> (Text
n, Text
p, Text
ht, Text
h)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Map Text [Text]
inputDrvs <- forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec () Text a -> Parsec () Text [a]
serializeList
(forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (ParsecT () Text Identity Text
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity Text
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
",") (forall a. Parsec () Text a -> Parsec () Text [a]
serializeList ParsecT () Text Identity Text
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
")"))
Text
_ <- ParsecT () Text Identity Text
","
Set Text
inputSrcs <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec () Text a -> Parsec () Text [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 <- forall a. Parsec () Text a -> Parsec () Text [a]
serializeList ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
","
Map Text Text
env <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a. Parsec () Text a -> Parsec () Text [a]
serializeList forall a b. (a -> b) -> a -> b
$ (\[Text
a, Text
b] -> (Text
a, Text
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
Text
_ <- ParsecT () Text Identity Text
")"
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
let outputs :: Map Text Text
outputs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (\(Text
a, Text
b, Text
_, Text
_) -> (Text
a, Text
b)) 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 = forall a. Monoid a => a
mempty
let useJson :: Bool
useJson = forall x. One x => OneItem x -> x
one Text
"__json" forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> [k]
Map.keys Map Text Text
env
pure $ 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT () Text Identity Char
escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT () Text Identity (Token Text)
regular) (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
escaped :: ParsecT () Text Identity Char
escaped = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( Char
'\n' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"n"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\r' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"r"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\t' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"t"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
)
regular :: ParsecT () Text Identity (Token Text)
regular = 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 =
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
o forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy f a
p (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
",") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 :: forall a. Parsec () Text a -> Parsec () Text [a]
parens = forall {f :: * -> *} {e} {s} {a}.
(MonadParsec e s f, IsString (Tokens s)) =>
Tokens s -> Tokens s -> f a -> f [a]
wrap Tokens Text
"(" Tokens Text
")"
serializeList :: Parsec () Text a -> Parsec () Text [a]
serializeList :: forall a. Parsec () Text a -> Parsec () Text [a]
serializeList = forall {f :: * -> *} {e} {s} {a}.
(MonadParsec e s f, IsString (Tokens s)) =>
Tokens s -> Tokens s -> f a -> f [a]
wrap Tokens Text
"[" Tokens Text
"]"
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 forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Text
hash forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty ->
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]
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Unsupported hash type for output of fixed-output derivation in .drv file: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [(Text, Text, Text, Text)]
fullOutputs
in
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ String
err -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$ String
"Unsupported hash " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (Text
hashType forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
hash) forall a. Semigroup a => a -> a -> a
<> String
"in .drv file: " forall a. Semigroup a => a -> a -> a
<> String
err)
(\ SomeNamedDigest
digest -> (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)]
_ -> (forall a. Maybe a
Nothing, HashMode
Flat)
defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, KeyMap Text) m) => NValue t f m -> m (NValue t f m)
defaultDerivationStrict :: forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, KeyMap Text) m) =>
NValue t f m -> m (NValue t f m)
defaultDerivationStrict NValue t f m
val = do
HashMap Text (NValue t f m)
s <- forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) <- forall (m :: * -> *) a.
Monad m =>
WithStringContextT m a -> m (a, HashSet StringContext)
runWithStringContextT' forall a b. (a -> b) -> a -> b
$ forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
KeyMap (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext HashMap Text (NValue t f m)
s
StorePathName
drvName <- forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName 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])
toStorePaths HashSet StringContext
ctx
ifNotJsonModEnv :: (Map Text Text -> Map Text Text) -> Map Text Text
ifNotJsonModEnv Map Text Text -> Map Text Text
f =
forall a. a -> a -> Bool -> a
bool Map Text Text -> Map Text Text
f 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 forall a b. (a -> b) -> a -> b
$ forall hashAlgo.
NamedAlgo hashAlgo =>
String -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
Store.makeFixedOutputPath String
"/nix/store" (Derivation -> HashMode
hashMode Derivation
drv 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 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"out" Text
out
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall x. One x => OneItem x -> x
one (Text
"out", Text
out) }
Maybe SomeNamedDigest
Nothing -> do
Digest SHA256
hash <- forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, KeyMap Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo 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 ->
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(\Map Text Text
m Text
k -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k forall a. Monoid a => a
mempty Map Text Text
m)
Map Text Text
baseEnv
(forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ Derivation -> Map Text Text
outputs Derivation
drv)
)
}
Map Text Text
outputs' <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Text
o 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) 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
outputs' forall a. Semigroup a => a -> a -> a
<>)
}
(coerce :: forall a b. Coercible a b => a -> b
coerce @Text @VarName -> VarName
drvPath) <- StorePath -> Text
pathToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Derivation -> m StorePath
writeDerivation Derivation
drv'
Text
drvHash <- forall a. BaseEncoding -> Digest a -> Text
Store.encodeDigestWith BaseEncoding
Store.Base16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, KeyMap Text) m) =>
Derivation -> m (Digest SHA256)
hashDerivationModulo Derivation
drv'
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
MS.insert (coerce :: forall a b. Coercible a b => a -> b
coerce VarName
drvPath) Text
drvHash
let
outputsWithContext :: Map Text NixString
outputsWithContext =
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
(\Text
out (coerce :: forall a b. Coercible a b => a -> b
coerce -> VarName
path) -> StringContext -> VarName -> NixString
mkNixStringWithSingletonContext (ContextFlavor -> VarName -> StringContext
StringContext (Text -> ContextFlavor
DerivationOutput Text
out) VarName
drvPath) VarName
path)
(Derivation -> Map Text Text
outputs Derivation
drv')
drvPathWithContext :: NixString
drvPathWithContext = StringContext -> VarName -> NixString
mkNixStringWithSingletonContext (ContextFlavor -> VarName -> StringContext
StringContext ContextFlavor
AllOutputs VarName
drvPath) VarName
drvPath
attrSet :: HashMap Text (Free (NValue' t f m) a)
attrSet = forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NixString -> Free (NValue' t w m) a
NVStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ((Text
"drvPath", NixString
drvPathWithContext) forall a. a -> [a] -> [a]
: forall k a. Map k a -> [(k, a)]
Map.toList Map Text NixString
outputsWithContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
PositionSet
-> AttrSet (Free (NValue' t w m) a) -> Free (NValue' t w m) a
NVSet forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys coerce :: forall a b. Coercible a b => a -> b
coerce forall {t} {m :: * -> *} {a}. HashMap Text (Free (NValue' t f m) a)
attrSet
where
pathToText :: StorePath -> Text
pathToText = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 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 <- forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
Store.unStorePathName StorePathName
n forall a. Semigroup a => a -> a -> a
<> if Text
o forall a. Eq a => a -> a -> Bool
== Text
"out" then forall a. Monoid a => a
mempty else Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
o
pure $ StorePath -> Text
pathToText forall a b. (a -> b) -> a -> b
$ forall h.
NamedAlgo h =>
String -> ByteString -> Digest h -> StorePathName -> StorePath
Store.makeStorePath String
"/nix/store" (ByteString
"output:" forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
o) Digest h
h StorePathName
name
toStorePaths :: HashSet StringContext -> (Set Text, Map Text [Text])
toStorePaths :: HashSet StringContext -> (Set Text, Map Text [Text])
toStorePaths = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (p :: * -> * -> *).
Bifunctor p =>
StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs) forall a. Monoid a => a
mempty
addToInputs :: Bifunctor p => StringContext -> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs :: forall (p :: * -> * -> *).
Bifunctor p =>
StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs (StringContext ContextFlavor
kind (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
path)) =
case ContextFlavor
kind of
ContextFlavor
DirectPath -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert Text
path
DerivationOutput Text
o -> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) Text
path forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one Text
o
ContextFlavor
AllOutputs ->
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) => KeyMap (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
KeyMap (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext KeyMap (NValue t f m)
drvAttrs = do
Text
drvName <- 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" forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m Text
assertDrvStoreName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString
forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
Info (String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"While evaluating derivation " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
drvName) forall a b. (a -> b) -> a -> b
$ do
Bool
useJson <- 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure
Bool
ignoreNulls <- 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure
[Text]
args <- 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" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 <- 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" forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString
Text
platform <- 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" forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m Text
assertNonNull 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
extractNoCtx
Maybe Text
mHash <- 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" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) 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
extractNoCtx
HashMode
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 forall a b. (a -> b) -> a -> b
$ MonadNix e t f m => Text -> WithStringContextT m HashMode
parseHashMode 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
extractNoCtx
[Text]
outputs <- 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" (forall x. One x => OneItem x -> x
one Text
"out") forall a b. (a -> b) -> a -> b
$ 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
extractNoCtx forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
(\ Text
hash -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
outputs forall a. Eq a => a -> a -> Bool
/= forall x. One x => OneItem x -> x
one Text
"out") forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Multiple outputs are not supported for fixed-output derivations"
Text
hashType <- 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
extractNoCtx
SomeNamedDigest
digest <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Either String SomeNamedDigest
Store.mkNamedDigest Text
hashType Text
hash
pure $ forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeNamedDigest
digest)
Maybe Text
mHash
KeyMap (NValue t f m)
attrs <-
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall a. a -> a -> Bool -> a
bool
(forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap (NValue t f m)
drvAttrs)
(forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
M.mapMaybe forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\case
NVConstant NAtom
NNull -> forall a. Maybe a
Nothing
NValue t f m
_value -> forall a. a -> Maybe a
Just NValue t f m
_value
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (m :: * -> *). MonadValue v m => v -> m v
demand
)
KeyMap (NValue t f m)
drvAttrs
)
Bool
ignoreNulls
Map Text Text
env <- if Bool
useJson
then do
NixString
jsonString :: NixString <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m NixString
toJSONNixString forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
PositionSet
-> AttrSet (Free (NValue' t w m) a) -> Free (NValue' t w m) a
NVSet forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$
forall a. [Text] -> KeyMap a -> KeyMap a
deleteKeys [ Text
"args", Text
"__ignoreNulls", Text
"__structuredAttrs" ] KeyMap (NValue t f m)
attrs
Text
rawString :: Text <- forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString NixString
jsonString
pure $ forall x. One x => OneItem x -> x
one (Text
"__json", Text
rawString)
else
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e t (f :: * -> *) (m :: * -> *).
(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 -> NValue t f m -> m NixString
coerceAnyToNixString 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) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList forall a b. (a -> b) -> a -> b
$ forall a. [Text] -> KeyMap a -> KeyMap a
deleteKeys [ Text
"args", Text
"__ignoreNulls" ] KeyMap (NValue t f m)
attrs
pure $ 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (, forall a. Monoid a => a
mempty) 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 = 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' :: 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' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
level s
f = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
level s
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: 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 m a
d v -> WithStringContextT m a
f = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
n KeyMap (NValue t f m)
drvAttrs of
Maybe (NValue t f m)
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
d
Just NValue t f m
v -> forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
Info (String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"While evaluating attribute '" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
n forall a. Semigroup a => a -> a -> a
<> String
"'") forall a b. (a -> b) -> a -> b
$
v -> WithStringContextT m a
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
getAttr :: Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
n = 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 (forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Required attribute '" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
n forall a. Semigroup a => a -> a -> a
<> String
"' not found.")
assertDrvStoreName :: MonadNix e t f m => Text -> WithStringContextT m Text
assertDrvStoreName :: MonadNix e t f m => Text -> WithStringContextT m Text
assertDrvStoreName Text
name = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
let invalid :: Char -> Bool
invalid Char
c = Bool -> Bool
not 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 forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
"+-._?=" :: String))
let failWith :: String -> m a
failWith String
reason = forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Store name " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
name forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
reason
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"." Text -> Text -> Bool
`Text.isPrefixOf` Text
name) forall a b. (a -> b) -> a -> b
$ forall {e} {m :: * -> *} {a}.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"cannot start with a period"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
Text.length Text
name forall a. Ord a => a -> a -> Bool
> Int
211) forall a b. (a -> b) -> a -> b
$ forall {e} {m :: * -> *} {a}.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"must be no longer than 211 characters"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
invalid Text
name) forall a b. (a -> b) -> a -> b
$ forall {e} {m :: * -> *} {a}.
(MonadReader e m, Has e Frames, MonadThrow m) =>
String -> m a
failWith String
"contains some invalid character"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
".drv" Text -> Text -> Bool
`Text.isSuffixOf` Text
name) forall a b. (a -> b) -> a -> b
$ 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 :: MonadNix e t f m => NixString -> WithStringContextT m Text
extractNoCtx NixString
ns =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"The string " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NixString
ns forall a. Semigroup a => a -> a -> a
<> String
" is not allowed to have a context.")
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 :: MonadNix e t f m => Text -> WithStringContextT m Text
assertNonNull Text
t = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
t) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError 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 :: MonadNix e t f m => Text -> WithStringContextT m HashMode
parseHashMode = \case
Text
"flat" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMode
Flat
Text
"recursive" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMode
Recursive
Text
other -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Hash mode " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
other forall a. Semigroup a => a -> a -> a
<> String
" is not valid. It must be either 'flat' or 'recursive'"
deleteKeys :: [Text] -> KeyMap a -> KeyMap a
deleteKeys :: forall a. [Text] -> KeyMap a -> KeyMap a
deleteKeys [Text]
keys KeyMap a
attrSet = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete) KeyMap a
attrSet [Text]
keys