Begin work in Builtins.hs
This commit is contained in:
John Wiegley
parent
568fe7f825
commit
483dded8db
|
|
@ -32,7 +32,7 @@ import Control.Monad.Reader (asks)
|
|||
-- us to put the hashing package in the unconditional dependency list.
|
||||
-- See https://github.com/NixOS/cabal2nix/issues/348 for more info
|
||||
#if MIN_VERSION_hashing(0, 1, 0)
|
||||
import Crypto.Hash
|
||||
import qualified "hashing" Crypto.Hash
|
||||
import qualified "hashing" Crypto.Hash.MD5 as MD5
|
||||
import qualified "hashing" Crypto.Hash.SHA1 as SHA1
|
||||
import qualified "hashing" Crypto.Hash.SHA256 as SHA256
|
||||
|
|
@ -96,24 +96,24 @@ import Text.Read
|
|||
import Text.Regex.TDFA
|
||||
|
||||
-- | Evaluate a nix expression in the default context
|
||||
withNixContext :: forall e m r. (MonadNix e m, Has e Options)
|
||||
withNixContext :: forall e t f m r. (MonadNix e t f m, Has e Options)
|
||||
=> Maybe FilePath -> m r -> m r
|
||||
withNixContext mpath action = do
|
||||
base <- builtins
|
||||
opts :: Options <- asks (view hasLens)
|
||||
let i = wrapValue @(NValue m) @(NThunk m) @m $ nvList $
|
||||
map (wrapValue @(NValue m) @(NThunk m) @m
|
||||
let i = wrapValue @(NValue t f m) @t @m $ nvList $
|
||||
map (wrapValue @(NValue t f m) @t @m
|
||||
. nvStr . hackyMakeNixStringWithoutContext . Text.pack) (include opts)
|
||||
pushScope (M.singleton "__includes" i) $
|
||||
pushScopes base $ case mpath of
|
||||
Nothing -> action
|
||||
Just path -> do
|
||||
traceM $ "Setting __cur_file = " ++ show path
|
||||
let ref = wrapValue @(NValue m) @(NThunk m) @m $ nvPath path
|
||||
let ref = wrapValue @(NValue t f m) @t @m $ nvPath path
|
||||
pushScope (M.singleton "__cur_file" ref) action
|
||||
|
||||
builtins :: (MonadNix e m, Scoped (NThunk m) m)
|
||||
=> m (Scopes m (NThunk m))
|
||||
builtins :: (MonadNix e t f m, Scoped t m)
|
||||
=> m (Scopes m t)
|
||||
builtins = do
|
||||
ref <- thunk $ flip nvSet M.empty <$> buildMap
|
||||
lst <- ([("builtins", ref)] ++) <$> topLevelBuiltins
|
||||
|
|
@ -129,18 +129,18 @@ builtins = do
|
|||
Builtin TopLevel ("__" <> name, builtin)
|
||||
|
||||
data BuiltinType = Normal | TopLevel
|
||||
data Builtin m = Builtin
|
||||
data Builtin t = Builtin
|
||||
{ _kind :: BuiltinType
|
||||
, mapping :: (Text, NThunk m)
|
||||
, mapping :: (Text, t)
|
||||
}
|
||||
|
||||
valueThunk :: forall e m. MonadNix e m => NValue m -> NThunk m
|
||||
valueThunk :: forall e t f m. MonadNix e t f m => NValue t f m -> t
|
||||
valueThunk = wrapValue @_ @_ @m
|
||||
|
||||
force' :: forall e m. MonadNix e m => NThunk m -> m (NValue m)
|
||||
force' :: forall e t f m. MonadNix e t f m => t -> m (NValue t f m)
|
||||
force' = force ?? pure
|
||||
|
||||
builtinsList :: forall e m. MonadNix e m => m [ Builtin m ]
|
||||
builtinsList :: forall e t f m. MonadNix e t f m => m [Builtin t]
|
||||
builtinsList = sequence [
|
||||
do version <- toValue (principledMakeNixStringWithoutContext "2.0")
|
||||
pure $ Builtin Normal ("nixVersion", version)
|
||||
|
|
@ -288,12 +288,12 @@ builtinsList = sequence [
|
|||
add2 t n v = wrap t n <$> mkThunk n (builtin2 (Text.unpack n) v)
|
||||
add3 t n v = wrap t n <$> mkThunk n (builtin3 (Text.unpack n) v)
|
||||
|
||||
add' :: ToBuiltin m a => BuiltinType -> Text -> a -> m (Builtin m)
|
||||
add' :: ToBuiltin t m a => BuiltinType -> Text -> a -> m (Builtin t)
|
||||
add' t n v = wrap t n <$> mkThunk n (toBuiltin (Text.unpack n) v)
|
||||
|
||||
-- Primops
|
||||
|
||||
foldNixPath :: forall e m r. MonadNix e m
|
||||
foldNixPath :: forall e t f m r. MonadNix e t f m
|
||||
=> (FilePath -> Maybe String -> NixPathEntryType -> r -> m r) -> r -> m r
|
||||
foldNixPath f z = do
|
||||
mres <- lookupVar "__includes"
|
||||
|
|
@ -313,7 +313,7 @@ foldNixPath f z = do
|
|||
[n, p] -> f (Text.unpack p) (Just (Text.unpack n)) ty rest
|
||||
_ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " ++ show x
|
||||
|
||||
nixPath :: MonadNix e m => m (NValue m)
|
||||
nixPath :: MonadNix e t f m => m (NValue t f m)
|
||||
nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
||||
pure $ valueThunk
|
||||
(flip nvSet mempty $ M.fromList
|
||||
|
|
@ -323,33 +323,33 @@ nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
|||
, ("prefix", valueThunk $
|
||||
nvStr (hackyMakeNixStringWithoutContext $ Text.pack (fromMaybe "" mn))) ]) : rest
|
||||
|
||||
toString :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
toString :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toString str = str >>= coerceToString DontCopyToStore CoerceAny >>= toNix
|
||||
|
||||
hasAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
hasAttr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
hasAttr x y =
|
||||
fromValue x >>= fromStringNoContext >>= \key ->
|
||||
fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
fromValue @(AttrSet t, AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
toNix $ M.member key aset
|
||||
|
||||
attrsetGet :: MonadNix e m => Text -> AttrSet t -> m t
|
||||
attrsetGet :: MonadNix e t f m => Text -> AttrSet t -> m t
|
||||
attrsetGet k s = case M.lookup k s of
|
||||
Just v -> pure v
|
||||
Nothing ->
|
||||
throwError $ ErrorCall $ "Attribute '" ++ Text.unpack k ++ "' required"
|
||||
|
||||
hasContext :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
hasContext :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
hasContext =
|
||||
toNix . stringHasContext <=< fromValue
|
||||
|
||||
getAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
getAttr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
getAttr x y =
|
||||
fromValue x >>= fromStringNoContext >>= \key ->
|
||||
fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
fromValue @(AttrSet t, AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
attrsetGet key aset >>= force'
|
||||
|
||||
unsafeGetAttrPos :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
unsafeGetAttrPos :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVStr ns, NVSet _ apos) -> case M.lookup (hackyStringIgnoreContext ns) apos of
|
||||
Nothing -> pure $ nvConstant NNull
|
||||
|
|
@ -359,10 +359,10 @@ unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
|
||||
-- This function is a bit special in that it doesn't care about the contents
|
||||
-- of the list.
|
||||
length_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
length_ = toValue . (length :: [NThunk m] -> Int) <=< fromValue
|
||||
length_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
length_ = toValue . (length :: [t] -> Int) <=< fromValue
|
||||
|
||||
add_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
add_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) ->
|
||||
toNix ( x + y :: Integer)
|
||||
|
|
@ -372,7 +372,7 @@ add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
(_, _) ->
|
||||
throwError $ Addition x' y'
|
||||
|
||||
mul_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
mul_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) ->
|
||||
toNix ( x * y :: Integer)
|
||||
|
|
@ -382,7 +382,7 @@ mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
(_, _) ->
|
||||
throwError $ Multiplication x' y'
|
||||
|
||||
div_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
div_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) | y /= 0 ->
|
||||
toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)
|
||||
|
|
@ -402,7 +402,7 @@ anyM p (x:xs) = do
|
|||
if q then return True
|
||||
else anyM p xs
|
||||
|
||||
any_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
any_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
any_ fun xs = fun >>= \f ->
|
||||
toNix <=< anyM fromValue <=< mapM ((f `callFunc`) . force')
|
||||
<=< fromValue $ xs
|
||||
|
|
@ -414,24 +414,24 @@ allM p (x:xs) = do
|
|||
if q then allM p xs
|
||||
else return False
|
||||
|
||||
all_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
all_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
all_ fun xs = fun >>= \f ->
|
||||
toNix <=< allM fromValue <=< mapM ((f `callFunc`) . force')
|
||||
<=< fromValue $ xs
|
||||
|
||||
foldl'_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
foldl'_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
foldl'_ fun z xs =
|
||||
fun >>= \f -> fromValue @[NThunk m] xs >>= foldl' (go f) z
|
||||
fun >>= \f -> fromValue @[t] xs >>= foldl' (go f) z
|
||||
where
|
||||
go f b a = f `callFunc` b >>= (`callFunc` force' a)
|
||||
|
||||
head_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
head_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
head_ = fromValue >=> \case
|
||||
[] -> throwError $ ErrorCall "builtins.head: empty list"
|
||||
h:_ -> force' h
|
||||
|
||||
tail_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
tail_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tail_ = fromValue >=> \case
|
||||
[] -> throwError $ ErrorCall "builtins.tail: empty list"
|
||||
_:t -> return $ nvList t
|
||||
|
|
@ -467,7 +467,7 @@ splitVersion s = case Text.uncons s of
|
|||
x -> VersionComponent_String x
|
||||
in thisComponent : splitVersion rest
|
||||
|
||||
splitVersion_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
splitVersion_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
splitVersion_ = fromValue >=> fromStringNoContext >=> \s ->
|
||||
return $ nvList $ flip map (splitVersion s) $ \c ->
|
||||
valueThunk $ nvStr $ principledMakeNixStringWithoutContext $ versionComponentToString c
|
||||
|
|
@ -479,7 +479,7 @@ compareVersions s1 s2 =
|
|||
z = VersionComponent_String ""
|
||||
f = uncurry compare . fromThese z z
|
||||
|
||||
compareVersions_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
compareVersions_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
compareVersions_ t1 t2 =
|
||||
fromValue t1 >>= fromStringNoContext >>= \s1 ->
|
||||
fromValue t2 >>= fromStringNoContext >>= \s2 ->
|
||||
|
|
@ -507,19 +507,19 @@ splitDrvName s =
|
|||
breakAfterFirstItem isFirstVersionPiece pieces
|
||||
in (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)
|
||||
|
||||
parseDrvName :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
parseDrvName :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
parseDrvName = fromValue >=> fromStringNoContext >=> \s -> do
|
||||
let (name :: Text, version :: Text) = splitDrvName s
|
||||
-- jww (2018-04-15): There should be an easier way to write this.
|
||||
(toValue =<<) $ sequence $ M.fromList
|
||||
[ ("name" :: Text,
|
||||
thunk @_ @(NThunk m)
|
||||
thunk @_ @t
|
||||
(toValue $ principledMakeNixStringWithoutContext name))
|
||||
, ("version",
|
||||
thunk @_ @(NThunk m)
|
||||
thunk @_ @t
|
||||
(toValue $ principledMakeNixStringWithoutContext version)) ]
|
||||
|
||||
match_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
match_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
match_ pat str =
|
||||
fromValue pat >>= fromStringNoContext >>= \p ->
|
||||
fromValue str >>= \ns -> do
|
||||
|
|
@ -540,7 +540,7 @@ match_ pat str =
|
|||
(if length s > 1 then tail s else s)
|
||||
_ -> pure $ nvConstant NNull
|
||||
|
||||
split_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
split_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
split_ pat str =
|
||||
fromValue pat >>= fromStringNoContext >>= \p ->
|
||||
fromValue str >>= \ns -> do
|
||||
|
|
@ -555,11 +555,11 @@ split_ pat str =
|
|||
splitMatches 0 (map elems $ matchAllText re haystack) haystack
|
||||
|
||||
splitMatches
|
||||
:: forall e m. MonadNix e m
|
||||
:: forall e t f m. MonadNix e t f m
|
||||
=> Int
|
||||
-> [[(ByteString, (Int, Int))]]
|
||||
-> ByteString
|
||||
-> [NThunk m]
|
||||
-> [t]
|
||||
splitMatches _ [] haystack = [thunkStr haystack]
|
||||
splitMatches _ ([]:_) _ = error "Error in splitMatches: this should never happen!"
|
||||
splitMatches numDropped (((_,(start,len)):captures):mts) haystack =
|
||||
|
|
@ -572,86 +572,88 @@ splitMatches numDropped (((_,(start,len)):captures):mts) haystack =
|
|||
|
||||
thunkStr s = valueThunk (nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s)))
|
||||
|
||||
substring :: MonadNix e m => Int -> Int -> NixString -> Prim m NixString
|
||||
substring :: MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString
|
||||
substring start len str = Prim $
|
||||
if start < 0 --NOTE: negative values of 'len' are OK
|
||||
then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start
|
||||
else pure $ principledModifyNixContents (Text.take len . Text.drop start) str
|
||||
|
||||
attrNames :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
attrNames = fromValue @(ValueSet m) >=> toNix . map principledMakeNixStringWithoutContext . sort . M.keys
|
||||
attrNames :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrNames = fromValue @(AttrSet t)
|
||||
>=> toNix . map principledMakeNixStringWithoutContext . sort . M.keys
|
||||
|
||||
attrValues :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
attrValues = fromValue @(ValueSet m) >=>
|
||||
toValue . fmap snd . sortOn (fst @Text @(NThunk m)) . M.toList
|
||||
attrValues :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrValues = fromValue @(AttrSet t) >=>
|
||||
toValue . fmap snd . sortOn (fst @Text @t) . M.toList
|
||||
|
||||
map_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
map_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
map_ fun xs = fun >>= \f ->
|
||||
toNix <=< traverse (thunk @_ @(NThunk m) . withFrame Debug
|
||||
toNix <=< traverse (thunk @_ @t . withFrame Debug
|
||||
(ErrorCall "While applying f in map:\n")
|
||||
. (f `callFunc`) . force')
|
||||
<=< fromValue @[NThunk m] $ xs
|
||||
<=< fromValue @[t] $ xs
|
||||
|
||||
mapAttrs_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
mapAttrs_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
mapAttrs_ fun xs = fun >>= \f ->
|
||||
fromValue @(AttrSet (NThunk m)) xs >>= \aset -> do
|
||||
fromValue @(AttrSet t) xs >>= \aset -> do
|
||||
let pairs = M.toList aset
|
||||
values <- for pairs $ \(key, value) ->
|
||||
thunk @_ @(NThunk m) $
|
||||
thunk @_ @t $
|
||||
withFrame Debug (ErrorCall "While applying f in mapAttrs:\n") $
|
||||
callFunc ?? force' value =<< callFunc f (pure (nvStr (principledMakeNixStringWithoutContext key)))
|
||||
callFunc ?? force' value
|
||||
=<< callFunc f (pure (nvStr (principledMakeNixStringWithoutContext key)))
|
||||
toNix . M.fromList . zip (map fst pairs) $ values
|
||||
|
||||
filter_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
filter_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
filter_ fun xs = fun >>= \f ->
|
||||
toNix <=< filterM (fromValue <=< callFunc f . force')
|
||||
<=< fromValue @[NThunk m] $ xs
|
||||
<=< fromValue @[t] $ xs
|
||||
|
||||
catAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
catAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
catAttrs attrName xs =
|
||||
fromValue attrName >>= fromStringNoContext >>= \n ->
|
||||
fromValue @[NThunk m] xs >>= \l ->
|
||||
fromValue @[t] xs >>= \l ->
|
||||
fmap (nvList . catMaybes) $
|
||||
forM l $ fmap (M.lookup n) . fromValue
|
||||
|
||||
baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
baseNameOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
baseNameOf x = do
|
||||
ns <- coerceToString DontCopyToStore CoerceStringy =<< x
|
||||
pure $ nvStr (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
|
||||
|
||||
bitAnd :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
bitAnd :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitAnd x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a .&. b)
|
||||
|
||||
bitOr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
bitOr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitOr x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a .|. b)
|
||||
|
||||
bitXor :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
bitXor :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitXor x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a `xor` b)
|
||||
|
||||
dirOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
dirOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
dirOf x = x >>= \case
|
||||
NVStr ns -> pure $ nvStr (principledModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
|
||||
NVPath path -> pure $ nvPath $ takeDirectory path
|
||||
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
|
||||
|
||||
-- jww (2018-04-28): This should only be a string argument, and not coerced?
|
||||
unsafeDiscardStringContext :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
unsafeDiscardStringContext :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
unsafeDiscardStringContext mnv = do
|
||||
ns <- fromValue mnv
|
||||
toNix $ principledMakeNixStringWithoutContext $ principledStringIgnoreContext ns
|
||||
|
||||
seq_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
seq_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
seq_ a b = a >> b
|
||||
|
||||
deepSeq :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
deepSeq :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
deepSeq a b = do
|
||||
-- We evaluate 'a' only for its effects, so data cycles are ignored.
|
||||
normalForm_ =<< a
|
||||
|
|
@ -661,34 +663,34 @@ deepSeq a b = do
|
|||
-- recursive data structures in Haskell).
|
||||
b
|
||||
|
||||
elem_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
elem_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
elem_ x xs = x >>= \x' ->
|
||||
toValue <=< anyM (valueEq x' <=< force') <=< fromValue @[NThunk m] $ xs
|
||||
toValue <=< anyM (valueEq x' <=< force') <=< fromValue @[t] $ xs
|
||||
|
||||
elemAt :: [a] -> Int -> Maybe a
|
||||
elemAt ls i = case drop i ls of
|
||||
[] -> Nothing
|
||||
a:_ -> Just a
|
||||
|
||||
elemAt_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
elemAt_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
elemAt_ xs n = fromValue n >>= \n' -> fromValue xs >>= \xs' ->
|
||||
case elemAt xs' n' of
|
||||
Just a -> force' a
|
||||
Nothing -> throwError $ ErrorCall $ "builtins.elem: Index " ++ show n'
|
||||
++ " too large for list of length " ++ show (length xs')
|
||||
|
||||
genList :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
genList :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
genList generator = fromValue @Integer >=> \n ->
|
||||
if n >= 0
|
||||
then generator >>= \f ->
|
||||
toNix =<< forM [0 .. n - 1]
|
||||
(\i -> thunk @_ @(NThunk m) $ f `callFunc` toNix i)
|
||||
(\i -> thunk @_ @t $ f `callFunc` toNix i)
|
||||
else throwError $ ErrorCall $ "builtins.genList: Expected a non-negative number, got "
|
||||
++ show n
|
||||
|
||||
genericClosure :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
genericClosure = fromValue @(AttrSet (NThunk m)) >=> \s ->
|
||||
genericClosure :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
genericClosure = fromValue @(AttrSet t) >=> \s ->
|
||||
case (M.lookup "startSet" s, M.lookup "operator" s) of
|
||||
(Nothing, Nothing) ->
|
||||
throwError $ ErrorCall $
|
||||
|
|
@ -701,15 +703,15 @@ genericClosure = fromValue @(AttrSet (NThunk m)) >=> \s ->
|
|||
throwError $ ErrorCall $
|
||||
"builtins.genericClosure: Attribute 'operator' required"
|
||||
(Just startSet, Just operator) ->
|
||||
fromValue @[NThunk m] startSet >>= \ss ->
|
||||
fromValue @[t] startSet >>= \ss ->
|
||||
force operator $ \op ->
|
||||
toValue @[NThunk m] =<< snd <$> go op ss S.empty
|
||||
toValue @[t] =<< snd <$> go op ss S.empty
|
||||
where
|
||||
go :: NValue m -> [NThunk m] -> Set (NValue m)
|
||||
-> m (Set (NValue m), [NThunk m])
|
||||
go :: NValue t f m -> [t] -> Set (NValue t f m)
|
||||
-> m (Set (NValue t f m), [t])
|
||||
go _ [] ks = pure (ks, [])
|
||||
go op (t:ts) ks =
|
||||
force t $ \v -> fromValue @(AttrSet (NThunk m)) t >>= \s ->
|
||||
force t $ \v -> fromValue @(AttrSet t) t >>= \s ->
|
||||
case M.lookup "key" s of
|
||||
Nothing ->
|
||||
throwError $ ErrorCall $
|
||||
|
|
@ -718,13 +720,13 @@ genericClosure = fromValue @(AttrSet (NThunk m)) >=> \s ->
|
|||
if S.member k' ks
|
||||
then go op ts ks
|
||||
else do
|
||||
ys <- fromValue @[NThunk m] =<< (op `callFunc` pure v)
|
||||
ys <- fromValue @[t] =<< (op `callFunc` pure v)
|
||||
case S.toList ks of
|
||||
[] -> checkComparable k' k'
|
||||
j:_ -> checkComparable k' j
|
||||
fmap (t:) <$> go op (ts ++ ys) (S.insert k' ks)
|
||||
|
||||
replaceStrings :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
replaceStrings :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
replaceStrings tfrom tto ts =
|
||||
fromNix tfrom >>= \(nsFrom :: [NixString]) ->
|
||||
fromNix tto >>= \(nsTo :: [NixString]) ->
|
||||
|
|
@ -758,28 +760,28 @@ replaceStrings tfrom tto ts =
|
|||
_ -> go rest (result <> Builder.fromText replacement) (ctx <> newCtx)
|
||||
toNix $ go (principledStringIgnoreContext ns) mempty $ principledGetContext ns
|
||||
|
||||
removeAttrs :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
removeAttrs :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
removeAttrs set = fromNix >=> \(nsToRemove :: [NixString]) ->
|
||||
fromValue @(AttrSet (NThunk m),
|
||||
fromValue @(AttrSet t,
|
||||
AttrSet SourcePos) set >>= \(m, p) -> do
|
||||
toRemove <- mapM fromStringNoContext nsToRemove
|
||||
toNix (go m toRemove, go p toRemove)
|
||||
where
|
||||
go = foldl' (flip M.delete)
|
||||
|
||||
intersectAttrs :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
intersectAttrs :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
intersectAttrs set1 set2 =
|
||||
fromValue @(AttrSet (NThunk m),
|
||||
fromValue @(AttrSet t,
|
||||
AttrSet SourcePos) set1 >>= \(s1, p1) ->
|
||||
fromValue @(AttrSet (NThunk m),
|
||||
fromValue @(AttrSet t,
|
||||
AttrSet SourcePos) set2 >>= \(s2, p2) ->
|
||||
return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)
|
||||
|
||||
functionArgs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
functionArgs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
functionArgs fun = fun >>= \case
|
||||
NVClosure p _ -> toValue @(AttrSet (NThunk m)) $
|
||||
NVClosure p _ -> toValue @(AttrSet t) $
|
||||
valueThunk . nvConstant . NBool <$>
|
||||
case p of
|
||||
Param name -> M.singleton name False
|
||||
|
|
@ -787,7 +789,7 @@ functionArgs fun = fun >>= \case
|
|||
v -> throwError $ ErrorCall $
|
||||
"builtins.functionArgs: expected function, got " ++ show v
|
||||
|
||||
toFile :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
toFile :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
toFile name s = do
|
||||
name' <- fromStringNoContext =<< fromValue name
|
||||
s' <- fromValue s
|
||||
|
|
@ -799,58 +801,58 @@ toFile name s = do
|
|||
sc = StringContext t DirectPath
|
||||
toNix $ principledMakeNixStringWithSingletonContext t sc
|
||||
|
||||
toPath :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
toPath :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toPath = fromValue @Path >=> toNix @Path
|
||||
|
||||
pathExists_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
pathExists_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
pathExists_ path = path >>= \case
|
||||
NVPath p -> toNix =<< pathExists p
|
||||
NVStr ns -> toNix =<< pathExists (Text.unpack (hackyStringIgnoreContext ns))
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.pathExists: expected path, got " ++ show v
|
||||
|
||||
hasKind :: forall a e m. (MonadNix e m, FromValue a m (NValue m))
|
||||
=> m (NValue m) -> m (NValue m)
|
||||
hasKind :: forall a e t f m. (MonadNix e t f m, FromValue a m (NValue t f m))
|
||||
=> m (NValue t f m) -> m (NValue t f m)
|
||||
hasKind = fromValueMay >=> toNix . \case Just (_ :: a) -> True; _ -> False
|
||||
|
||||
isAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isAttrs = hasKind @(ValueSet m)
|
||||
isAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isAttrs = hasKind @(AttrSet t)
|
||||
|
||||
isList :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isList = hasKind @[NThunk m]
|
||||
isList :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isList = hasKind @[t]
|
||||
|
||||
isString :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isString :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isString = hasKind @NixString
|
||||
|
||||
isInt :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isInt :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isInt = hasKind @Int
|
||||
|
||||
isFloat :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isFloat :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFloat = hasKind @Float
|
||||
|
||||
isBool :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isBool :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isBool = hasKind @Bool
|
||||
|
||||
isNull :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isNull :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isNull = hasKind @()
|
||||
|
||||
isFunction :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
isFunction :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFunction func = func >>= \case
|
||||
NVClosure {} -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
throw_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
throw_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
throw_ mnv = do
|
||||
ns <- coerceToString CopyToStore CoerceStringy =<< mnv
|
||||
throwError . ErrorCall . Text.unpack $ principledStringIgnoreContext ns
|
||||
|
||||
import_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
import_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
import_ = scopedImport (pure (nvSet M.empty M.empty))
|
||||
|
||||
scopedImport :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
scopedImport :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
scopedImport asetArg pathArg =
|
||||
fromValue @(AttrSet (NThunk m)) asetArg >>= \s ->
|
||||
fromValue @(AttrSet t) asetArg >>= \s ->
|
||||
fromValue pathArg >>= \(Path p) -> do
|
||||
path <- pathToDefaultNix p
|
||||
mres <- lookupVar "__cur_file"
|
||||
|
|
@ -858,15 +860,15 @@ scopedImport asetArg pathArg =
|
|||
Nothing -> do
|
||||
traceM "No known current directory"
|
||||
return path
|
||||
Just p -> fromValue @_ @_ @(NThunk m) p >>= \(Path p') -> do
|
||||
Just p -> fromValue @_ @_ @t p >>= \(Path p') -> do
|
||||
traceM $ "Current file being evaluated is: " ++ show p'
|
||||
return $ takeDirectory p' </> path
|
||||
clearScopes @(NThunk m) $
|
||||
clearScopes @t $
|
||||
withNixContext (Just path') $
|
||||
pushScope s $
|
||||
importPath @m path'
|
||||
|
||||
getEnv_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
getEnv_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
|
||||
mres <- getEnvVar (Text.unpack s)
|
||||
toNix $ principledMakeNixStringWithoutContext $
|
||||
|
|
@ -874,7 +876,7 @@ getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
|
|||
Nothing -> ""
|
||||
Just v -> Text.pack v
|
||||
|
||||
sort_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
sort_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
sort_ comparator xs = comparator >>= \comp ->
|
||||
fromValue xs >>= sortByM (cmp comp) >>= toValue
|
||||
where
|
||||
|
|
@ -888,7 +890,7 @@ sort_ comparator xs = comparator >>= \comp ->
|
|||
True -> GT
|
||||
False -> EQ
|
||||
|
||||
lessThan :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
lessThan :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
|
||||
let badType = throwError $ ErrorCall $
|
||||
"builtins.lessThan: expected two numbers or two strings, "
|
||||
|
|
@ -903,15 +905,15 @@ lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
|
|||
(NVStr a, NVStr b) -> pure $ principledStringIgnoreContext a < principledStringIgnoreContext b
|
||||
_ -> badType
|
||||
|
||||
concatLists :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
concatLists = fromValue @[NThunk m]
|
||||
>=> mapM (fromValue @[NThunk m] >=> pure)
|
||||
concatLists :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
concatLists = fromValue @[t]
|
||||
>=> mapM (fromValue @[t] >=> pure)
|
||||
>=> toValue . concat
|
||||
|
||||
listToAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
listToAttrs = fromValue @[NThunk m] >=> \l ->
|
||||
listToAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
listToAttrs = fromValue @[t] >=> \l ->
|
||||
fmap (flip nvSet M.empty . M.fromList . reverse) $
|
||||
forM l $ fromValue @(AttrSet (NThunk m)) >=> \s -> do
|
||||
forM l $ fromValue @(AttrSet t) >=> \s -> do
|
||||
name <- fromStringNoContext =<< fromValue =<< attrsetGet "name" s
|
||||
val <- attrsetGet "value" s
|
||||
pure (name, val)
|
||||
|
|
@ -919,7 +921,7 @@ listToAttrs = fromValue @[NThunk m] >=> \l ->
|
|||
-- prim_hashString from nix/src/libexpr/primops.cc
|
||||
-- fail if context in the algo arg
|
||||
-- propagate context from the s arg
|
||||
hashString :: MonadNix e m => NixString -> NixString -> Prim m NixString
|
||||
hashString :: MonadNix e t f m => NixString -> NixString -> Prim m NixString
|
||||
hashString nsAlgo ns = Prim $ do
|
||||
algo <- fromStringNoContext nsAlgo
|
||||
let f g = pure $ principledModifyNixContents g ns
|
||||
|
|
@ -951,7 +953,7 @@ hashString nsAlgo ns = Prim $ do
|
|||
_ -> throwError $ ErrorCall $ "builtins.hashString: "
|
||||
++ "expected \"md5\", \"sha1\", \"sha256\", or \"sha512\", got " ++ show algo
|
||||
|
||||
placeHolder :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
placeHolder :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
placeHolder = fromValue >=> fromStringNoContext >=> \t -> do
|
||||
h <- runPrim (hashString (principledMakeNixStringWithoutContext "sha256")
|
||||
(principledMakeNixStringWithoutContext ("nix-output:" <> t)))
|
||||
|
|
@ -959,7 +961,7 @@ placeHolder = fromValue >=> fromStringNoContext >=> \t -> do
|
|||
-- The result coming out of hashString is base16 encoded
|
||||
fst $ Base16.decode $ encodeUtf8 $ principledStringIgnoreContext h
|
||||
|
||||
absolutePathFromValue :: MonadNix e m => NValue m -> m FilePath
|
||||
absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m FilePath
|
||||
absolutePathFromValue = \case
|
||||
NVStr ns -> do
|
||||
let path = Text.unpack $ hackyStringIgnoreContext ns
|
||||
|
|
@ -969,12 +971,12 @@ absolutePathFromValue = \case
|
|||
NVPath path -> pure path
|
||||
v -> throwError $ ErrorCall $ "expected a path, got " ++ show v
|
||||
|
||||
readFile_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
readFile_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readFile_ path =
|
||||
path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix
|
||||
|
||||
findFile_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
findFile_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
findFile_ aset filePath =
|
||||
aset >>= \aset' ->
|
||||
filePath >>= \filePath' ->
|
||||
|
|
@ -993,14 +995,14 @@ data FileType
|
|||
| FileTypeUnknown
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
instance Applicative m => ToNix FileType m (NValue m) where
|
||||
instance Applicative m => ToNix FileType m (NValue t f m) where
|
||||
toNix = toNix . principledMakeNixStringWithoutContext . \case
|
||||
FileTypeRegular -> "regular" :: Text
|
||||
FileTypeDirectory -> "directory"
|
||||
FileTypeSymlink -> "symlink"
|
||||
FileTypeUnknown -> "unknown"
|
||||
|
||||
readDir_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
readDir_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readDir_ pathThunk = do
|
||||
path <- absolutePathFromValue =<< pathThunk
|
||||
items <- listDirectory path
|
||||
|
|
@ -1014,7 +1016,7 @@ readDir_ pathThunk = do
|
|||
pure (Text.pack item, t)
|
||||
toNix (M.fromList itemsWithTypes)
|
||||
|
||||
fromJSON :: forall e m. (MonadNix e m, Typeable m) => m (NValue m) -> m (NValue m)
|
||||
fromJSON :: forall e t f m. (MonadNix e t f m, Typeable m) => m (NValue t f m) -> m (NValue t f m)
|
||||
fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
|
||||
case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of
|
||||
Left jsonError ->
|
||||
|
|
@ -1035,15 +1037,15 @@ fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
|
|||
A.Null -> pure $ nvConstant NNull
|
||||
|
||||
prim_toJSON
|
||||
:: MonadNix e m
|
||||
=> m (NValue m)
|
||||
-> m (NValue m)
|
||||
:: MonadNix e t f m
|
||||
=> m (NValue t f m)
|
||||
-> m (NValue t f m)
|
||||
prim_toJSON x = x >>= nvalueToJSONNixString >>= pure . nvStr
|
||||
|
||||
toXML_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
toXML_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toXML_ v = v >>= normalForm >>= pure . nvStr . toXML
|
||||
|
||||
typeOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
typeOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case
|
||||
NVConstant a -> case a of
|
||||
NInt _ -> "int"
|
||||
|
|
@ -1058,7 +1060,7 @@ typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case
|
|||
NVBuiltin _ _ -> "lambda"
|
||||
_ -> error "Pattern synonyms obscure complete patterns"
|
||||
|
||||
tryEval :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
tryEval :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tryEval e = catch (onSuccess <$> e) (pure . onError)
|
||||
where
|
||||
onSuccess v = flip nvSet M.empty $ M.fromList
|
||||
|
|
@ -1066,38 +1068,38 @@ tryEval e = catch (onSuccess <$> e) (pure . onError)
|
|||
, ("value", valueThunk v)
|
||||
]
|
||||
|
||||
onError :: SomeException -> NValue m
|
||||
onError :: SomeException -> NValue t f m
|
||||
onError _ = flip nvSet M.empty $ M.fromList
|
||||
[ ("success", valueThunk (nvConstant (NBool False)))
|
||||
, ("value", valueThunk (nvConstant (NBool False)))
|
||||
]
|
||||
|
||||
trace_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
trace_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
trace_ msg action = do
|
||||
traceEffect . Text.unpack . principledStringIgnoreContext =<< fromValue msg
|
||||
action
|
||||
|
||||
-- TODO: remember error context
|
||||
addErrorContext :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
addErrorContext :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
addErrorContext _ action = action
|
||||
|
||||
exec_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
exec_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
exec_ xs = do
|
||||
ls <- fromValue @[NThunk m] xs
|
||||
ls <- fromValue @[t] xs
|
||||
xs <- traverse (coerceToString DontCopyToStore CoerceStringy <=< force') ls
|
||||
-- TODO Still need to do something with the context here
|
||||
-- See prim_exec in nix/src/libexpr/primops.cc
|
||||
-- Requires the implementation of EvalState::realiseContext
|
||||
exec (map (Text.unpack . hackyStringIgnoreContext) xs)
|
||||
|
||||
fetchurl :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
fetchurl :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
fetchurl v = v >>= \case
|
||||
NVSet s _ -> attrsetGet "url" s >>= force ?? (go (M.lookup "sha256" s))
|
||||
v@NVStr {} -> go Nothing v
|
||||
v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or set, got "
|
||||
++ show v
|
||||
where
|
||||
go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
|
||||
go :: Maybe t -> NValue t f m -> m (NValue t f m)
|
||||
go _msha = \case
|
||||
NVStr ns -> noContextAttrs ns >>= getURL >>= \case -- msha
|
||||
Left e -> throwError e
|
||||
|
|
@ -1110,41 +1112,41 @@ fetchurl v = v >>= \case
|
|||
"builtins.fetchurl: unsupported arguments to url"
|
||||
Just t -> pure t
|
||||
|
||||
partition_ :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
partition_ :: forall e t f m. MonadNix e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
partition_ fun xs = fun >>= \f ->
|
||||
fromValue @[NThunk m] xs >>= \l -> do
|
||||
fromValue @[t] xs >>= \l -> do
|
||||
let match t = f `callFunc` force' t >>= fmap (, t) . fromValue
|
||||
selection <- traverse match l
|
||||
let (right, wrong) = partition fst selection
|
||||
let makeSide = valueThunk . nvList . map snd
|
||||
toValue @(AttrSet (NThunk m)) $
|
||||
toValue @(AttrSet t) $
|
||||
M.fromList [("right", makeSide right), ("wrong", makeSide wrong)]
|
||||
|
||||
currentSystem :: MonadNix e m => m (NValue m)
|
||||
currentSystem :: MonadNix e t f m => m (NValue t f m)
|
||||
currentSystem = do
|
||||
os <- getCurrentSystemOS
|
||||
arch <- getCurrentSystemArch
|
||||
return $ nvStr $ principledMakeNixStringWithoutContext (arch <> "-" <> os)
|
||||
|
||||
currentTime_ :: MonadNix e m => m (NValue m)
|
||||
currentTime_ :: MonadNix e t f m => m (NValue t f m)
|
||||
currentTime_ = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
toNix @Integer $ round $ Time.utcTimeToPOSIXSeconds (currentTime opts)
|
||||
|
||||
derivationStrict_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
derivationStrict_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
derivationStrict_ = (>>= derivationStrict)
|
||||
|
||||
newtype Prim m a = Prim { runPrim :: m a }
|
||||
|
||||
-- | Types that support conversion to nix in a particular monad
|
||||
class ToBuiltin m a | a -> m where
|
||||
toBuiltin :: String -> a -> m (NValue m)
|
||||
class ToBuiltin t m a | a -> m where
|
||||
toBuiltin :: String -> a -> m (NValue t f m)
|
||||
|
||||
instance (MonadNix e m, ToNix a m (NValue m))
|
||||
=> ToBuiltin m (Prim m a) where
|
||||
instance (MonadNix e t f m, ToNix a m (NValue t f m))
|
||||
=> ToBuiltin t m (Prim m a) where
|
||||
toBuiltin _ p = toNix =<< runPrim p
|
||||
|
||||
instance (MonadNix e m, FromNix a m (NValue m), ToBuiltin m b)
|
||||
=> ToBuiltin m (a -> b) where
|
||||
instance (MonadNix e t f m, FromNix a m (NValue t f m), ToBuiltin t m b)
|
||||
=> ToBuiltin t m (a -> b) where
|
||||
toBuiltin name f = return $ nvBuiltin name (fromNix >=> toBuiltin name . f)
|
||||
|
|
|
|||
Loading…
Reference in a new issue