{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}


module Nix.Effects.Derivation ( defaultDerivationStrict ) where

import           Nix.Utils
import           Data.Char                      ( isAscii
                                                , isAlphaNum
                                                )
import qualified Data.HashMap.Lazy             as M
import qualified Data.HashMap.Strict           as MS
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           Nix.Atoms
import           Nix.Convert
import           Nix.Effects
import           Nix.Exec                       ( MonadNix
                                                , callFunc
                                                )
import           Nix.Frames
import           Nix.Json                       ( nvalueToJSONNixString )
import           Nix.Render
import           Nix.String
import           Nix.String.Coerce
import           Nix.Value
import           Nix.Value.Monad

import qualified System.Nix.ReadonlyStore      as Store
import qualified System.Nix.Hash               as Store
import qualified System.Nix.StorePath          as Store

import           Text.Megaparsec
import           Text.Megaparsec.Char
import Prelude hiding (readFile)


data Derivation = Derivation
  { Derivation -> Text
name :: Text
  , Derivation -> Map Text Text
outputs :: Map Text Text
  , Derivation -> (Set Text, Map Text [Text])
inputs :: (Set Text, Map Text [Text])
  , Derivation -> Text
platform :: Text
  , Derivation -> Text
builder :: Text -- 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)
-> m [StorePath] -> m (Set StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [StorePath] -> Set StorePath
forall a. Ord a => [a] -> Set a
Set.fromList (m [StorePath] -> m (Set StorePath))
-> m [StorePath] -> m (Set StorePath)
forall a b. (a -> b) -> a -> 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 ([Text] -> m [StorePath]) -> [Text] -> m [StorePath]
forall a b. (a -> b) -> a -> b
$ 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 -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Text
inputSrcs (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text [Text] -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text [Text]
inputDrvs
  StorePath
path <- Text -> Text -> StorePathSet -> Bool -> m StorePath
forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Text -> Text -> StorePathSet -> Bool -> m StorePath
addTextToStore (Text -> Text -> Text
Text.append Text
name Text
".drv") (Derivation -> Text
unparseDrv Derivation
drv) ([StorePath] -> StorePathSet
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([StorePath] -> StorePathSet) -> [StorePath] -> StorePathSet
forall a b. (a -> b) -> a -> b
$ Set StorePath -> [StorePath]
forall a. Set a -> [a]
Set.toList Set StorePath
references) Bool
False
  Text -> m StorePath
forall e (m :: * -> *). Framed e m => Text -> m StorePath
parsePath (Text -> m StorePath) -> Text -> m StorePath
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorePath -> String
unStorePath StorePath
path

-- | 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, MS.HashMap Text Text) m) => Derivation -> m (Store.Digest 'Store.SHA256)
hashDerivationModulo :: Derivation -> m (Digest 'SHA256)
hashDerivationModulo
  Derivation
    { mFixed :: Derivation -> Maybe SomeNamedDigest
mFixed = Just (Store.SomeDigest (Digest a
digest :: Store.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
$
      ValidAlgo 'SHA256 => ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
Store.hash @'Store.SHA256 (ByteString -> Digest 'SHA256) -> ByteString -> Digest 'SHA256
forall a b. (a -> b) -> a -> b
$
        Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
          Text
"fixed:out"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if HashMode
hashMode HashMode -> HashMode -> Bool
forall a. Eq a => a -> a -> Bool
== HashMode
Recursive then Text
":r" else Text
"")
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (NamedAlgo a => Text
forall (a :: HashAlgorithm). 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 :: HashAlgorithm). BaseEncoding -> Digest a -> Text
Store.encodeInBase BaseEncoding
Store.Base16 Digest a
digest
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
    [(Text, Text)]
_outputsList -> ErrorCall -> m (Digest 'SHA256)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (Digest 'SHA256))
-> ErrorCall -> m (Digest 'SHA256)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"This is weird. A fixed output drv should only have one output named 'out'. Got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> String
forall b a. (Show a, IsString b) => a -> b
show [(Text, Text)]
_outputsList
hashDerivationModulo
  drv :: Derivation
drv@Derivation
    { inputs :: Derivation -> (Set Text, Map Text [Text])
inputs = ( Set Text
inputSrcs
               , Map Text [Text]
inputDrvs
               )
    } =
  do
    HashMap Text Text
cache <- ((b, HashMap Text Text) -> HashMap Text Text)
-> m (HashMap Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (b, HashMap Text Text) -> HashMap Text Text
forall a b. (a, b) -> b
snd
    Map Text [Text]
inputsModulo <-
      [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> Map Text [Text])
-> m [(Text, [Text])] -> m (Map Text [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ((Text, [Text]) -> m (Text, [Text]))
-> [(Text, [Text])] -> m [(Text, [Text])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
          (\(Text
path, [Text]
outs) ->
            m (Text, [Text])
-> (Text -> m (Text, [Text])) -> Maybe Text -> m (Text, [Text])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (do
                Derivation
drv' <- String -> m Derivation
forall e (m :: * -> *).
(Framed e m, MonadFile m) =>
String -> m Derivation
readDerivation (String -> m Derivation) -> String -> m Derivation
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
path
                Text
hash <- BaseEncoding -> Digest 'SHA256 -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
Store.encodeInBase 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
MS.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 $ ValidAlgo 'SHA256 => ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
Store.hash @'Store.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
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
"" 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 :: Store.Digest hashType)) ->
            [Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NamedAlgo a => Text
forall (a :: HashAlgorithm). NamedAlgo a => Text
Store.algoName @hashType, BaseEncoding -> Digest a -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
Store.encodeInBase 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 = Char -> Text
Text.singleton Char
c

readDerivation :: (Framed e m, MonadFile m) => FilePath -> m Derivation
readDerivation :: String -> m Derivation
readDerivation String
path = do
  Text
content <- ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). MonadFile m => String -> m ByteString
readFile String
path
  (ParseErrorBundle Text () -> m Derivation)
-> (Derivation -> m Derivation)
-> Either (ParseErrorBundle Text ()) Derivation
-> m Derivation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\ ParseErrorBundle Text ()
err -> ErrorCall -> m Derivation
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Derivation) -> ErrorCall -> m Derivation
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall b a. (Show a, IsString b) => a -> b
show String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text () -> String
forall b a. (Show a, IsString b) => a -> b
show ParseErrorBundle Text ()
err)
    Derivation -> m Derivation
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parsec () Text Derivation
-> String -> Text -> Either (ParseErrorBundle Text ()) Derivation
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec () Text Derivation
derivationParser String
path Text
content)

derivationParser :: Parsec () Text Derivation
derivationParser :: Parsec () Text Derivation
derivationParser = do
  Text
_ <- ParsecT () Text Identity Text
"Derive("
  [(Text, Text, Text, Text)]
fullOutputs <- ParsecT () Text Identity (Text, Text, Text, Text)
-> ParsecT () Text Identity [(Text, Text, Text, Text)]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList (ParsecT () Text Identity (Text, Text, Text, Text)
 -> ParsecT () Text Identity [(Text, Text, Text, Text)])
-> ParsecT () Text Identity (Text, Text, Text, Text)
-> ParsecT () Text Identity [(Text, Text, Text, Text)]
forall a b. (a -> b) -> a -> b
$
    (\[Text
n, Text
p, Text
ht, Text
h] -> (Text
n, Text
p, Text
ht, Text
h)) ([Text] -> (Text, Text, Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text, Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
","
  Map Text [Text]
inputDrvs   <- [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> Map Text [Text])
-> ParsecT () Text Identity [(Text, [Text])]
-> ParsecT () Text Identity (Map Text [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity (Text, [Text])
-> ParsecT () Text Identity [(Text, [Text])]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList
    ((Text -> [Text] -> (Text, [Text]))
-> ParsecT () Text Identity Text
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, [Text])
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (ParsecT () Text Identity Text
"(" ParsecT () Text Identity Text
-> ParsecT () Text Identity Text -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity Text
s ParsecT () Text Identity Text
-> ParsecT () Text Identity Text -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
",") (ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s ParsecT () Text Identity [Text]
-> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT () Text Identity Text
")"))
  Text
_ <- ParsecT () Text Identity Text
","
  Set Text
inputSrcs   <- [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text)
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
","
  Text
platform    <- ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
","
  Text
builder     <- ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
","
  [Text]
args        <- ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
","
  Map Text Text
env         <- ([(Text, Text)] -> Map Text Text)
-> ParsecT () Text Identity [(Text, Text)]
-> ParsecT () Text Identity (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (ParsecT () Text Identity [(Text, Text)]
 -> ParsecT () Text Identity (Map Text Text))
-> ParsecT () Text Identity [(Text, Text)]
-> ParsecT () Text Identity (Map Text Text)
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity (Text, Text)
-> ParsecT () Text Identity [(Text, Text)]
forall e s (f :: * -> *) a.
(MonadParsec e s f, IsString (Tokens s)) =>
f a -> f [a]
serializeList (ParsecT () Text Identity (Text, Text)
 -> ParsecT () Text Identity [(Text, Text)])
-> ParsecT () Text Identity (Text, Text)
-> ParsecT () Text Identity [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (\[Text
a, Text
b] -> (Text
a, Text
b)) ([Text] -> (Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
parens ParsecT () Text Identity Text
s
  Text
_ <- ParsecT () Text Identity Text
")"
  ParsecT () Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

  let outputs :: Map Text Text
outputs = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (\(Text
a, Text
b, Text
_, Text
_) -> (Text
a, Text
b)) ((Text, Text, Text, Text) -> (Text, Text))
-> [(Text, Text, Text, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text, Text, Text)]
fullOutputs
  let (Maybe SomeNamedDigest
mFixed, HashMode
hashMode) = [(Text, Text, Text, Text)] -> (Maybe SomeNamedDigest, HashMode)
parseFixed [(Text, Text, Text, Text)]
fullOutputs
  let name :: Text
name = Text
"" -- FIXME (extract from file path ?)
  let useJson :: Bool
useJson = [Text
"__json"] [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text Text -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text Text
env

  pure $ Derivation :: Text
-> Map Text Text
-> (Set Text, Map Text [Text])
-> Text
-> Text
-> [Text]
-> Map Text Text
-> Maybe SomeNamedDigest
-> HashMode
-> Bool
-> Derivation
Derivation {inputs :: (Set Text, Map Text [Text])
inputs = (Set Text
inputSrcs, Map Text [Text]
inputDrvs), Bool
[Text]
Maybe SomeNamedDigest
Text
Map Text Text
HashMode
useJson :: Bool
name :: Text
hashMode :: HashMode
mFixed :: Maybe SomeNamedDigest
outputs :: Map Text Text
env :: Map Text Text
args :: [Text]
builder :: Text
platform :: Text
useJson :: Bool
hashMode :: HashMode
mFixed :: Maybe SomeNamedDigest
env :: Map Text Text
args :: [Text]
builder :: Text
platform :: Text
outputs :: Map Text Text
name :: Text
..}
 where
  s :: Parsec () Text Text
  s :: ParsecT () Text Identity Text
s = (String -> Text)
-> ParsecT () Text Identity String -> ParsecT () Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. ToText a => a -> Text
toText (ParsecT () Text Identity String -> ParsecT () Text Identity Text)
-> ParsecT () Text Identity String -> ParsecT () Text Identity Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"" ParsecT () Text Identity Text
-> ParsecT () Text Identity String
-> ParsecT () Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity Char
-> ParsecT () Text Identity Text -> ParsecT () Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT () Text Identity Char
escaped ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT () Text Identity Char
ParsecT () Text Identity (Token Text)
regular) (Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
  escaped :: ParsecT () Text Identity Char
escaped = Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    (   Char
'\n' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"n"
    ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\r' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"r"
    ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\t' Char
-> ParsecT () Text Identity (Tokens Text)
-> ParsecT () Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"t"
    ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT () Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
    )
  regular :: ParsecT () Text Identity (Token Text)
regular = [Token Text] -> ParsecT () Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\\', Char
'"']

  parens :: Parsec () Text a -> Parsec () Text [a]
  parens :: Parsec () Text a -> Parsec () Text [a]
parens Parsec () Text a
p =
    (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
-> Parsec () Text [a] -> Parsec () Text [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text a
-> ParsecT () Text Identity Text -> Parsec () Text [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy Parsec () Text a
p (Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
",") Parsec () Text [a]
-> ParsecT () Text Identity Text -> Parsec () Text [a]
forall (f :: * -> *) a b. Applicative f => 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
")")
  serializeList :: f a -> f [a]
serializeList   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 (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
"]")

  parseFixed :: [(Text, Text, Text, Text)] -> (Maybe Store.SomeNamedDigest, HashMode)
  parseFixed :: [(Text, Text, Text, Text)] -> (Maybe SomeNamedDigest, HashMode)
parseFixed [(Text, Text, Text, Text)]
fullOutputs = case [(Text, Text, Text, Text)]
fullOutputs of
    [(Text
"out", Text
_path, Text
rht, Text
hash)] | Text
rht Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& Text
hash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" ->
      let
        (Text
hashType, HashMode
hashMode) = case Text -> Text -> [Text]
Text.splitOn Text
":" Text
rht of
          [Text
"r", Text
ht] -> (Text
ht, HashMode
Recursive)
          [Text
ht] ->      (Text
ht, HashMode
Flat)
          [Text]
_ -> Text -> (Text, HashMode)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Text, HashMode)) -> Text -> (Text, HashMode)
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported hash type for output of fixed-output derivation in .drv file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Text, Text, Text)] -> Text
forall b a. (Show a, IsString b) => a -> b
show [(Text, Text, Text, Text)]
fullOutputs
      in
        (String -> (Maybe SomeNamedDigest, HashMode))
-> (SomeNamedDigest -> (Maybe SomeNamedDigest, HashMode))
-> Either String SomeNamedDigest
-> (Maybe SomeNamedDigest, HashMode)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          -- 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, MS.HashMap Text Text) m) => NValue t f m -> m (NValue t f m)
defaultDerivationStrict :: NValue t f m -> m (NValue t f m)
defaultDerivationStrict NValue t f m
val = do
    AttrSet (NValue t f m)
s <- NValue t f m -> m (AttrSet (NValue t f m))
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue @(AttrSet (NValue t f m)) NValue t f m
val
    (Derivation
drv, HashSet StringContext
ctx) <- WithStringContextT m Derivation
-> m (Derivation, HashSet StringContext)
forall (m :: * -> *) a.
Monad m =>
WithStringContextT m a -> m (a, HashSet StringContext)
runWithStringContextT' (WithStringContextT m Derivation
 -> m (Derivation, HashSet StringContext))
-> WithStringContextT m Derivation
-> m (Derivation, HashSet StringContext)
forall a b. (a -> b) -> a -> b
$ AttrSet (NValue t f m) -> WithStringContextT m Derivation
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext AttrSet (NValue t f m)
s
    StorePathName
drvName <- Text -> m StorePathName
forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName (Text -> m StorePathName) -> Text -> m StorePathName
forall a b. (a -> b) -> a -> b
$ Derivation -> Text
name Derivation
drv
    let inputs :: (Set Text, Map Text [Text])
inputs = HashSet StringContext -> (Set Text, Map Text [Text])
forall (t :: * -> *).
Foldable t =>
t StringContext -> (Set Text, Map Text [Text])
toStorePaths HashSet StringContext
ctx

    -- 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 :: HashAlgorithm).
(ValidAlgo 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
        let env' :: Map Text Text
env' = if Derivation -> Bool
useJson Derivation
drv then Derivation -> Map Text Text
env Derivation
drv else 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 -> Map Text Text
env Derivation
drv)
        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 = Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton 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 = if Derivation -> Bool
useJson Derivation
drv then Derivation -> Map Text Text
env Derivation
drv
                  else (Map Text Text -> Text -> Map Text Text)
-> Map Text Text -> [Text] -> Map Text Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Text Text
m Text
k -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k Text
"" Map Text Text
m) (Derivation -> Map Text Text
env Derivation
drv) (Map Text Text -> [Text]
forall k a. Map k a -> [k]
Map.keys (Map Text Text -> [Text]) -> Map Text Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Derivation -> Map Text Text
outputs Derivation
drv)
          }
        Map Text Text
outputs' <- Map Text (m Text) -> m (Map Text Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Map Text (m Text) -> m (Map Text Text))
-> Map Text (m Text) -> m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> m Text) -> Map Text Text -> Map Text (m Text)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Text
o Text
_ -> Text -> Digest 'SHA256 -> StorePathName -> m Text
forall (f :: * -> *) e (hashAlgo :: HashAlgorithm).
(MonadReader e f, Has e Frames, MonadThrow f,
 NamedAlgo hashAlgo) =>
Text -> Digest hashAlgo -> StorePathName -> f Text
makeOutputPath Text
o Digest 'SHA256
hash StorePathName
drvName) (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 = if Derivation -> Bool
useJson Derivation
drv then Derivation -> Map Text Text
env Derivation
drv else Map Text Text -> Map Text Text -> Map Text Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
outputs' (Derivation -> Map Text Text
env Derivation
drv)
          }

    Text
drvPath <- StorePath -> Text
pathToText (StorePath -> Text) -> m StorePath -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Derivation -> m StorePath
forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Derivation -> m StorePath
writeDerivation Derivation
drv'

    -- Memoize here, as it may be our last chance in case of readonly stores.
    Text
drvHash <- BaseEncoding -> Digest 'SHA256 -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
Store.encodeInBase BaseEncoding
Store.Base16 (Digest 'SHA256 -> Text) -> m (Digest 'SHA256) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Derivation -> m (Digest 'SHA256)
forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (b, HashMap Text Text) m) =>
Derivation -> m (Digest 'SHA256)
hashDerivationModulo Derivation
drv'
    ((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ())
-> ((b, HashMap Text Text) -> (b, HashMap Text Text)) -> m ()
forall a b. (a -> b) -> a -> b
$ (HashMap Text Text -> HashMap Text Text)
-> (b, HashMap Text Text) -> (b, HashMap Text Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((HashMap Text Text -> HashMap Text Text)
 -> (b, HashMap Text Text) -> (b, HashMap Text Text))
-> (HashMap Text Text -> HashMap Text Text)
-> (b, HashMap Text Text)
-> (b, HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
MS.insert Text
drvPath Text
drvHash

    let outputsWithContext :: Map Text NixString
outputsWithContext = (Text -> Text -> NixString) -> Map Text Text -> Map Text NixString
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Text
out Text
path -> Text -> StringContext -> NixString
makeNixStringWithSingletonContext Text
path (Text -> ContextFlavor -> StringContext
StringContext Text
drvPath (ContextFlavor -> StringContext) -> ContextFlavor -> StringContext
forall a b. (a -> b) -> a -> b
$ Text -> ContextFlavor
DerivationOutput Text
out)) (Derivation -> Map Text Text
outputs Derivation
drv')
        drvPathWithContext :: NixString
drvPathWithContext = Text -> StringContext -> NixString
makeNixStringWithSingletonContext Text
drvPath (Text -> ContextFlavor -> StringContext
StringContext Text
drvPath ContextFlavor
AllOutputs)
        attrSet :: HashMap Text (NValue t f m)
attrSet = (NixString -> NValue t f m)
-> HashMap Text NixString -> HashMap Text (NValue t f m)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
nvStr (HashMap Text NixString -> HashMap Text (NValue t f m))
-> HashMap Text NixString -> HashMap Text (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [(Text, NixString)] -> HashMap Text NixString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, NixString)] -> HashMap Text NixString)
-> [(Text, NixString)] -> HashMap Text NixString
forall a b. (a -> b) -> a -> b
$ (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
$ HashMap Text SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text SourcePos
-> HashMap Text (NValue t f m) -> NValue t f m
nvSet HashMap Text SourcePos
forall a. Monoid a => a
mempty AttrSet (NValue t f m)
forall t (m :: * -> *). HashMap Text (NValue t f m)
attrSet

  where

    pathToText :: StorePath -> Text
pathToText = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (StorePath -> ByteString) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> ByteString
Store.storePathToRawFilePath

    makeOutputPath :: Text -> Digest hashAlgo -> StorePathName -> f Text
makeOutputPath Text
o Digest hashAlgo
h StorePathName
n = do
      StorePathName
name <- Text -> f StorePathName
forall e (m :: * -> *). Framed e m => Text -> m StorePathName
makeStorePathName (StorePathName -> Text
Store.unStorePathName StorePathName
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text
o Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"out" then Text
"" else Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o)
      pure $ StorePath -> Text
pathToText (StorePath -> Text) -> StorePath -> Text
forall a b. (a -> b) -> a -> b
$ String
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
forall (hashAlgo :: HashAlgorithm).
NamedAlgo hashAlgo =>
String
-> ByteString -> Digest hashAlgo -> 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 hashAlgo
h StorePathName
name

    toStorePaths :: t StringContext -> (Set Text, Map Text [Text])
toStorePaths t StringContext
ctx = ((Set Text, Map Text [Text])
 -> StringContext -> (Set Text, Map Text [Text]))
-> (Set Text, Map Text [Text])
-> t StringContext
-> (Set Text, Map Text [Text])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((StringContext
 -> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text]))
-> (Set Text, Map Text [Text])
-> StringContext
-> (Set Text, Map Text [Text])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StringContext
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
forall (p :: * -> * -> *).
Bifunctor p =>
StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs) (Set Text
forall a. Monoid a => a
mempty, Map Text [Text]
forall a. Monoid a => a
mempty) t StringContext
ctx
    addToInputs :: StringContext
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
addToInputs (StringContext Text
path ContextFlavor
kind) = case ContextFlavor
kind of
      ContextFlavor
DirectPath -> (Set Text -> Set Text)
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
path)
      DerivationOutput Text
o -> (Map Text [Text] -> Map Text [Text])
-> p (Set Text) (Map Text [Text]) -> p (Set Text) (Map Text [Text])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Text] -> [Text] -> [Text])
-> Text -> [Text] -> Map Text [Text] -> Map Text [Text]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) Text
path [Text
o])
      ContextFlavor
AllOutputs ->
        -- 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) => AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext :: AttrSet (NValue t f m) -> WithStringContextT m Derivation
buildDerivationWithContext AttrSet (NValue t f m)
drvAttrs = do
    -- 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"           [Text
"out"] (([NValue t f m] -> WithStringContextT m [Text])
 -> WithStringContextT m [Text])
-> ([NValue t f m] -> WithStringContextT m [Text])
-> WithStringContextT m [Text]
forall a b. (a -> b) -> a -> b
$ (NValue t f m -> WithStringContextT m Text)
-> [NValue t f m] -> WithStringContextT m [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx (NixString -> WithStringContextT m Text)
-> (NValue t f m -> WithStringContextT m NixString)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> WithStringContextT m NixString
forall a.
(FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) =>
NValue t f m -> WithStringContextT m a
fromValue')

      Maybe SomeNamedDigest
mFixedOutput <-
        WithStringContextT m (Maybe SomeNamedDigest)
-> (Text -> WithStringContextT m (Maybe SomeNamedDigest))
-> Maybe Text
-> WithStringContextT m (Maybe SomeNamedDigest)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Maybe SomeNamedDigest
-> WithStringContextT m (Maybe SomeNamedDigest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeNamedDigest
forall a. Maybe a
Nothing)
          (\ Text
hash -> do
            Bool -> WithStringContextT m () -> WithStringContextT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
outputs [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text
"out"]) (WithStringContextT m () -> WithStringContextT m ())
-> WithStringContextT m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ m () -> WithStringContextT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithStringContextT m ())
-> m () -> WithStringContextT m ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m ()
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m ()) -> ErrorCall -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Multiple outputs are not supported for fixed-output derivations"
            Text
hashType <- Text
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall v a.
FromValue v m (NValue' t f m (NValue t f m)) =>
Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
"outputHashAlgo" MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx
            SomeNamedDigest
digest <- m SomeNamedDigest -> WithStringContextT m SomeNamedDigest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SomeNamedDigest -> WithStringContextT m SomeNamedDigest)
-> m SomeNamedDigest -> WithStringContextT m SomeNamedDigest
forall a b. (a -> b) -> a -> b
$ (String -> m SomeNamedDigest)
-> (SomeNamedDigest -> m SomeNamedDigest)
-> Either String SomeNamedDigest
-> m SomeNamedDigest
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorCall -> m SomeNamedDigest
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m SomeNamedDigest)
-> (String -> ErrorCall) -> String -> m SomeNamedDigest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall) SomeNamedDigest -> m SomeNamedDigest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SomeNamedDigest -> m SomeNamedDigest)
-> Either String SomeNamedDigest -> m SomeNamedDigest
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Either String SomeNamedDigest
Store.mkNamedDigest Text
hashType Text
hash
            pure $ SomeNamedDigest -> Maybe SomeNamedDigest
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeNamedDigest
digest)
          Maybe Text
mHash

      -- filter out null values if needed.
      AttrSet (NValue t f m)
attrs <-
        m (AttrSet (NValue t f m))
-> WithStringContextT m (AttrSet (NValue t f m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (AttrSet (NValue t f m))
 -> WithStringContextT m (AttrSet (NValue t f m)))
-> m (AttrSet (NValue t f m))
-> WithStringContextT m (AttrSet (NValue t f m))
forall a b. (a -> b) -> a -> b
$
          m (AttrSet (NValue t f m))
-> m (AttrSet (NValue t f m)) -> Bool -> m (AttrSet (NValue t f m))
forall a. a -> a -> Bool -> a
bool
            (AttrSet (NValue t f m) -> m (AttrSet (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet (NValue t f m)
drvAttrs)
            ((Maybe (NValue t f m) -> Maybe (NValue t f m))
-> HashMap Text (Maybe (NValue t f m)) -> AttrSet (NValue t f m)
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
M.mapMaybe Maybe (NValue t f m) -> Maybe (NValue t f m)
forall a. a -> a
id (HashMap Text (Maybe (NValue t f m)) -> AttrSet (NValue t f m))
-> m (HashMap Text (Maybe (NValue t f m)))
-> m (AttrSet (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              (NValue t f m -> m (Maybe (NValue t f m)))
-> AttrSet (NValue t f m)
-> m (HashMap Text (Maybe (NValue t f m)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                ((NValue t f m -> Maybe (NValue t f m))
-> m (NValue t f m) -> m (Maybe (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                  (\case
                    NVConstant NAtom
NNull -> Maybe (NValue t f m)
forall a. Maybe a
Nothing
                    NValue t f m
_value           -> NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
_value
                  )
                  (m (NValue t f m) -> m (Maybe (NValue t f m)))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (Maybe (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
                )
                AttrSet (NValue t f m)
drvAttrs
            )
            Bool
ignoreNulls

      Map Text Text
env <- if Bool
useJson
        then do
          NixString
jsonString :: NixString <- m NixString -> WithStringContextT m NixString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NixString -> WithStringContextT m NixString)
-> m NixString -> WithStringContextT m NixString
forall a b. (a -> b) -> a -> b
$ NValue t f m -> m NixString
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m NixString
nvalueToJSONNixString (NValue t f m -> m NixString) -> NValue t f m -> m NixString
forall a b. (a -> b) -> a -> b
$ HashMap Text SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text SourcePos
-> HashMap Text (NValue t f m) -> NValue t f m
nvSet HashMap Text SourcePos
forall a. Monoid a => a
mempty (AttrSet (NValue t f m) -> NValue t f m)
-> AttrSet (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$
            [Text] -> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
forall a. [Text] -> AttrSet a -> AttrSet a
deleteKeys [ Text
"args", Text
"__ignoreNulls", Text
"__structuredAttrs" ] AttrSet (NValue t f m)
attrs
          Text
rawString :: Text <- NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString NixString
jsonString
          pure $ Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"__json" Text
rawString
        else
          (NValue t f m -> WithStringContextT m Text)
-> Map Text (NValue t f m) -> WithStringContextT m (Map Text Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString (NixString -> WithStringContextT m Text)
-> (NValue t f m -> WithStringContextT m NixString)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m NixString -> WithStringContextT m NixString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NixString -> WithStringContextT m NixString)
-> (NValue t f m -> m NixString)
-> NValue t f m
-> WithStringContextT m NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
forall e (m :: * -> *) t (f :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
coerceToString NValue t f m -> NValue t f m -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc CopyToStoreMode
CopyToStore CoercionLevel
CoerceAny) (Map Text (NValue t f m) -> WithStringContextT m (Map Text Text))
-> Map Text (NValue t f m) -> WithStringContextT m (Map Text Text)
forall a b. (a -> b) -> a -> b
$
            [(Text, NValue t f m)] -> Map Text (NValue t f m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, NValue t f m)] -> Map Text (NValue t f m))
-> [(Text, NValue t f m)] -> Map Text (NValue t f m)
forall a b. (a -> b) -> a -> b
$ AttrSet (NValue t f m) -> [(Text, NValue t f m)]
forall k v. HashMap k v -> [(k, v)]
M.toList (AttrSet (NValue t f m) -> [(Text, NValue t f m)])
-> AttrSet (NValue t f m) -> [(Text, NValue t f m)]
forall a b. (a -> b) -> a -> b
$ [Text] -> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
forall a. [Text] -> AttrSet a -> AttrSet a
deleteKeys [ Text
"args", Text
"__ignoreNulls" ] AttrSet (NValue t f m)
attrs

      pure $ Derivation :: Text
-> Map Text Text
-> (Set Text, Map Text [Text])
-> Text
-> Text
-> [Text]
-> Map Text Text
-> Maybe SomeNamedDigest
-> HashMode
-> Bool
-> Derivation
Derivation { Text
platform :: Text
platform :: Text
platform, Text
builder :: Text
builder :: Text
builder, [Text]
args :: [Text]
args :: [Text]
args, Map Text Text
env :: Map Text Text
env :: Map Text Text
env,  HashMode
hashMode :: HashMode
hashMode :: HashMode
hashMode, Bool
useJson :: Bool
useJson :: Bool
useJson
        , name :: Text
name = Text
drvName
        , outputs :: Map Text Text
outputs = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (, Text
forall a. Monoid a => a
mempty) (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
outputs
        , mFixed :: Maybe SomeNamedDigest
mFixed = Maybe SomeNamedDigest
mFixedOutput
        , inputs :: (Set Text, Map Text [Text])
inputs = (Set Text
forall a. Monoid a => a
mempty, Map Text [Text]
forall a. Monoid a => a
mempty) -- 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 AttrSet 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 -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
n AttrSet (NValue t f m)
drvAttrs of
      Maybe (NValue t f m)
Nothing -> m a -> WithStringContextT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
d
      Just NValue t f m
v  -> NixLevel
-> ErrorCall -> WithStringContextT m a -> WithStringContextT m a
forall s a.
(Framed e m, Exception s) =>
NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
withFrame' NixLevel
Info (String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"While evaluating attribute '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'") (WithStringContextT m a -> WithStringContextT m a)
-> WithStringContextT m a -> WithStringContextT m a
forall a b. (a -> b) -> a -> b
$
                   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 WithStringContextT m v
-> (v -> WithStringContextT m a) -> WithStringContextT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> WithStringContextT m a
f

    getAttrOr :: Text
-> a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr Text
n a
d v -> WithStringContextT m a
f = Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
forall v a.
(MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m))) =>
Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' Text
n (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
d) v -> WithStringContextT m a
f

    getAttr :: Text -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttr Text
n = Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
forall v a.
(MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m))) =>
Text
-> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
getAttrOr' Text
n (ErrorCall -> m a
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m a) -> ErrorCall -> m a
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Required attribute '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' not found.")

    -- 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] -> AttrSet a -> AttrSet a
    deleteKeys :: [Text] -> AttrSet a -> AttrSet a
deleteKeys [Text]
keys AttrSet a
attrSet = (AttrSet a -> Text -> AttrSet a)
-> AttrSet a -> [Text] -> AttrSet a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> AttrSet a -> AttrSet a) -> AttrSet a -> Text -> AttrSet a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> AttrSet a -> AttrSet a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete) AttrSet a
attrSet [Text]
keys