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

module Nix.Effects.Derivation ( defaultDerivationStrict ) where

import           Prelude                 hiding ( readFile )

import           Control.Arrow                  ( first, second )
import           Control.Monad                  ( (>=>), forM, when )
import           Control.Monad.Writer           ( join, lift )
import           Control.Monad.State            ( MonadState, gets, modify )

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.List
import qualified Data.Map.Strict               as Map
import           Data.Map.Strict                ( Map )
import qualified Data.Set                      as Set
import           Data.Set                       ( Set )
import           Data.Text                      ( Text )
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding            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.Utils               hiding ( readFile )
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


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

defaultDerivation :: Derivation
defaultDerivation :: Derivation
defaultDerivation = Derivation :: Text
-> Map Text Text
-> (Set Text, Map Text [Text])
-> Text
-> Text
-> [Text]
-> Map Text Text
-> Maybe SomeNamedDigest
-> HashMode
-> Bool
-> Derivation
Derivation
  { name :: Text
name        = Text
forall a. HasCallStack => a
undefined
  , outputs :: Map Text Text
outputs     = Map Text Text
forall k a. Map k a
Map.empty
  , inputs :: (Set Text, Map Text [Text])
inputs      = (Set Text
forall a. Set a
Set.empty, Map Text [Text]
forall k a. Map k a
Map.empty)
  , platform :: Text
platform    = Text
forall a. HasCallStack => a
undefined
  , builder :: Text
builder     = Text
forall a. HasCallStack => a
undefined
  , args :: [Text]
args        = []
  , env :: Map Text Text
env         = Map Text Text
forall k a. Map k a
Map.empty
  , mFixed :: Maybe SomeNamedDigest
mFixed      = Maybe SomeNamedDigest
forall a. Maybe a
Nothing
  , hashMode :: HashMode
hashMode    = HashMode
Flat
  , useJson :: Bool
useJson     = Bool
False
  }

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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' for use in a store path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  Right StorePathName
spname -> StorePathName -> m StorePathName
forall (m :: * -> *) a. Monad m => a -> m a
return 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
Text.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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
err
  Right StorePath
path -> StorePath -> m StorePath
forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
inputSrcs Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` ([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
Text.pack (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 (m :: * -> *) a. Monad m => a -> m a
return (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
Text.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. [a] -> [a] -> [a]
++ [(Text, Text)] -> String
forall a. Show a => a -> String
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])]
-> ((Text, [Text]) -> m (Text, [Text])) -> m [(Text, [Text])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Text]
inputDrvs) (\(Text
path, [Text]
outs) ->
    case 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 of
      Just Text
hash -> (Text, [Text]) -> m (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
hash, [Text]
outs)
      Maybe Text
Nothing -> 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
Text.unpack 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'
        (Text, [Text]) -> m (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
hash, [Text]
outs)
    )
  Digest 'SHA256 -> m (Digest 'SHA256)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
Text.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
list ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((Text, Text) -> Text) -> [(Text, Text)] -> [Text])
-> [(Text, Text)] -> ((Text, Text) -> Text) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
outputs) (\(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
        case Maybe SomeNamedDigest
mFixed of
          Maybe SomeNamedDigest
Nothing -> [Text] -> Text
parens [Text -> Text
s Text
outputName, Text -> Text
s Text
outputPath, Text -> Text
s Text
"", Text -> Text
s Text
""]
          Just (Store.SomeDigest (Digest a
digest :: Store.Digest hashType)) ->
            [Text] -> Text
parens [Text -> Text
s Text
outputName, Text -> Text
s Text
outputPath, Text -> Text
s (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NamedAlgo a => Text
forall (a :: HashAlgorithm). NamedAlgo a => Text
Store.algoName @hashType, Text -> Text
s (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> Digest a -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
Store.encodeInBase BaseEncoding
Store.Base16 Digest a
digest]
        )
    , -- inputDrvs
      [Text] -> Text
list ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((Text, [Text]) -> Text) -> [(Text, [Text])] -> [Text])
-> [(Text, [Text])] -> ((Text, [Text]) -> Text) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, [Text]) -> Text) -> [(Text, [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text [Text] -> [(Text, [Text])])
-> Map Text [Text] -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$ (Set Text, Map Text [Text]) -> Map Text [Text]
forall a b. (a, b) -> b
snd (Set Text, Map Text [Text])
inputs) (\(Text
path, [Text]
outs) ->
        [Text] -> Text
parens [Text -> Text
s Text
path, [Text] -> Text
list ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
s ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
outs])
    , -- inputSrcs
      [Text] -> Text
list ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
s ([Text] -> [Text]) -> [Text] -> [Text]
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, 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
list ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
s [Text]
args
    , -- env (key value pairs)
      [Text] -> Text
list ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((Text, Text) -> Text) -> [(Text, Text)] -> [Text])
-> [(Text, Text)] -> ((Text, Text) -> Text) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
env) (\(Text
k, Text
v) ->
        [Text] -> Text
parens [Text -> Text
s Text
k, Text -> Text
s Text
v])
    ]
  where
    parens :: [Text] -> Text
    parens :: [Text] -> Text
parens [Text]
ts = [Text] -> Text
Text.concat [Text
"(", Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
ts, Text
")"]
    list   :: [Text] -> Text
    list :: [Text] -> Text
list   [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) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
Text.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
  case 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 of
    Left 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. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseErrorBundle Text () -> String
forall a. Show a => a -> String
show ParseErrorBundle Text ()
err
    Right Derivation
drv -> Derivation -> m Derivation
forall (m :: * -> *) a. Monad m => a -> m a
return Derivation
drv

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]
list (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] -> (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
fmap (\[Text
n, Text
p, Text
ht, Text
h] -> (Text
n, Text
p, Text
ht, Text
h)) (ParsecT () Text Identity [Text]
 -> ParsecT () Text Identity (Text, Text, Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text, Text, Text)
forall a b. (a -> b) -> a -> 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])
-> 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]
list (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 -> [Text] -> (Text, [Text]))
-> ParsecT () Text Identity Text
-> ParsecT () Text Identity ([Text] -> (Text, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,) (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] -> (Text, [Text]))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, [Text])
forall (f :: * -> *) a b. Applicative f => 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]
list 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)
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (ParsecT () Text Identity [Text]
 -> ParsecT () Text Identity (Set Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Set Text)
forall a b. (a -> b) -> a -> 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]
list 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]
list 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]
list (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] -> (Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Text
a, Text
b] -> (Text
a, Text
b)) (ParsecT () Text Identity [Text]
 -> ParsecT () Text Identity (Text, Text))
-> ParsecT () Text Identity [Text]
-> ParsecT () Text Identity (Text, Text)
forall a b. (a -> b) -> a -> 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, Text, Text, Text) -> (Text, Text))
-> [(Text, Text, Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a, Text
b, Text
_, Text
_) -> (Text
a, Text
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

  Derivation -> Parsec () Text Derivation
forall (m :: * -> *) a. Monad m => a -> m a
return (Derivation -> Parsec () Text Derivation)
-> Derivation -> Parsec () Text Derivation
forall a b. (a -> b) -> a -> b
$ 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
Text.pack (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
")")
  list :: f a -> f [a]
list   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]
_ -> String -> (Text, HashMode)
forall a. HasCallStack => String -> a
error (String -> (Text, HashMode)) -> String -> (Text, HashMode)
forall a b. (a -> b) -> a -> b
$ String
"Unsupported hash type for output of fixed-output derivation in .drv file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Text, Text, Text, Text)] -> String
forall a. Show a => a -> String
show [(Text, Text, Text, Text)]
fullOutputs
      in case Text -> Text -> Either String SomeNamedDigest
Store.mkNamedDigest Text
hashType Text
hash of
        Right SomeNamedDigest
digest -> (SomeNamedDigest -> Maybe SomeNamedDigest
forall a. a -> Maybe a
Just SomeNamedDigest
digest, HashMode
hashMode)
        Left String
err -> String -> (Maybe SomeNamedDigest, HashMode)
forall a. HasCallStack => String -> a
error (String -> (Maybe SomeNamedDigest, HashMode))
-> String -> (Maybe SomeNamedDigest, HashMode)
forall a b. (a -> b) -> a -> b
$ String
"Unsupported hash " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
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. [a] -> [a] -> [a]
++ String
"in .drv file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
    [(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 = forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet (NValue t f m)) m v =>
v -> m (AttrSet (NValue t f m))
fromValue @(AttrSet (NValue t f m)) (NValue t f m -> m (AttrSet (NValue t f m)))
-> (AttrSet (NValue t f m) -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \AttrSet (NValue t f m)
s -> do
    (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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) e (hashAlgo :: HashAlgorithm).
(MonadReader e m, Has e Frames, MonadThrow m,
 NamedAlgo hashAlgo) =>
Text -> Digest hashAlgo -> StorePathName -> m Text
makeOutputPath Text
o Digest 'SHA256
hash StorePathName
drvName) (Derivation -> Map Text Text
outputs Derivation
drv)
        Derivation -> m Derivation
forall (m :: * -> *) a. Monad m => a -> m a
return (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
          , 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
a, HashMap Text Text
b) -> (b
a, 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 HashMap Text Text
b))

    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
principledMakeNixStringWithSingletonContext Text
path (Text -> ContextFlavor -> StringContext
StringContext Text
drvPath (Text -> ContextFlavor
DerivationOutput Text
out))) (Derivation -> Map Text Text
outputs Derivation
drv')
        drvPathWithContext :: NixString
drvPathWithContext = Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext 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 (m :: * -> *) a. Monad m => a -> m a
return (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ AttrSet (NValue t f m) -> HashMap Text SourcePos -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text (NValue t f m)
-> HashMap Text SourcePos -> NValue t f m
nvSet AttrSet (NValue t f m)
forall t (m :: * -> *). HashMap Text (NValue t f m)
attrSet HashMap Text SourcePos
forall k v. HashMap k v
M.empty

  where

    pathToText :: StorePath -> Text
pathToText = ByteString -> Text
Text.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 -> m Text
makeOutputPath Text
o Digest hashAlgo
h StorePathName
n = do
      StorePathName
name <- Text -> m 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)
      Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ 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
Text.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])
addToInputs) (Set Text
forall a. Set a
Set.empty, Map Text [Text]
forall k a. Map k a
Map.empty) t StringContext
ctx
    addToInputs :: StringContext
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
addToInputs (StringContext Text
path ContextFlavor
kind) = case ContextFlavor
kind of
      ContextFlavor
DirectPath -> (Set Text -> Set Text)
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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])
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, 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. [a] -> [a] -> [a]
(++) Text
path [Text
o])
      ContextFlavor
AllOutputs ->
        -- TODO: recursive lookup. See prim_derivationStrict
        -- XXX: When is this really used ?
        String
-> (Set Text, Map Text [Text]) -> (Set Text, Map Text [Text])
forall a. HasCallStack => String -> a
error String
"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
$ NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString (NixString -> WithStringContextT m Text)
-> (Text -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MonadNix e t f m => Text -> WithStringContextT m Text
Text -> WithStringContextT m Text
assertDrvStoreName
    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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
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) -> WithStringContextT m Bool)
-> (Bool -> WithStringContextT m Bool) -> WithStringContextT m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> WithStringContextT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
      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) -> WithStringContextT m Bool)
-> (Bool -> WithStringContextT m Bool) -> WithStringContextT m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> WithStringContextT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return

      [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"              []      (([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 :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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' (NValue t f m -> WithStringContextT m NixString)
-> (NixString -> WithStringContextT m Text)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString)
      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)
 -> WithStringContextT m Text)
-> (NixString -> WithStringContextT m Text)
-> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ 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 => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx (NixString -> WithStringContextT m Text)
-> (Text -> WithStringContextT m Text)
-> NixString
-> WithStringContextT m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MonadNix e t f m => Text -> WithStringContextT m Text
Text -> WithStringContextT m Text
assertNonNull
      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. Maybe a
Nothing ((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
$ MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx (NixString -> WithStringContextT m Text)
-> (Text -> WithStringContextT m (Maybe Text))
-> NixString
-> WithStringContextT m (Maybe Text)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Maybe Text -> WithStringContextT m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (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 a. a -> Maybe a
Just)
      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 => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx (NixString -> WithStringContextT m Text)
-> (Text -> WithStringContextT m HashMode)
-> NixString
-> WithStringContextT m HashMode
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MonadNix e t f m => Text -> WithStringContextT m HashMode
Text -> WithStringContextT m HashMode
parseHashMode
      [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 :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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' (NValue t f m -> WithStringContextT m NixString)
-> (NixString -> WithStringContextT m Text)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MonadNix e t f m => NixString -> WithStringContextT m Text
NixString -> WithStringContextT m Text
extractNoCtx)

      Maybe SomeNamedDigest
mFixedOutput <- case Maybe Text
mHash of
        Maybe Text
Nothing -> Maybe SomeNamedDigest
-> WithStringContextT m (Maybe SomeNamedDigest)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SomeNamedDigest
forall a. Maybe a
Nothing
        Just 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 -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ 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" ((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 => 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 (m :: * -> *) a. Monad m => a -> m a
return (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
          Maybe SomeNamedDigest
-> WithStringContextT m (Maybe SomeNamedDigest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeNamedDigest
 -> WithStringContextT m (Maybe SomeNamedDigest))
-> Maybe SomeNamedDigest
-> WithStringContextT m (Maybe SomeNamedDigest)
forall a b. (a -> b) -> a -> b
$ SomeNamedDigest -> Maybe SomeNamedDigest
forall a. a -> Maybe a
Just SomeNamedDigest
digest

      -- filter out null values if needed.
      AttrSet (NValue t f m)
attrs <- if Bool -> Bool
not Bool
ignoreNulls
        then AttrSet (NValue t f m)
-> WithStringContextT m (AttrSet (NValue t f m))
forall (m :: * -> *) a. Monad m => a -> m a
return AttrSet (NValue t f m)
drvAttrs
        else (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))
-> WithStringContextT m (HashMap Text (Maybe (NValue t f m)))
-> WithStringContextT m (AttrSet (NValue t f m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (NValue t f m)
-> (NValue t f m -> WithStringContextT m (Maybe (NValue t f m)))
-> WithStringContextT m (HashMap Text (Maybe (NValue t f m)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AttrSet (NValue t f m)
drvAttrs (NValue t f m
-> (NValue t f m -> WithStringContextT m (Maybe (NValue t f m)))
-> WithStringContextT m (Maybe (NValue t f m))
forall a.
NValue t f m
-> (NValue t f m -> WithStringContextT m a)
-> WithStringContextT m a
demand' (NValue t f m
 -> (NValue t f m -> WithStringContextT m (Maybe (NValue t f m)))
 -> WithStringContextT m (Maybe (NValue t f m)))
-> (NValue t f m -> WithStringContextT m (Maybe (NValue t f m)))
-> NValue t f m
-> WithStringContextT m (Maybe (NValue t f m))
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? (\case
            NVConstant NAtom
NNull -> Maybe (NValue t f m) -> WithStringContextT m (Maybe (NValue t f m))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (NValue t f m)
forall a. Maybe a
Nothing
            NValue t f m
value -> Maybe (NValue t f m) -> WithStringContextT m (Maybe (NValue t f m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (NValue t f m)
 -> WithStringContextT m (Maybe (NValue t f m)))
-> Maybe (NValue t f m)
-> WithStringContextT m (Maybe (NValue t f m))
forall a b. (a -> b) -> a -> b
$ NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
value
          ))

      Map Text Text
env <- if Bool
useJson
        then do
          NixString
jsonString :: NixString <- m NixString -> WithStringContextT m NixString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NixString -> WithStringContextT m NixString)
-> m NixString -> WithStringContextT m NixString
forall a b. (a -> b) -> a -> b
$ NValue t f m -> m NixString
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m NixString
nvalueToJSONNixString (NValue t f m -> m NixString) -> NValue t f m -> m NixString
forall a b. (a -> b) -> a -> b
$ (AttrSet (NValue t f m) -> HashMap Text SourcePos -> NValue t f m)
-> HashMap Text SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall a b c. (a -> b -> c) -> b -> a -> c
flip AttrSet (NValue t f m) -> HashMap Text SourcePos -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text (NValue t f m)
-> HashMap Text SourcePos -> NValue t f m
nvSet HashMap Text SourcePos
forall k v. HashMap k v
M.empty (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
          Map Text Text -> WithStringContextT m (Map Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text Text -> WithStringContextT m (Map Text Text))
-> Map Text Text -> WithStringContextT m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ 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 :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 (NValue t f m -> WithStringContextT m NixString)
-> (NixString -> WithStringContextT m Text)
-> NValue t f m
-> WithStringContextT m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> NixString -> WithStringContextT m Text
forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString) (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

      Derivation -> WithStringContextT m Derivation
forall (m :: * -> *) a. Monad m => a -> m a
return (Derivation -> WithStringContextT m Derivation)
-> Derivation -> WithStringContextT m Derivation
forall a b. (a -> b) -> a -> b
$ Derivation
defaultDerivation { 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 -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
o -> (Text
o, Text
"")) [Text]
outputs
        , mFixed :: Maybe SomeNamedDigest
mFixed = Maybe SomeNamedDigest
mFixedOutput
        }
  where
    -- common functions, lifted to WithStringContextT

    demand' :: NValue t f m -> (NValue t f m -> WithStringContextT m a) -> WithStringContextT m a
    demand' :: NValue t f m
-> (NValue t f m -> WithStringContextT m a)
-> WithStringContextT m a
demand' NValue t f m
v NValue t f m -> WithStringContextT m a
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 (WithStringContextT m a)
-> WithStringContextT m a
forall a b. (a -> b) -> a -> b
$ 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))
-> m (WithStringContextT m a)
-> WithStringContextT m (WithStringContextT m a)
forall a b. (a -> b) -> a -> b
$ NValue t f m
-> (NValue t f m -> m (WithStringContextT m a))
-> m (WithStringContextT m a)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
v (WithStringContextT m a -> m (WithStringContextT m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithStringContextT m a -> m (WithStringContextT m a))
-> (NValue t f m -> WithStringContextT m a)
-> NValue t f m
-> m (WithStringContextT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> WithStringContextT m a
f)

    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 (m :: * -> *) a. Monad m => a -> m a
return

    -- 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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
n String -> ShowS
forall 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 (m :: * -> *) a. Monad m => a -> m a
return 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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
n String -> ShowS
forall 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t 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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall 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'"
      Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name

    extractNoCtx :: MonadNix e t f m => NixString -> WithStringContextT m Text
    extractNoCtx :: NixString -> WithStringContextT m Text
extractNoCtx NixString
ns = case NixString -> Maybe Text
principledGetStringNoContext NixString
ns of
      Maybe Text
Nothing -> 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. [a] -> [a] -> [a]
++ NixString -> String
forall a. Show a => a -> String
show NixString
ns String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not allowed to have a context."
      Just Text
v -> Text -> WithStringContextT m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v

    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"
      Text -> WithStringContextT m Text
forall (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) a. Monad m => a -> m a
return HashMode
Flat
      Text
"recursive" -> HashMode -> WithStringContextT m HashMode
forall (m :: * -> *) a. Monad m => a -> m a
return 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. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
other String -> ShowS
forall 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