{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
#ifdef __GHCIDE__
# define NIX_IS_AT_LEAST(mm,m,p) 1
#endif
module Hercules.CNix.Expr
( init,
setTalkative,
setDebug,
setGlobalOption,
setOption,
logInfo,
withEvalState,
withEvalStateConduit,
addAllowedPath,
addInternalAllowedPaths,
evalFile,
newStrings,
appendString,
evalArgs,
autoCallFunction,
isDerivation,
isFunctor,
getRecurseForDerivations,
getAttr,
mkNullableRawValue,
getAttrs,
getDrvFile,
getAttrBool,
getList,
getAttrList,
valueFromExpressionString,
callFunction,
apply,
mkPath,
getFlakeFromFlakeRef,
getLocalFlake,
getFlakeFromGit,
getFlakeFromArchiveUrl,
ToRawValue(..),
ToValue(..),
FromValue(..),
ViaJSON(..),
RawValue,
rawValueType,
module Hercules.CNix.Store,
module Hercules.CNix.Expr.Typed,
type EvalState,
)
where
import Conduit
import qualified Data.Aeson as A
import Data.Coerce (coerce)
import qualified Data.HashMap.Lazy as H
import qualified Data.Map as M
import qualified Data.Scientific as Sci
import Data.Vector (Vector)
import qualified Data.Vector as V
import Foreign (nullPtr)
import qualified Foreign.C.String
import Hercules.CNix.Encapsulation (moveToForeignPtrWrapper)
import Hercules.CNix.Expr.Context
import Hercules.CNix.Expr.Raw
import Hercules.CNix.Expr.Typed
import Hercules.CNix.Store
import Hercules.CNix.Store.Context
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exception as C
import Paths_hercules_ci_cnix_expr (getDataFileName)
import Protolude hiding (evalState)
import System.Directory (makeAbsolute)
import Data.Aeson.KeyMap (toMapText)
C.context (Hercules.CNix.Store.Context.context <> Hercules.CNix.Expr.Context.evalContext)
C.include "<stdio.h>"
C.include "<cstring>"
C.include "<math.h>"
C.include "<nix/config.h>"
C.include "<nix/shared.hh>"
C.include "<nix/eval.hh>"
C.include "<nix/eval-inline.hh>"
C.include "<nix/store-api.hh>"
C.include "<nix/common-eval-args.hh>"
C.include "<nix/get-drvs.hh>"
C.include "<nix/derivations.hh>"
C.include "<nix/globals.hh>"
C.include "<nix/flake/flake.hh>"
C.include "<nix/flake/flakeref.hh>"
C.include "hercules-ci-cnix/expr.hxx"
C.include "<gc/gc.h>"
C.include "<gc/gc_cpp.h>"
C.include "<gc/gc_allocator.h>"
C.using "namespace nix"
C.verbatim "\nGC_API void GC_CALL GC_throw_bad_alloc() { throw std::bad_alloc(); }\n"
init :: IO ()
init :: IO ()
init =
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
[C.throwBlock| void {
nix::initNix();
nix::initGC();
#ifdef NIX_2_5
std::set<nix::ExperimentalFeature> features(nix::settings.experimentalFeatures.get());
features.insert(nix::ExperimentalFeature::Flakes);
#else
Strings features(nix::settings.experimentalFeatures.get());
features.push_back("flakes");
#endif
nix::settings.experimentalFeatures.assign(features);
} |]
setTalkative :: IO ()
setTalkative :: IO ()
setTalkative =
[C.throwBlock| void {
nix::verbosity = nix::lvlTalkative;
} |]
setDebug :: IO ()
setDebug :: IO ()
setDebug =
[C.throwBlock| void {
nix::verbosity = nix::lvlVomit;
} |]
setGlobalOption :: Text -> Text -> IO ()
setGlobalOption :: Text -> Text -> IO ()
setGlobalOption Text
opt Text
value = do
let optionStr :: ByteString
optionStr = Text -> ByteString
encodeUtf8 Text
opt
valueStr :: ByteString
valueStr = Text -> ByteString
encodeUtf8 Text
value
[C.throwBlock| void {
globalConfig.set($bs-cstr:optionStr, $bs-cstr:valueStr);
}|]
setOption :: Text -> Text -> IO ()
setOption :: Text -> Text -> IO ()
setOption Text
opt Text
value = do
let optionStr :: ByteString
optionStr = Text -> ByteString
encodeUtf8 Text
opt
valueStr :: ByteString
valueStr = Text -> ByteString
encodeUtf8 Text
value
[C.throwBlock| void {
settings.set($bs-cstr:optionStr, $bs-cstr:valueStr);
}|]
logInfo :: Text -> IO ()
logInfo :: Text -> IO ()
logInfo Text
t = do
let bstr :: ByteString
bstr = Text -> ByteString
encodeUtf8 Text
t
[C.throwBlock| void {
printInfo($bs-cstr:bstr);
}|]
withEvalState ::
Store ->
(Ptr EvalState -> IO a) ->
IO a
withEvalState :: forall a. Store -> (Ptr EvalState -> IO a) -> IO a
withEvalState (Store Ptr (Ref NixStore)
store) =
IO (Ptr EvalState)
-> (Ptr EvalState -> IO ()) -> (Ptr EvalState -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
( IO (Ptr EvalState) -> IO (Ptr EvalState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
[C.throwBlock| EvalState* {
Strings searchPaths;
return new EvalState(searchPaths, *$(refStore* store));
} |]
)
(\Ptr EvalState
x -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO [C.throwBlock| void { delete $(EvalState* x); } |])
withEvalStateConduit ::
MonadResource m =>
Store ->
(Ptr EvalState -> ConduitT i o m r) ->
ConduitT i o m r
withEvalStateConduit :: forall (m :: * -> *) i o r.
MonadResource m =>
Store -> (Ptr EvalState -> ConduitT i o m r) -> ConduitT i o m r
withEvalStateConduit (Store Ptr (Ref NixStore)
store) =
IO (Ptr EvalState)
-> (Ptr EvalState -> IO ())
-> (Ptr EvalState -> ConduitT i o m r)
-> ConduitT i o m r
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
( IO (Ptr EvalState) -> IO (Ptr EvalState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
[C.throwBlock| EvalState* {
Strings searchPaths;
return new EvalState(searchPaths, *$(refStore* store));
} |]
)
(\Ptr EvalState
x -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO [C.throwBlock| void { delete $(EvalState* x); } |])
addAllowedPath :: Ptr EvalState -> ByteString -> IO ()
addAllowedPath :: Ptr EvalState -> ByteString -> IO ()
addAllowedPath Ptr EvalState
evalState ByteString
path =
[C.throwBlock| void {
std::string path = std::string($bs-ptr:path, $bs-len:path);
EvalState &evalState = *$(EvalState *evalState);
if (evalState.allowedPaths) {
evalState.allowedPaths->insert(path);
}
}|]
addInternalAllowedPaths :: Ptr EvalState -> IO ()
addInternalAllowedPaths :: Ptr EvalState -> IO ()
addInternalAllowedPaths Ptr EvalState
evalState = do
Ptr EvalState -> ByteString -> IO ()
addAllowedPath Ptr EvalState
evalState (ByteString -> IO ())
-> (FilePath -> ByteString) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> IO ()) -> IO FilePath -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
getDataFileName FilePath
"vendor/flake-compat"
evalFile :: Ptr EvalState -> FilePath -> IO RawValue
evalFile :: Ptr EvalState -> FilePath -> IO RawValue
evalFile Ptr EvalState
evalState FilePath
filename = do
CString
filename' <- FilePath -> IO CString
Foreign.C.String.newCString FilePath
filename
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value* {
Value value;
$(EvalState *evalState)->evalFile($(const char *filename'), value);
return new (NoGC) Value(value);
}|]
newStrings :: IO (Ptr Strings)
newStrings :: IO (Ptr Strings)
newStrings = [C.exp| Strings* { new (NoGC) Strings() }|]
appendString :: Ptr Strings -> ByteString -> IO ()
appendString :: Ptr Strings -> ByteString -> IO ()
appendString Ptr Strings
ss ByteString
s =
[C.block| void {
$(Strings *ss)->push_back(std::string($bs-ptr:s, $bs-len:s));
}|]
evalArgs :: Ptr EvalState -> [ByteString] -> IO (Value NixAttrs)
evalArgs :: Ptr EvalState -> [ByteString] -> IO (Value NixAttrs)
evalArgs Ptr EvalState
evalState [ByteString]
args = do
Ptr Strings
argsStrings <- IO (Ptr Strings)
newStrings
[ByteString] -> (ByteString -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
args ((ByteString -> IO ()) -> IO ()) -> (ByteString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Strings -> ByteString -> IO ()
appendString Ptr Strings
argsStrings
(RawValue -> Value NixAttrs) -> IO RawValue -> IO (Value NixAttrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawValue -> Value NixAttrs
forall a. RawValue -> Value a
unsafeAssertType (IO RawValue -> IO (Value NixAttrs))
-> (Ptr Value' -> IO RawValue) -> Ptr Value' -> IO (Value NixAttrs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO (Value NixAttrs))
-> IO (Ptr Value') -> IO (Value NixAttrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value * {
Strings *args = $(Strings *argsStrings);
struct MixEvalArgs evalArgs;
Bindings *autoArgs;
EvalState &state = *$(EvalState *evalState);
evalArgs.parseCmdline(*args);
autoArgs = evalArgs.getAutoArgs(state);
if (!autoArgs) {
throw nix::Error("Could not evaluate automatic arguments");
}
Value *r = new (NoGC) Value ();
r->mkAttrs(autoArgs);
return r;
}|]
autoCallFunction :: Ptr EvalState -> RawValue -> Value NixAttrs -> IO RawValue
autoCallFunction :: Ptr EvalState -> RawValue -> Value NixAttrs -> IO RawValue
autoCallFunction Ptr EvalState
evalState (RawValue Ptr Value'
fun) (Value (RawValue Ptr Value'
autoArgs)) =
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value* {
Value result;
$(EvalState *evalState)->autoCallFunction(
*$(Value *autoArgs)->attrs,
*$(Value *fun),
result);
return new (NoGC) Value (result);
}|]
isDerivation :: Ptr EvalState -> RawValue -> IO Bool
isDerivation :: Ptr EvalState -> RawValue -> IO Bool
isDerivation Ptr EvalState
evalState (RawValue Ptr Value'
v) =
(CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=)
(CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.throwBlock| int {
if ($(Value *v) == NULL) { throw std::invalid_argument("forceValue value must be non-null"); }
$(EvalState *evalState)->forceValue(*$(Value *v), nix::noPos);
return $(EvalState *evalState)->isDerivation(*$(Value *v));
}|]
isFunctor :: Ptr EvalState -> RawValue -> IO Bool
isFunctor :: Ptr EvalState -> RawValue -> IO Bool
isFunctor Ptr EvalState
evalState (RawValue Ptr Value'
v) =
(CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=)
(CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.throwBlock| int {
if ($(Value *v) == NULL) { throw std::invalid_argument("forceValue value must be non-null"); }
return $(EvalState *evalState)->isFunctor(*$(Value *v));
}|]
getRecurseForDerivations :: Ptr EvalState -> Value NixAttrs -> IO Bool
getRecurseForDerivations :: Ptr EvalState -> Value NixAttrs -> IO Bool
getRecurseForDerivations Ptr EvalState
evalState (Value (RawValue Ptr Value'
v)) =
(CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=)
(CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.throwBlock| int {
Value *v = $(Value *v);
EvalState &evalState = *$(EvalState *evalState);
Bindings::iterator iter = v->attrs->find(evalState.sRecurseForDerivations);
if (iter == v->attrs->end()) {
return 0;
} else {
// Previously this bool was unpacked manually and included a special
// case to return true when it is not a bool. That logic was added
// because an empty attrset was found here, observed in
// nixpkgs master 67e2de195a4aa0a50ffb1e1ba0b4fb531dca67dc
#if NIX_IS_AT_LEAST(2,9,0)
return evalState.forceBool(*iter->value, iter->pos);
#else
return evalState.forceBool(*iter->value, *iter->pos);
#endif
}
} |]
getAttr :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr :: Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState (Value (RawValue Ptr Value'
v)) ByteString
k =
Ptr Value' -> IO (Maybe RawValue)
mkNullableRawValue
(Ptr Value' -> IO (Maybe RawValue))
-> IO (Ptr Value') -> IO (Maybe RawValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
Value &v = *$(Value *v);
EvalState &evalState = *$(EvalState *evalState);
Symbol k = evalState.symbols.create($bs-cstr:k);
Bindings::iterator iter = v.attrs->find(k);
if (iter == v.attrs->end()) {
return nullptr;
} else {
return iter->value;
}
}|]
mkNullableRawValue :: Ptr Value' -> IO (Maybe RawValue)
mkNullableRawValue :: Ptr Value' -> IO (Maybe RawValue)
mkNullableRawValue Ptr Value'
p | Ptr Value'
p Ptr Value' -> Ptr Value' -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Value'
forall a. Ptr a
nullPtr = Maybe RawValue -> IO (Maybe RawValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RawValue
forall a. Maybe a
Nothing
mkNullableRawValue Ptr Value'
p = RawValue -> Maybe RawValue
forall a. a -> Maybe a
Just (RawValue -> Maybe RawValue) -> IO RawValue -> IO (Maybe RawValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Value' -> IO RawValue
mkRawValue Ptr Value'
p
getAttrs :: Ptr EvalState -> Value NixAttrs -> IO (Map ByteString RawValue)
getAttrs :: Ptr EvalState -> Value NixAttrs -> IO (Map ByteString RawValue)
getAttrs Ptr EvalState
evalState (Value (RawValue Ptr Value'
v)) = do
Ptr Attr'
begin <- [C.exp| Attr *{ $(Value *v)->attrs->begin() }|]
Ptr Attr'
end <- [C.exp| Attr *{ $(Value *v)->attrs->end() }|]
let gather :: Map ByteString RawValue -> Ptr Attr' -> IO (Map ByteString RawValue)
gather :: Map ByteString RawValue
-> Ptr Attr' -> IO (Map ByteString RawValue)
gather Map ByteString RawValue
acc Ptr Attr'
i | Ptr Attr'
i Ptr Attr' -> Ptr Attr' -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Attr'
end = Map ByteString RawValue -> IO (Map ByteString RawValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ByteString RawValue
acc
gather Map ByteString RawValue
acc Ptr Attr'
i = do
#if NIX_IS_AT_LEAST(2,9,0)
ByteString
name <- IO CString -> IO ByteString
forall (m :: * -> *). MonadIO m => IO CString -> m ByteString
unsafeMallocBS [C.block| const char *{
EvalState &evalState = *$(EvalState *evalState);
SymbolStr str = evalState.symbols[$(Attr *i)->name];
return strdup(static_cast<std::string>(str).c_str());
}|]
#else
name <- unsafeMallocBS [C.exp| const char *{ strdup(static_cast<std::string>($(Attr *i)->name).c_str()) } |]
#endif
RawValue
value <- Ptr Value' -> IO RawValue
mkRawValue (Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.exp| Value *{ new (NoGC) Value(*$(Attr *i)->value) } |]
let acc' :: Map ByteString RawValue
acc' = ByteString
-> RawValue -> Map ByteString RawValue -> Map ByteString RawValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ByteString
name RawValue
value Map ByteString RawValue
acc
Map ByteString RawValue -> IO () -> IO ()
seq Map ByteString RawValue
acc' IO ()
forall (f :: * -> *). Applicative f => f ()
pass
Map ByteString RawValue
-> Ptr Attr' -> IO (Map ByteString RawValue)
gather Map ByteString RawValue
acc' (Ptr Attr' -> IO (Map ByteString RawValue))
-> IO (Ptr Attr') -> IO (Map ByteString RawValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.exp| Attr *{ &$(Attr *i)[1] }|]
Map ByteString RawValue
-> Ptr Attr' -> IO (Map ByteString RawValue)
gather Map ByteString RawValue
forall a. Monoid a => a
mempty Ptr Attr'
begin
getDrvFile :: MonadIO m => Ptr EvalState -> RawValue -> m StorePath
getDrvFile :: forall (m :: * -> *).
MonadIO m =>
Ptr EvalState -> RawValue -> m StorePath
getDrvFile Ptr EvalState
evalState (RawValue Ptr Value'
v) = IO StorePath -> m StorePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
Ptr NixStorePath -> IO StorePath
forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
(Ptr NixStorePath -> IO StorePath)
-> IO (Ptr NixStorePath) -> IO StorePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| nix::StorePath *{
EvalState &state = *$(EvalState *evalState);
auto drvInfo = getDerivation(state, *$(Value *v), false);
if (!drvInfo)
throw EvalError("Not a valid derivation");
#if NIX_IS_AT_LEAST(2,7,0)
StorePath storePath = drvInfo->requireDrvPath();
#else
std::string drvPath = drvInfo->queryDrvPath();
StorePath storePath = state.store->parseStorePath(drvPath);
#endif
// write it (?)
auto drv = state.store->derivationFromPath(storePath);
return new StorePath(storePath);
}|]
getAttrBool :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Either SomeException (Maybe Bool))
getAttrBool :: Ptr EvalState
-> Value NixAttrs
-> ByteString
-> IO (Either SomeException (Maybe Bool))
getAttrBool Ptr EvalState
evalState Value NixAttrs
attrset ByteString
attrName = do
Maybe RawValue
attrMaybe <- Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
attrset ByteString
attrName
Maybe RawValue
attrMaybe Maybe RawValue
-> (Maybe RawValue -> IO (Either SomeException (Maybe Bool)))
-> IO (Either SomeException (Maybe Bool))
forall a b. a -> (a -> b) -> b
& IO (Either SomeException (Maybe Bool))
-> (RawValue -> IO (Either SomeException (Maybe Bool)))
-> Maybe RawValue
-> IO (Either SomeException (Maybe Bool))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> Either SomeException (Maybe Bool)
forall a b. b -> Either a b
Right Maybe Bool
forall a. Maybe a
Nothing)) \RawValue
attr -> do
Ptr EvalState -> RawValue -> IO (Either SomeException Match)
match Ptr EvalState
evalState RawValue
attr IO (Either SomeException Match)
-> (Either SomeException Match
-> IO (Either SomeException (Maybe Bool)))
-> IO (Either SomeException (Maybe Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left SomeException
e -> do
Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool)))
-> Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException (Maybe Bool)
forall a b. a -> Either a b
Left SomeException
e
Right (IsBool Value Bool
r) -> do
Bool
b <- Value Bool -> IO Bool
getBool Value Bool
r
Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool)))
-> Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Either SomeException (Maybe Bool)
forall a b. b -> Either a b
Right (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b)
Right Match
_ -> do
Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool)))
-> Either SomeException (Maybe Bool)
-> IO (Either SomeException (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Either SomeException (Maybe Bool)
forall a b. b -> Either a b
Right Maybe Bool
forall a. Maybe a
Nothing
getList :: Value NixList -> IO [RawValue]
getList :: Value NixList -> IO [RawValue]
getList (Value (RawValue Ptr Value'
nixList)) = do
CInt
len <- [C.exp| int { $(Value *nixList)->listSize() }|]
let getElem :: CInt -> IO RawValue
getElem CInt
i = Ptr Value' -> IO RawValue
mkRawValue (Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.exp| Value * { $(Value *nixList)->listElems()[$(int i)] }|]
[CInt] -> (CInt -> IO RawValue) -> IO [RawValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt
0 .. (CInt
len CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)] \CInt
i -> do
CInt -> IO RawValue
getElem CInt
i
getAttrList :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Either SomeException (Maybe [RawValue]))
getAttrList :: Ptr EvalState
-> Value NixAttrs
-> ByteString
-> IO (Either SomeException (Maybe [RawValue]))
getAttrList Ptr EvalState
evalState Value NixAttrs
attrset ByteString
attrName = do
Maybe RawValue
attrMaybe <- Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
attrset ByteString
attrName
Maybe RawValue
attrMaybe Maybe RawValue
-> (Maybe RawValue -> IO (Either SomeException (Maybe [RawValue])))
-> IO (Either SomeException (Maybe [RawValue]))
forall a b. a -> (a -> b) -> b
& IO (Either SomeException (Maybe [RawValue]))
-> (RawValue -> IO (Either SomeException (Maybe [RawValue])))
-> Maybe RawValue
-> IO (Either SomeException (Maybe [RawValue]))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [RawValue] -> Either SomeException (Maybe [RawValue])
forall a b. b -> Either a b
Right Maybe [RawValue]
forall a. Maybe a
Nothing)) \RawValue
attr -> do
Ptr EvalState -> RawValue -> IO (Either SomeException Match)
match Ptr EvalState
evalState RawValue
attr IO (Either SomeException Match)
-> (Either SomeException Match
-> IO (Either SomeException (Maybe [RawValue])))
-> IO (Either SomeException (Maybe [RawValue]))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left SomeException
e -> do
Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue])))
-> Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException (Maybe [RawValue])
forall a b. a -> Either a b
Left SomeException
e
Right (IsList Value NixList
r) -> do
[RawValue]
b <- Value NixList -> IO [RawValue]
getList Value NixList
r
Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue])))
-> Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall a b. (a -> b) -> a -> b
$ Maybe [RawValue] -> Either SomeException (Maybe [RawValue])
forall a b. b -> Either a b
Right ([RawValue] -> Maybe [RawValue]
forall a. a -> Maybe a
Just [RawValue]
b)
Right Match
_ -> do
Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue])))
-> Either SomeException (Maybe [RawValue])
-> IO (Either SomeException (Maybe [RawValue]))
forall a b. (a -> b) -> a -> b
$ Maybe [RawValue] -> Either SomeException (Maybe [RawValue])
forall a b. b -> Either a b
Right Maybe [RawValue]
forall a. Maybe a
Nothing
valueFromExpressionString ::
Ptr EvalState ->
ByteString ->
ByteString ->
IO RawValue
valueFromExpressionString :: Ptr EvalState -> ByteString -> ByteString -> IO RawValue
valueFromExpressionString Ptr EvalState
evalState ByteString
s ByteString
basePath = do
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
EvalState &evalState = *$(EvalState *evalState);
Expr *expr = evalState.parseExprFromString(std::string($bs-ptr:s, $bs-len:s), std::string($bs-ptr:basePath, $bs-len:basePath));
Value *r = new (NoGC) Value();
evalState.eval(expr, *r);
return r;
}|]
callFunction :: Ptr EvalState -> RawValue -> RawValue -> IO RawValue
callFunction :: Ptr EvalState -> RawValue -> RawValue -> IO RawValue
callFunction Ptr EvalState
evalState (RawValue Ptr Value'
f) (RawValue Ptr Value'
a) = do
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
EvalState &evalState = *$(EvalState *evalState);
Value *r = new (NoGC) Value();
evalState.callFunction(*$(Value *f), *$(Value *a), *r, noPos);
return r;
}|]
apply :: RawValue -> RawValue -> IO RawValue
apply :: RawValue -> RawValue -> IO RawValue
apply (RawValue Ptr Value'
f) (RawValue Ptr Value'
a) = do
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
Value *r = new (NoGC) Value();
r->mkApp($(Value *f), $(Value *a));
return r;
}|]
mkPath :: ByteString -> IO (Value NixPath)
mkPath :: ByteString -> IO (Value NixPath)
mkPath ByteString
path =
RawValue -> Value NixPath
forall a. RawValue -> Value a
Value
(RawValue -> Value NixPath) -> IO RawValue -> IO (Value NixPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
Value *r = new (NoGC) Value();
std::string s($bs-ptr:path, $bs-len:path);
r->mkPath(s.c_str());
return r;
}|]
)
getFlakeFromFlakeRef :: Ptr EvalState -> ByteString -> IO RawValue
getFlakeFromFlakeRef :: Ptr EvalState -> ByteString -> IO RawValue
getFlakeFromFlakeRef Ptr EvalState
evalState ByteString
flakeRef = do
[C.throwBlock| Value *{
EvalState &evalState = *$(EvalState *evalState);
Value *r = new (NoGC) Value();
std::string flakeRefStr($bs-ptr:flakeRef, $bs-len:flakeRef);
auto flakeRef = nix::parseFlakeRef(flakeRefStr, {}, true);
nix::flake::callFlake(evalState,
nix::flake::lockFlake(evalState, flakeRef,
nix::flake::LockFlags {
.updateLockFile = false,
.useRegistries = false,
.allowMutable = false,
}),
*r);
return r;
}|]
IO (Ptr Value') -> (Ptr Value' -> IO RawValue) -> IO RawValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Value' -> IO RawValue
mkRawValue
getLocalFlake :: Ptr EvalState -> Text -> IO RawValue
getLocalFlake :: Ptr EvalState -> Text -> IO RawValue
getLocalFlake Ptr EvalState
evalState Text
path = do
ByteString
absPath <- Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> ByteString) -> IO FilePath -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
makeAbsolute (Text -> FilePath
forall a b. ConvertText a b => a -> b
toS Text
path)
Ptr Value' -> IO RawValue
mkRawValue
(Ptr Value' -> IO RawValue) -> IO (Ptr Value') -> IO RawValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.throwBlock| Value *{
EvalState &evalState = *$(EvalState *evalState);
Value *r = new (NoGC) Value();
std::string path($bs-ptr:absPath, $bs-len:absPath);
auto flakeRef = nix::parseFlakeRef(path, {}, true);
nix::flake::callFlake(evalState,
nix::flake::lockFlake(evalState, flakeRef,
nix::flake::LockFlags {
.updateLockFile = false,
.useRegistries = false,
.allowMutable = false,
}),
*r);
return r;
}|]
getFlakeFromGit :: Ptr EvalState -> Text -> Text -> Text -> IO RawValue
getFlakeFromGit :: Ptr EvalState -> Text -> Text -> Text -> IO RawValue
getFlakeFromGit Ptr EvalState
evalState Text
url Text
ref Text
rev =
let
urlb :: ByteString
urlb = Text -> ByteString
encodeUtf8 Text
url
refb :: ByteString
refb = Text -> ByteString
encodeUtf8 Text
ref
revb :: ByteString
revb = Text -> ByteString
encodeUtf8 Text
rev
in [C.throwBlock| Value *{
EvalState &evalState = *$(EvalState *evalState);
Value *r = new (NoGC) Value();
std::string url($bs-ptr:urlb, $bs-len:urlb);
std::string ref($bs-ptr:refb, $bs-len:refb);
std::string rev($bs-ptr:revb, $bs-len:revb);
fetchers::Attrs attrs;
attrs.emplace("type", "git");
attrs.emplace("url", url);
attrs.emplace("ref", ref);
attrs.emplace("rev", rev);
auto flakeRef = nix::FlakeRef::fromAttrs(attrs);
nix::flake::callFlake(evalState,
nix::flake::lockFlake(evalState, flakeRef,
nix::flake::LockFlags {
.updateLockFile = false,
.useRegistries = false,
.allowMutable = false,
}),
*r);
return r;
}|]
IO (Ptr Value') -> (Ptr Value' -> IO RawValue) -> IO RawValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Value' -> IO RawValue
mkRawValue
getFlakeFromArchiveUrl :: Ptr EvalState -> Text -> IO RawValue
getFlakeFromArchiveUrl :: Ptr EvalState -> Text -> IO RawValue
getFlakeFromArchiveUrl Ptr EvalState
evalState Text
url = do
RawValue
srcArgs <-
Ptr EvalState -> Map ByteString Text -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState (Map ByteString Text -> IO RawValue)
-> Map ByteString Text -> IO RawValue
forall a b. (a -> b) -> a -> b
$
(ByteString
"url" :: ByteString) ByteString -> Text -> Map ByteString Text
forall k a. k -> a -> Map k a
=: Text
url
RawValue
fn <- Ptr EvalState -> ByteString -> ByteString -> IO RawValue
valueFromExpressionString Ptr EvalState
evalState ByteString
"builtins.fetchTarball" ByteString
"/"
RawValue
pValue <- RawValue -> RawValue -> IO RawValue
apply RawValue
fn RawValue
srcArgs
Value NixString
p <- Ptr EvalState -> RawValue -> IO (Value NixString)
forall (m :: * -> *) t.
(HasCallStack, MonadIO m, CheckType t) =>
Ptr EvalState -> RawValue -> m (Value t)
assertType Ptr EvalState
evalState RawValue
pValue
ByteString
p' <- Value NixString -> IO ByteString
getStringIgnoreContext Value NixString
p
Ptr EvalState -> ByteString -> IO RawValue
getFlakeFromFlakeRef Ptr EvalState
evalState ByteString
p'
traverseWithKey_ :: Applicative f => (k -> a -> f ()) -> Map k a -> f ()
traverseWithKey_ :: forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> Map k a -> f ()
traverseWithKey_ k -> a -> f ()
f = (k -> a -> f () -> f ()) -> f () -> Map k a -> f ()
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\k
k a
a f ()
more -> k -> a -> f ()
f k
k a
a f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
more) (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
class ToRawValue a where
toRawValue :: Ptr EvalState -> a -> IO RawValue
default toRawValue :: ToValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a = Value (NixTypeFor a) -> RawValue
forall a. Value a -> RawValue
rtValue (Value (NixTypeFor a) -> RawValue)
-> IO (Value (NixTypeFor a)) -> IO RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EvalState -> a -> IO (Value (NixTypeFor a))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
evalState a
a
class ToRawValue a => ToValue a where
type NixTypeFor a :: Type
toValue :: Ptr EvalState -> a -> IO (Value (NixTypeFor a))
class FromValue n a | a -> n where
fromValue :: Value n -> IO a
instance FromValue Bool Bool where
fromValue :: Value Bool -> IO Bool
fromValue = Value Bool -> IO Bool
getBool
instance FromValue NixList [RawValue] where
fromValue :: Value NixList -> IO [RawValue]
fromValue = Value NixList -> IO [RawValue]
getList
instance FromValue NixInt Int64 where
fromValue :: Value Int64 -> IO Int64
fromValue = Value Int64 -> IO Int64
getInt
instance ToRawValue RawValue where
toRawValue :: Ptr EvalState -> RawValue -> IO RawValue
toRawValue Ptr EvalState
_ = RawValue -> IO RawValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance ToRawValue (Value a)
instance ToValue (Value a) where
type NixTypeFor (Value a) = a
toValue :: Ptr EvalState -> Value a -> IO (Value (NixTypeFor (Value a)))
toValue Ptr EvalState
_ = Value a -> IO (Value (NixTypeFor (Value a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance ToRawValue C.CBool
instance ToValue C.CBool where
type NixTypeFor C.CBool = Bool
toValue :: Ptr EvalState -> CBool -> IO (Value (NixTypeFor CBool))
toValue Ptr EvalState
_ CBool
b =
Ptr Value' -> Value Bool
coerce
(Ptr Value' -> Value Bool) -> IO (Ptr Value') -> IO (Value Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| Value *{
Value *r = new (NoGC) Value();
r->mkBool($(bool b));
return r;
}|]
instance ToRawValue Bool
instance ToValue Bool where
type NixTypeFor Bool = Bool
toValue :: Ptr EvalState -> Bool -> IO (Value (NixTypeFor Bool))
toValue Ptr EvalState
es Bool
False = Ptr EvalState -> CBool -> IO (Value (NixTypeFor CBool))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (CBool
0 :: C.CBool)
toValue Ptr EvalState
es Bool
True = Ptr EvalState -> CBool -> IO (Value (NixTypeFor CBool))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (CBool
1 :: C.CBool)
instance ToRawValue Int64
instance ToValue Int64 where
type NixTypeFor Int64 = NixInt
toValue :: Ptr EvalState -> Int64 -> IO (Value (NixTypeFor Int64))
toValue Ptr EvalState
_ Int64
i =
Ptr Value' -> Value Int64
coerce
(Ptr Value' -> Value Int64) -> IO (Ptr Value') -> IO (Value Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| Value *{
Value *r = new (NoGC) Value();
r->mkInt($(int64_t i));
return r;
}|]
instance ToRawValue Int
instance ToValue Int where
type NixTypeFor Int = NixInt
toValue :: Ptr EvalState -> Int -> IO (Value (NixTypeFor Int))
toValue Ptr EvalState
es Int
i = Ptr EvalState -> Int64 -> IO (Value (NixTypeFor Int64))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Int64)
instance ToRawValue C.CDouble
instance ToValue C.CDouble where
type NixTypeFor C.CDouble = NixFloat
toValue :: Ptr EvalState -> CDouble -> IO (Value (NixTypeFor CDouble))
toValue Ptr EvalState
_ CDouble
f =
Ptr Value' -> Value NixFloat
coerce
(Ptr Value' -> Value NixFloat)
-> IO (Ptr Value') -> IO (Value NixFloat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| Value *{
Value *r = new (NoGC) Value();
r->mkFloat($(double f));
return r;
}|]
instance ToRawValue Double
instance ToValue Double where
type NixTypeFor Double = NixFloat
toValue :: Ptr EvalState -> Double -> IO (Value (NixTypeFor Double))
toValue Ptr EvalState
es Double
f = Ptr EvalState -> CDouble -> IO (Value (NixTypeFor CDouble))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (Rational -> CDouble
forall a. Fractional a => Rational -> a
fromRational (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
f) :: C.CDouble)
instance ToValue ByteString where
type NixTypeFor ByteString = NixString
toValue :: Ptr EvalState -> ByteString -> IO (Value (NixTypeFor ByteString))
toValue Ptr EvalState
_ ByteString
s =
Ptr Value' -> Value NixString
coerce
(Ptr Value' -> Value NixString)
-> IO (Ptr Value') -> IO (Value NixString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| Value *{
Value *r = new (NoGC) Value();
std::string_view s($bs-ptr:s, $bs-len:s);
// If empty, the pointer may be invalid; don't use it.
if (s.size() == 0) {
r->mkString("");
}
else {
r->mkString(GC_STRNDUP(s.data(), s.size()));
}
return r;
}|]
instance ToRawValue ByteString
instance ToRawValue Text
instance ToValue Text where
type NixTypeFor Text = NixString
toValue :: Ptr EvalState -> Text -> IO (Value (NixTypeFor Text))
toValue Ptr EvalState
es Text
s = Ptr EvalState -> ByteString -> IO (Value (NixTypeFor ByteString))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (Text -> ByteString
encodeUtf8 Text
s)
instance ToRawValue a => ToRawValue (Map ByteString a)
#if NIX_IS_AT_LEAST(2,6,0)
withBindingsBuilder :: Integral n => Ptr EvalState -> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder :: forall n.
Integral n =>
Ptr EvalState
-> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder Ptr EvalState
evalState n
n Ptr BindingsBuilder' -> IO ()
f = do
Ptr EvalState
-> n
-> (Ptr BindingsBuilder' -> IO (Value NixAttrs))
-> IO (Value NixAttrs)
forall n a.
Integral n =>
Ptr EvalState -> n -> (Ptr BindingsBuilder' -> IO a) -> IO a
withBindingsBuilder' Ptr EvalState
evalState n
n \Ptr BindingsBuilder'
bb -> do
Ptr BindingsBuilder' -> IO ()
f Ptr BindingsBuilder'
bb
Ptr Value'
v <- [C.block| Value* {
auto v = new (NoGC) Value();
v->mkAttrs(*$(BindingsBuilder *bb));
return v;
}|]
RawValue -> Value NixAttrs
forall a. RawValue -> Value a
Value (RawValue -> Value NixAttrs) -> IO RawValue -> IO (Value NixAttrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Value' -> IO RawValue
mkRawValue Ptr Value'
v
withBindingsBuilder' :: Integral n => Ptr EvalState -> n -> (Ptr BindingsBuilder' -> IO a) -> IO a
withBindingsBuilder' :: forall n a.
Integral n =>
Ptr EvalState -> n -> (Ptr BindingsBuilder' -> IO a) -> IO a
withBindingsBuilder' Ptr EvalState
evalState n
n =
let l :: C.CInt
l :: CInt
l = n -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n
in
IO (Ptr BindingsBuilder')
-> (Ptr BindingsBuilder' -> IO ())
-> (Ptr BindingsBuilder' -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
[C.block| BindingsBuilder* {
auto &evalState = *$(EvalState *evalState);
return new BindingsBuilder(evalState, evalState.allocBindings($(int l)));
}|]
\Ptr BindingsBuilder'
bb -> [C.block| void { delete $(BindingsBuilder *bb); }|]
#endif
instance ToRawValue a => ToValue (Map ByteString a) where
type NixTypeFor (Map ByteString a) = NixAttrs
#if NIX_IS_AT_LEAST(2,6,0)
toValue :: Ptr EvalState
-> Map ByteString a -> IO (Value (NixTypeFor (Map ByteString a)))
toValue Ptr EvalState
evalState Map ByteString a
attrs = Ptr EvalState
-> Int -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
forall n.
Integral n =>
Ptr EvalState
-> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder Ptr EvalState
evalState (Map ByteString a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map ByteString a
attrs) \Ptr BindingsBuilder'
bb -> do
Map ByteString a
attrs Map ByteString a -> (Map ByteString a -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
& (ByteString -> a -> IO ()) -> Map ByteString a -> IO ()
forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> Map k a -> f ()
traverseWithKey_ \ByteString
k a
a -> do
RawValue Ptr Value'
aRaw <- Ptr EvalState -> a -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a
[C.block| void {
EvalState &evalState = *$(EvalState *evalState);
std::string k($bs-ptr:k, $bs-len:k);
Value &a = *$(Value *aRaw);
$(BindingsBuilder *bb)->alloc(evalState.symbols.create(k)) = a;
}|]
#else
toValue evalState attrs = do
let l :: C.CInt
l = fromIntegral (length attrs)
v <-
[C.block| Value* {
EvalState &evalState = *$(EvalState *evalState);
Value *v = new (NoGC) Value();
evalState.mkAttrs(*v, $(int l));
return v;
}|]
attrs & traverseWithKey_ \k a -> do
RawValue aRaw <- toRawValue evalState a
[C.block| void {
EvalState &evalState = *$(EvalState *evalState);
std::string k($bs-ptr:k, $bs-len:k);
Value &a = *$(Value *aRaw);
*evalState.allocAttr(*$(Value *v), evalState.symbols.create(k)) = a;
}|]
[C.block| void {
$(Value *v)->attrs->sort();
}|]
Value <$> mkRawValue v
#endif
instance ToRawValue a => ToRawValue (Map Text a)
instance ToRawValue a => ToValue (Map Text a) where
type NixTypeFor (Map Text a) = NixAttrs
toValue :: Ptr EvalState -> Map Text a -> IO (Value (NixTypeFor (Map Text a)))
toValue Ptr EvalState
evalState Map Text a
attrs = Ptr EvalState
-> Map ByteString a -> IO (Value (NixTypeFor (Map ByteString a)))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
evalState ((Text -> ByteString) -> Map Text a -> Map ByteString a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> ByteString
encodeUtf8 Map Text a
attrs)
mkNull :: IO RawValue
mkNull :: IO RawValue
mkNull =
Ptr Value' -> RawValue
coerce
(Ptr Value' -> RawValue) -> IO (Ptr Value') -> IO RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| Value* {
Value *v = new (NoGC) Value();
v->mkNull();
return v;
}|]
instance ToRawValue A.Value where
toRawValue :: Ptr EvalState -> Value -> IO RawValue
toRawValue Ptr EvalState
es (A.Bool Bool
b) = Ptr EvalState -> Bool -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Bool
b
toRawValue Ptr EvalState
es (A.String Text
s) = Ptr EvalState -> Text -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Text
s
toRawValue Ptr EvalState
es (A.Object Object
fs) = Ptr EvalState -> Map Text Value -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (Map Text Value -> IO RawValue) -> Map Text Value -> IO RawValue
forall a b. (a -> b) -> a -> b
$ Object -> Map Text Value
forall v. KeyMap v -> Map Text v
toMapText Object
fs
toRawValue Ptr EvalState
_es Value
A.Null = IO RawValue
mkNull
toRawValue Ptr EvalState
es (A.Number Scientific
n) | Just Int64
i <- Scientific -> Maybe Int64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n = Ptr EvalState -> Int64 -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (Int64
i :: Int64)
toRawValue Ptr EvalState
es (A.Number Scientific
f) = Ptr EvalState -> Double -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (Scientific -> Double
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat Scientific
f :: Double)
toRawValue Ptr EvalState
es (A.Array Array
a) = Ptr EvalState -> Array -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Array
a
newtype ViaJSON a = ViaJSON {forall a. ViaJSON a -> a
fromViaJSON :: a}
deriving newtype (ViaJSON a -> ViaJSON a -> Bool
(ViaJSON a -> ViaJSON a -> Bool)
-> (ViaJSON a -> ViaJSON a -> Bool) -> Eq (ViaJSON a)
forall a. Eq a => ViaJSON a -> ViaJSON a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViaJSON a -> ViaJSON a -> Bool
$c/= :: forall a. Eq a => ViaJSON a -> ViaJSON a -> Bool
== :: ViaJSON a -> ViaJSON a -> Bool
$c== :: forall a. Eq a => ViaJSON a -> ViaJSON a -> Bool
Eq, Eq (ViaJSON a)
Eq (ViaJSON a)
-> (ViaJSON a -> ViaJSON a -> Ordering)
-> (ViaJSON a -> ViaJSON a -> Bool)
-> (ViaJSON a -> ViaJSON a -> Bool)
-> (ViaJSON a -> ViaJSON a -> Bool)
-> (ViaJSON a -> ViaJSON a -> Bool)
-> (ViaJSON a -> ViaJSON a -> ViaJSON a)
-> (ViaJSON a -> ViaJSON a -> ViaJSON a)
-> Ord (ViaJSON a)
ViaJSON a -> ViaJSON a -> Bool
ViaJSON a -> ViaJSON a -> Ordering
ViaJSON a -> ViaJSON a -> ViaJSON a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ViaJSON a)
forall a. Ord a => ViaJSON a -> ViaJSON a -> Bool
forall a. Ord a => ViaJSON a -> ViaJSON a -> Ordering
forall a. Ord a => ViaJSON a -> ViaJSON a -> ViaJSON a
min :: ViaJSON a -> ViaJSON a -> ViaJSON a
$cmin :: forall a. Ord a => ViaJSON a -> ViaJSON a -> ViaJSON a
max :: ViaJSON a -> ViaJSON a -> ViaJSON a
$cmax :: forall a. Ord a => ViaJSON a -> ViaJSON a -> ViaJSON a
>= :: ViaJSON a -> ViaJSON a -> Bool
$c>= :: forall a. Ord a => ViaJSON a -> ViaJSON a -> Bool
> :: ViaJSON a -> ViaJSON a -> Bool
$c> :: forall a. Ord a => ViaJSON a -> ViaJSON a -> Bool
<= :: ViaJSON a -> ViaJSON a -> Bool
$c<= :: forall a. Ord a => ViaJSON a -> ViaJSON a -> Bool
< :: ViaJSON a -> ViaJSON a -> Bool
$c< :: forall a. Ord a => ViaJSON a -> ViaJSON a -> Bool
compare :: ViaJSON a -> ViaJSON a -> Ordering
$ccompare :: forall a. Ord a => ViaJSON a -> ViaJSON a -> Ordering
Ord, ReadPrec [ViaJSON a]
ReadPrec (ViaJSON a)
Int -> ReadS (ViaJSON a)
ReadS [ViaJSON a]
(Int -> ReadS (ViaJSON a))
-> ReadS [ViaJSON a]
-> ReadPrec (ViaJSON a)
-> ReadPrec [ViaJSON a]
-> Read (ViaJSON a)
forall a. Read a => ReadPrec [ViaJSON a]
forall a. Read a => ReadPrec (ViaJSON a)
forall a. Read a => Int -> ReadS (ViaJSON a)
forall a. Read a => ReadS [ViaJSON a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViaJSON a]
$creadListPrec :: forall a. Read a => ReadPrec [ViaJSON a]
readPrec :: ReadPrec (ViaJSON a)
$creadPrec :: forall a. Read a => ReadPrec (ViaJSON a)
readList :: ReadS [ViaJSON a]
$creadList :: forall a. Read a => ReadS [ViaJSON a]
readsPrec :: Int -> ReadS (ViaJSON a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ViaJSON a)
Read, Int -> ViaJSON a -> ShowS
[ViaJSON a] -> ShowS
ViaJSON a -> FilePath
(Int -> ViaJSON a -> ShowS)
-> (ViaJSON a -> FilePath)
-> ([ViaJSON a] -> ShowS)
-> Show (ViaJSON a)
forall a. Show a => Int -> ViaJSON a -> ShowS
forall a. Show a => [ViaJSON a] -> ShowS
forall a. Show a => ViaJSON a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ViaJSON a] -> ShowS
$cshowList :: forall a. Show a => [ViaJSON a] -> ShowS
show :: ViaJSON a -> FilePath
$cshow :: forall a. Show a => ViaJSON a -> FilePath
showsPrec :: Int -> ViaJSON a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViaJSON a -> ShowS
Show)
instance A.ToJSON a => ToRawValue (ViaJSON a) where
toRawValue :: Ptr EvalState -> ViaJSON a -> IO RawValue
toRawValue Ptr EvalState
es (ViaJSON a
a) = Ptr EvalState -> Value -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (a -> Value
forall a. ToJSON a => a -> Value
A.toJSON a
a)
hmTraverseWithKey_ :: Applicative f => (k -> a -> f ()) -> H.HashMap k a -> f ()
hmTraverseWithKey_ :: forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> HashMap k a -> f ()
hmTraverseWithKey_ k -> a -> f ()
f = (k -> a -> f () -> f ()) -> f () -> HashMap k a -> f ()
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (\k
k a
a f ()
more -> k -> a -> f ()
f k
k a
a f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
more) (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance ToRawValue a => ToRawValue (H.HashMap Text a)
instance ToRawValue a => ToValue (H.HashMap Text a) where
type NixTypeFor (H.HashMap Text a) = NixAttrs
#if NIX_IS_AT_LEAST(2,6,0)
toValue :: Ptr EvalState
-> HashMap Text a -> IO (Value (NixTypeFor (HashMap Text a)))
toValue Ptr EvalState
evalState HashMap Text a
attrs = Ptr EvalState
-> Int -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
forall n.
Integral n =>
Ptr EvalState
-> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder Ptr EvalState
evalState (HashMap Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Text a
attrs) \Ptr BindingsBuilder'
bb -> do
HashMap Text a
attrs HashMap Text a -> (HashMap Text a -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
& (Text -> a -> IO ()) -> HashMap Text a -> IO ()
forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> HashMap k a -> f ()
hmTraverseWithKey_ \Text
k' a
a -> do
RawValue Ptr Value'
aRaw <- Ptr EvalState -> a -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a
let k :: ByteString
k = Text -> ByteString
encodeUtf8 Text
k'
[C.block| void {
EvalState &evalState = *$(EvalState *evalState);
std::string k($bs-ptr:k, $bs-len:k);
Value &a = *$(Value *aRaw);
$(BindingsBuilder *bb)->alloc(evalState.symbols.create(k)) = a;
}|]
#else
toValue evalState attrs = do
let l :: C.CInt
l = fromIntegral (length attrs)
v <-
[C.block| Value* {
EvalState &evalState = *$(EvalState *evalState);
Value *v = new (NoGC) Value();
evalState.mkAttrs(*v, $(int l));
return v;
}|]
attrs & hmTraverseWithKey_ \k' a -> do
RawValue aRaw <- toRawValue evalState a
let k = encodeUtf8 k'
[C.block| void {
EvalState &evalState = *$(EvalState *evalState);
std::string k($bs-ptr:k, $bs-len:k);
Value &a = *$(Value *aRaw);
*evalState.allocAttr(*$(Value *v), evalState.symbols.create(k)) = a;
}|]
[C.block| void {
$(Value *v)->attrs->sort();
}|]
Value <$> mkRawValue v
#endif
instance ToRawValue a => ToRawValue (Vector a)
instance ToRawValue a => ToValue (Vector a) where
type NixTypeFor (Vector a) = NixList
toValue :: Ptr EvalState -> Vector a -> IO (Value (NixTypeFor (Vector a)))
toValue Ptr EvalState
evalState Vector a
vec =
Value Any -> Value NixList
coerce (Value Any -> Value NixList)
-> IO (Value Any) -> IO (Value NixList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let l :: C.CInt
l :: CInt
l = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector a
vec)
Ptr Value'
v <-
[C.block| Value* {
EvalState &evalState = *$(EvalState *evalState);
Value *v = new (NoGC) Value();
evalState.mkList(*v, $(int l));
return v;
}|]
Vector a
vec Vector a -> (Vector a -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
& (Int -> a -> IO ()) -> Vector a -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ \Int
i a
a -> do
RawValue Ptr Value'
aRaw <- Ptr EvalState -> a -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a
let ix :: CInt
ix = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
[C.block| void {
Value &v = *$(Value *v);
v.listElems()[$(int ix)] = $(Value *aRaw);
}|]
RawValue -> Value Any
forall a. RawValue -> Value a
Value (RawValue -> Value Any) -> IO RawValue -> IO (Value Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Value' -> IO RawValue
mkRawValue Ptr Value'
v
instance ToRawValue a => ToRawValue [a]
instance ToRawValue a => ToValue [a] where
type NixTypeFor [a] = NixList
toValue :: Ptr EvalState -> [a] -> IO (Value (NixTypeFor [a]))
toValue Ptr EvalState
es [a]
l = Ptr EvalState -> Vector a -> IO (Value (NixTypeFor (Vector a)))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
l)