{-# language DataKinds #-}
{-# language NamedFieldPuns #-}
{-# language RecordWildCards #-}
{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@

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 -- 2021-07-05: Attrocity of Haskell hashing situation, in HNix we ended-up with 2 hash package dependencies @{hashing, cryptonite}@

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


--  2021-07-17: NOTE: Derivation consists of @"keys"@ @"vals"@ (of text), so underlining type boundary currently stops here.
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 -- should be typed as a store path
  , 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. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorePath -> String
coerce StorePath
path

-- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash.
-- this avoids propagating changes to their .drv when the output hash stays the same.
hashDerivationModulo :: (MonadNix e t f m, MonadState (b, KeyMap 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
forall a. Monoid a => a
mempty)
          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' <- Path -> m Derivation
forall e (m :: * -> *).
(Framed e m, MonadFile m) =>
Path -> m Derivation
readDerivation (Path -> m Derivation) -> Path -> m Derivation
forall a b. (a -> b) -> a -> b
$ String -> Path
coerce (String -> Path) -> String -> Path
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
      [ -- outputs: [("out", "/nix/store/.....-out", "", ""), ...]
        [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
      , -- inputDrvs
        [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)
      , -- inputSrcs
        [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
      , -- run script args
        [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
      , -- env (key value pairs)
        [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
forall a. Monoid a => a
mempty 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) => Path -> m Derivation
readDerivation :: Path -> m Derivation
readDerivation Path
path = do
  Text
content <- Path -> m Text
forall (m :: * -> *). MonadFile m => Path -> m Text
readFile Path
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
<> Path -> String
forall b a. (Show a, IsString b) => a -> b
show Path
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 (Path -> String
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 <- Parsec () Text (Text, Text, Text, Text)
-> Parsec () Text [(Text, Text, Text, Text)]
forall a. Parsec () Text a -> Parsec () Text [a]
serializeList (Parsec () Text (Text, Text, Text, Text)
 -> Parsec () Text [(Text, Text, Text, Text)])
-> Parsec () Text (Text, Text, Text, Text)
-> Parsec () Text [(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]
-> Parsec () Text (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
<$> Parsec () Text (Text, [Text])
-> ParsecT () Text Identity [(Text, [Text])]
forall a. Parsec () Text a -> Parsec () Text [a]
serializeList
    ((Text -> [Text] -> (Text, [Text]))
-> ParsecT () Text Identity Text
-> ParsecT () Text Identity [Text]
-> Parsec () Text (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 a. Parsec () Text a -> Parsec () Text [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 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        <- ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [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
$ Parsec () Text (Text, Text)
-> ParsecT () Text Identity [(Text, Text)]
forall a. Parsec () Text a -> Parsec () Text [a]
serializeList (Parsec () Text (Text, Text)
 -> ParsecT () Text Identity [(Text, Text)])
-> Parsec () Text (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] -> Parsec () 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
")"
  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
forall a. Monoid a => a
mempty -- FIXME (extract from file path ?)
  let useJson :: Bool
useJson = OneItem [Text] -> [Text]
forall x. One x => OneItem x -> x
one OneItem [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. IsString a => String -> a
fromString (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 = 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
")"
  serializeList :: Parsec () Text a -> Parsec () Text [a]
  serializeList :: Parsec () Text a -> Parsec () Text [a]
serializeList = 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
"]"

  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
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Text
hash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
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]
_ -> 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
          -- Please, no longer `error show` after migrating to Text
          (\ 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, KeyMap 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
    HashMap Text (NValue t f m)
s <- (VarName -> Text)
-> HashMap VarName (NValue t f m) -> HashMap Text (NValue t f m)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys VarName -> Text
coerce (HashMap VarName (NValue t f m) -> HashMap Text (NValue t f m))
-> m (HashMap VarName (NValue t f m))
-> m (HashMap Text (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NValue t f m -> m (HashMap VarName (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
$ HashMap Text (NValue t f m) -> WithStringContextT m Derivation
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 <- 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])
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)

    -- Compute the output paths, and add them to the environment if needed.
    -- Also add the inputs, just computed from the strings contexts.
    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
        --, outputs = Map.map (const "") (outputs drv)  -- not needed, this is already the case
          , 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
forall a. Monoid a => a
mempty 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 :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (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
outputs' Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>)
          }

    (Coercible Text VarName => Text -> VarName
coerce @Text @VarName -> VarName
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'

    -- Memoize here, as it may be our last chance in case of readonly stores.
    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 (VarName -> Text
coerce VarName
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 -> VarName
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 (NValue t f m)
attrSet = NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
mkNVStr (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)
    -- TODO: Add location information for all the entries.
    --              here --v
    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
$ PositionSet -> HashMap VarName (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkNVSet PositionSet
forall a. Monoid a => a
mempty (HashMap VarName (NValue t f m) -> NValue t f m)
-> HashMap VarName (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ (Text -> VarName)
-> HashMap Text (NValue t f m) -> HashMap VarName (NValue t f m)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys Text -> VarName
coerce HashMap Text (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
forall a. Monoid a => a
mempty 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 :: HashSet StringContext -> (Set Text, Map Text [Text])
    toStorePaths :: HashSet StringContext -> (Set Text, Map Text [Text])
toStorePaths = ((Set Text, Map Text [Text])
 -> StringContext -> (Set Text, Map Text [Text]))
-> (Set Text, Map Text [Text])
-> HashSet 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, Map Text [Text])
forall a. Monoid a => a
mempty

    addToInputs :: Bifunctor p => StringContext -> p (Set Text) (Map Text [Text])  -> p (Set Text) (Map Text [Text])
    addToInputs :: StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs (StringContext ContextFlavor
kind (VarName -> Text
coerce -> Text
path)) =
      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 ((Set Text -> Set Text)
 -> p (Set Text) (Map Text [Text])
 -> p (Set Text) (Map Text [Text]))
-> (Set Text -> Set Text)
-> p (Set Text) (Map Text [Text])
-> p (Set Text) (Map Text [Text])
forall a b. (a -> b) -> a -> b
$ 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 ((Map Text [Text] -> Map Text [Text])
 -> p (Set Text) (Map Text [Text])
 -> p (Set Text) (Map Text [Text]))
-> (Map Text [Text] -> Map Text [Text])
-> p (Set Text) (Map Text [Text])
-> p (Set Text) (Map Text [Text])
forall a b. (a -> b) -> a -> b
$ ([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] -> Map Text [Text] -> Map Text [Text])
-> [Text] -> Map Text [Text] -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ OneItem [Text] -> [Text]
forall x. One x => OneItem x -> x
one Text
OneItem [Text]
o
        ContextFlavor
AllOutputs ->
          -- TODO: recursive lookup. See prim_derivationStrict
          -- XXX: When is this really used ?
          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."


-- | Build a derivation in a context collecting string contexts.
-- This is complex from a typing standpoint, but it allows to perform the
-- full computation without worrying too much about all the string's contexts.
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) -> WithStringContextT m Derivation
buildDerivationWithContext KeyMap (NValue t f m)
drvAttrs = do
    -- Parse name first, so we can add an informative frame
    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"       (OneItem [Text] -> [Text]
forall x. One x => OneItem x -> x
one OneItem [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
/= OneItem [Text] -> [Text]
forall x. One x => OneItem x -> x
one OneItem [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

      -- filter out null values if needed.
      KeyMap (NValue t f m)
attrs <-
        m (KeyMap (NValue t f m))
-> WithStringContextT m (KeyMap (NValue t f m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (KeyMap (NValue t f m))
 -> WithStringContextT m (KeyMap (NValue t f m)))
-> m (KeyMap (NValue t f m))
-> WithStringContextT m (KeyMap (NValue t f m))
forall a b. (a -> b) -> a -> b
$
          m (KeyMap (NValue t f m))
-> m (KeyMap (NValue t f m)) -> Bool -> m (KeyMap (NValue t f m))
forall a. a -> a -> Bool -> a
bool
            (KeyMap (NValue t f m) -> m (KeyMap (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap (NValue t f m)
drvAttrs)
            ((Maybe (NValue t f m) -> Maybe (NValue t f m))
-> HashMap Text (Maybe (NValue t f m)) -> KeyMap (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)) -> KeyMap (NValue t f m))
-> m (HashMap Text (Maybe (NValue t f m)))
-> m (KeyMap (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)))
-> KeyMap (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
                )
                KeyMap (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
toJSONNixString (NValue t f m -> m NixString) -> NValue t f m -> m NixString
forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkNVSet PositionSet
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 -> VarName)
-> KeyMap (NValue t f m) -> AttrSet (NValue t f m)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
M.mapKeys Text -> VarName
coerce (KeyMap (NValue t f m) -> AttrSet (NValue t f m))
-> KeyMap (NValue t f m) -> AttrSet (NValue t f m)
forall a b. (a -> b) -> a -> b
$
            [Text] -> KeyMap (NValue t f m) -> KeyMap (NValue t f m)
forall a. [Text] -> KeyMap a -> KeyMap a
deleteKeys [ Text
"args", Text
"__ignoreNulls", Text
"__structuredAttrs" ] KeyMap (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 -> NValue t f m -> m NixString
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 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) (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
$ KeyMap (NValue t f m) -> [(Text, NValue t f m)]
forall k v. HashMap k v -> [(k, v)]
M.toList (KeyMap (NValue t f m) -> [(Text, NValue t f m)])
-> KeyMap (NValue t f m) -> [(Text, NValue t f m)]
forall a b. (a -> b) -> a -> b
$ [Text] -> KeyMap (NValue t f m) -> KeyMap (NValue t f m)
forall a. [Text] -> KeyMap a -> KeyMap a
deleteKeys [ Text
"args", Text
"__ignoreNulls" ] KeyMap (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, Map Text [Text])
forall a. Monoid a => a
mempty -- stub for now
        }
  where

    -- common functions, lifted to WithStringContextT

    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

    -- shortcuts to get the (forced) value of an KeyMap field

    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 -> KeyMap (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 KeyMap (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 = 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 (m a -> (v -> WithStringContextT m a) -> WithStringContextT m a)
-> (a -> m a)
-> a
-> (v -> WithStringContextT m a)
-> WithStringContextT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    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.")

    -- Test validity for fields

    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)) -- isAlphaNum allows non-ascii chars.
      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'"

    -- Other helpers

    deleteKeys :: [Text] -> KeyMap a -> KeyMap a
    deleteKeys :: [Text] -> KeyMap a -> KeyMap a
deleteKeys [Text]
keys KeyMap a
attrSet = (KeyMap a -> Text -> KeyMap a) -> KeyMap a -> [Text] -> KeyMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> KeyMap a -> KeyMap a) -> KeyMap a -> Text -> KeyMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> KeyMap a -> KeyMap a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete) KeyMap a
attrSet [Text]
keys