{-# 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,
    setExtraStackOverflowHandlerToSleep,
    initThread,
    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(..),

    -- * Re-exports
    RawValue,
    rawValueType,
    module Hercules.CNix.Store,
    module Hercules.CNix.Expr.Typed,
    type EvalState,
  )
where

-- TODO: No more Ptr EvalState
-- TODO: No more NixStore when EvalState is already there
-- TODO: Map Nix-specific C++ exceptions to a CNix exception type

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 =
  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);
    } |]

initThread :: IO ()
initThread :: IO ()
initThread =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void
    [C.throwBlock| void {
      nix::detectStackOverflow();
    }|]

{- | Configure the stack overflow handler to sleep before returning, allowing
  other threads to continue for a bit.

  No-op before Nix 2.12
-}
setExtraStackOverflowHandlerToSleep :: IO ()
setExtraStackOverflowHandlerToSleep :: IO ()
setExtraStackOverflowHandlerToSleep =
#if NIX_IS_AT_LEAST(2,12,0)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void
    [C.throwBlock| void {
      nix::stackOverflowHandler = [](siginfo_t *info, void *ctx) {
        Error error("stack overflow");
        logError(error.info());

        // This is risky for a signal handler.
        // Note that the original thread is now in a permanently blocked state
        // so we can easily create a deadlock.
        // Allow the rest of the process to continue for a bit.
        sleep(1);
        _exit(1);
        };
    }|]
#else
  pass
#endif

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) =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    ( forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        [C.throwBlock| EvalState* {
          Strings searchPaths;
          return new EvalState(searchPaths, *$(refStore* store));
        } |]
    )
    (\Ptr EvalState
x -> 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) =
  forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
    ( forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        [C.throwBlock| EvalState* {
          Strings searchPaths;
          return new EvalState(searchPaths, *$(refStore* store));
        } |]
    )
    (\Ptr EvalState
x -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO [C.throwBlock| void { delete $(EvalState* x); } |])

-- | Insert an allowed path. Only has an effect when in restricted or pure mode.
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS 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
    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);
    }|]

-- leaks
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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
args forall a b. (a -> b) -> a -> b
$ Ptr Strings -> ByteString -> IO ()
appendString Ptr Strings
argsStrings
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. RawValue -> Value a
unsafeAssertType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Value' -> IO RawValue
mkRawValue
    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
    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 forall a. Eq a => a -> a -> 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 forall a. Eq a => a -> a -> 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 forall a. Eq a => a -> a -> 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,14,0)
            return evalState.forceBool(*iter->value, iter->pos, "while evaluating whether to traverse into an attribute set to find more derivations");
#elif 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
    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;
      }
    }|]

-- | Converts 'nullPtr' to 'Nothing'; actual values to @Just (a :: 'RawValue')@
mkNullableRawValue :: Ptr Value' -> IO (Maybe RawValue)
mkNullableRawValue :: Ptr Value' -> IO (Maybe RawValue)
mkNullableRawValue Ptr Value'
p | Ptr Value'
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
mkNullableRawValue Ptr Value'
p = forall a. a -> Maybe a
Just 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 forall a. Eq a => a -> a -> Bool
== Ptr Attr'
end = 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 <- 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 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' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ByteString
name RawValue
value Map ByteString RawValue
acc
        seq :: forall a b. a -> b -> b
seq Map ByteString RawValue
acc' forall (f :: * -> *). Applicative f => f ()
pass
        Map ByteString RawValue
-> Ptr Attr' -> IO (Map ByteString RawValue)
gather Map ByteString RawValue
acc' 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 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) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
    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 forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)) \RawValue
attr -> do
    Ptr EvalState -> RawValue -> IO (Either SomeException Match)
match Ptr EvalState
evalState RawValue
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left SomeException
e -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just Bool
b)
      Right Match
_ -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [C.exp| Value * { $(Value *nixList)->listElems()[$(int i)] }|]
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt
0 .. (CInt
len 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 forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)) \RawValue
attr -> do
    Ptr EvalState -> RawValue -> IO (Either SomeException Match)
match Ptr EvalState
evalState RawValue
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left SomeException
e -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just [RawValue]
b)
      Right Match
_ -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing

-- | Parse a string and eval it.
valueFromExpressionString ::
  Ptr EvalState ->
  -- | The string to parse
  ByteString ->
  -- | Base path for path exprs
  ByteString ->
  IO RawValue
valueFromExpressionString :: Ptr EvalState -> ByteString -> ByteString -> IO RawValue
valueFromExpressionString Ptr EvalState
evalState ByteString
s ByteString
basePath = do
  Ptr Value' -> IO RawValue
mkRawValue
    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;
  }|]

-- | 'apply' but strict.
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
    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
    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 =
  forall a. RawValue -> Value a
Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Ptr Value' -> IO RawValue
mkRawValue
            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,
#if NIX_IS_AT_LEAST(2,13,0)
          .allowUnlocked = false,
#else
          .allowMutable = false,
#endif
        }),
      *r);
    return r;
  }|]
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
makeAbsolute (forall a b. ConvertText a b => a -> b
toS Text
path)
  Ptr Value' -> IO RawValue
mkRawValue
    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,
#if NIX_IS_AT_LEAST(2,13,0)
          .allowUnlocked = false,
#else
          .allowMutable = false,
#endif
        }),
      *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,
#if NIX_IS_AT_LEAST(2,13,0)
          .allowUnlocked = false,
#else
          .allowMutable = false,
#endif
        }),
      *r);
    return r;
  }|]
    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 <-
    forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState forall a b. (a -> b) -> a -> b
$
      (ByteString
"url" :: ByteString) 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 <- 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 = 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
more) (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 = forall a. Value a -> RawValue
rtValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))

-- | Marshall values from Nix into Haskell. Instances must satisfy the
-- requirements that:
--
--  - Only a single Nix value type is acceptable for the Haskell type.
--  - Marshalling does not fail, as the Nix runtime type has already been checked.
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

-- | Identity
instance ToRawValue RawValue where
  toRawValue :: Ptr EvalState -> RawValue -> IO RawValue
toRawValue Ptr EvalState
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Upcast
instance ToRawValue (Value a)

-- | Identity
instance ToValue (Value a) where
  type NixTypeFor (Value a) = a
  toValue :: Ptr EvalState -> Value a -> IO (Value (NixTypeFor (Value a)))
toValue Ptr EvalState
_ = 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 =
    coerce :: forall a b. Coercible a b => a -> b
coerce
      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 = 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 = forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (CBool
1 :: C.CBool)

-- | The native Nix integer type
instance ToRawValue Int64

-- | The native Nix integer type
instance ToValue Int64 where
  type NixTypeFor Int64 = NixInt
  toValue :: Ptr EvalState -> Int64 -> IO (Value (NixTypeFor Int64))
toValue Ptr EvalState
_ Int64
i =
    coerce :: forall a b. Coercible a b => a -> b
coerce
      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 = forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (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 =
    coerce :: forall a b. Coercible a b => a -> b
coerce
      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 = forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (forall a. Fractional a => Rational -> a
fromRational (forall a. Real a => a -> Rational
toRational Double
f) :: C.CDouble)

-- | Nix String
instance ToValue ByteString where
  type NixTypeFor ByteString = NixString
  toValue :: Ptr EvalState -> ByteString -> IO (Value (NixTypeFor ByteString))
toValue Ptr EvalState
_ ByteString
s =
    -- TODO simplify when r->mkString(string_view) is safe in all supported Nix versions
    coerce :: forall a b. Coercible a b => a -> b
coerce
      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;
  }|]

-- | Nix String
instance ToRawValue ByteString

-- | UTF-8
instance ToRawValue Text

-- | UTF-8
instance ToValue Text where
  type NixTypeFor Text = NixString
  toValue :: Ptr EvalState -> Text -> IO (Value (NixTypeFor Text))
toValue Ptr EvalState
es Text
s = 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
  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;
    }|]
    forall a. RawValue -> Value a
Value 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n
  in
    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 = forall n.
Integral n =>
Ptr EvalState
-> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder Ptr EvalState
evalState (forall (t :: * -> *) a. Foldable t => t a -> Int
length Map ByteString a
attrs) \Ptr BindingsBuilder'
bb -> do
    Map ByteString a
attrs forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> Map k a -> f ()
traverseWithKey_ \ByteString
k a
a -> do
      RawValue Ptr Value'
aRaw <- 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 = forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
evalState (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 =
  coerce :: forall a b. Coercible a b => a -> b
coerce
    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) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Bool
b
  toRawValue Ptr EvalState
es (A.String Text
s) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Text
s
  toRawValue Ptr EvalState
es (A.Object Object
fs) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es forall a b. (a -> b) -> a -> b
$ 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 <- forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
n = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (Int64
i :: Int64)
  toRawValue Ptr EvalState
es (A.Number Scientific
f) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (forall a. RealFloat a => Scientific -> a
Sci.toRealFloat Scientific
f :: Double)
  toRawValue Ptr EvalState
es (A.Array Array
a) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es Array
a

-- | For deriving-via of 'ToRawValue' using 'ToJSON'.
newtype ViaJSON a = ViaJSON {forall a. ViaJSON a -> a
fromViaJSON :: a}
  deriving newtype (ViaJSON a -> ViaJSON a -> Bool
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, 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]
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
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) = forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
es (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 = 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
more) (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 = forall n.
Integral n =>
Ptr EvalState
-> n -> (Ptr BindingsBuilder' -> IO ()) -> IO (Value NixAttrs)
withBindingsBuilder Ptr EvalState
evalState (forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Text a
attrs) \Ptr BindingsBuilder'
bb -> do
    HashMap Text a
attrs forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f ()) -> HashMap k a -> f ()
hmTraverseWithKey_ \Text
k' a
a -> do
      RawValue Ptr Value'
aRaw <- 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 =
    coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let l :: C.CInt
          l :: CInt
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ \Int
i a
a -> do
        RawValue Ptr Value'
aRaw <- forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a
        let ix :: CInt
ix = 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);
        }|]
      forall a. RawValue -> Value a
Value 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 = forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
es (forall a. [a] -> Vector a
V.fromList [a]
l)