{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Hercules.CNix.Expr.Raw
( RawValue (..),
mkRawValue,
RawValueType (..),
rawValueType,
forceValue,
canonicalRawType,
)
where
import Hercules.CNix.Expr.Context
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exception as C
import Protolude hiding (evalState)
import Prelude ()
C.context context
C.include "<nix/config.h>"
C.include "<nix/eval.hh>"
C.include "<nix/eval-inline.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"
newtype RawValue = RawValue (Ptr Value')
mkRawValue :: Ptr Value' -> IO RawValue
mkRawValue :: Ptr Value' -> IO RawValue
mkRawValue Ptr Value'
p = RawValue -> IO RawValue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawValue -> IO RawValue) -> RawValue -> IO RawValue
forall a b. (a -> b) -> a -> b
$ Ptr Value' -> RawValue
RawValue Ptr Value'
p
data RawValueType
= Int
| Bool
| String
| Path
| Null
| Attrs
| List
| Thunk
| App
| Lambda
| Blackhole
| PrimOp
| PrimOpApp
| External
| Float
| Other
deriving ((forall x. RawValueType -> Rep RawValueType x)
-> (forall x. Rep RawValueType x -> RawValueType)
-> Generic RawValueType
forall x. Rep RawValueType x -> RawValueType
forall x. RawValueType -> Rep RawValueType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RawValueType -> Rep RawValueType x
from :: forall x. RawValueType -> Rep RawValueType x
$cto :: forall x. Rep RawValueType x -> RawValueType
to :: forall x. Rep RawValueType x -> RawValueType
Generic, Int -> RawValueType -> ShowS
[RawValueType] -> ShowS
RawValueType -> String
(Int -> RawValueType -> ShowS)
-> (RawValueType -> String)
-> ([RawValueType] -> ShowS)
-> Show RawValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawValueType -> ShowS
showsPrec :: Int -> RawValueType -> ShowS
$cshow :: RawValueType -> String
show :: RawValueType -> String
$cshowList :: [RawValueType] -> ShowS
showList :: [RawValueType] -> ShowS
Show, RawValueType -> RawValueType -> Bool
(RawValueType -> RawValueType -> Bool)
-> (RawValueType -> RawValueType -> Bool) -> Eq RawValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawValueType -> RawValueType -> Bool
== :: RawValueType -> RawValueType -> Bool
$c/= :: RawValueType -> RawValueType -> Bool
/= :: RawValueType -> RawValueType -> Bool
Eq, Eq RawValueType
Eq RawValueType =>
(RawValueType -> RawValueType -> Ordering)
-> (RawValueType -> RawValueType -> Bool)
-> (RawValueType -> RawValueType -> Bool)
-> (RawValueType -> RawValueType -> Bool)
-> (RawValueType -> RawValueType -> Bool)
-> (RawValueType -> RawValueType -> RawValueType)
-> (RawValueType -> RawValueType -> RawValueType)
-> Ord RawValueType
RawValueType -> RawValueType -> Bool
RawValueType -> RawValueType -> Ordering
RawValueType -> RawValueType -> RawValueType
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
$ccompare :: RawValueType -> RawValueType -> Ordering
compare :: RawValueType -> RawValueType -> Ordering
$c< :: RawValueType -> RawValueType -> Bool
< :: RawValueType -> RawValueType -> Bool
$c<= :: RawValueType -> RawValueType -> Bool
<= :: RawValueType -> RawValueType -> Bool
$c> :: RawValueType -> RawValueType -> Bool
> :: RawValueType -> RawValueType -> Bool
$c>= :: RawValueType -> RawValueType -> Bool
>= :: RawValueType -> RawValueType -> Bool
$cmax :: RawValueType -> RawValueType -> RawValueType
max :: RawValueType -> RawValueType -> RawValueType
$cmin :: RawValueType -> RawValueType -> RawValueType
min :: RawValueType -> RawValueType -> RawValueType
Ord)
rawValueType :: RawValue -> IO RawValueType
rawValueType :: RawValue -> IO RawValueType
rawValueType (RawValue Ptr Value'
v) =
CInt -> RawValueType
forall {a}. (Eq a, Num a) => a -> RawValueType
f
(CInt -> RawValueType) -> IO CInt -> IO RawValueType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block| int {
switch ($(Value* v)->type()) {
case nInt: return 1;
case nBool: return 2;
case nString: return 3;
case nPath: return 4;
case nNull: return 5;
case nAttrs: return 6;
case nList: return 7;
case nFunction: return 8;
case nExternal: return 9;
case nFloat: return 10;
case nThunk: return 11;
default: return 0;
}
}|]
where
f :: a -> RawValueType
f a
1 = RawValueType
Int
f a
2 = RawValueType
Bool
f a
3 = RawValueType
String
f a
4 = RawValueType
Path
f a
5 = RawValueType
Null
f a
6 = RawValueType
Attrs
f a
7 = RawValueType
List
f a
8 = RawValueType
Lambda
f a
9 = RawValueType
External
f a
10 = RawValueType
Float
f a
11 = RawValueType
Thunk
f a
_ = RawValueType
Other
forceValue :: (Exception a) => Ptr EvalState -> RawValue -> IO (Either a ())
forceValue :: forall a.
Exception a =>
Ptr EvalState -> RawValue -> IO (Either a ())
forceValue Ptr EvalState
evalState (RawValue Ptr Value'
v) =
IO () -> IO (Either a ())
forall e a. Exception e => IO a -> IO (Either e a)
try
[C.catchBlock| {
Value *v = $(Value *v);
if (v == NULL) throw std::invalid_argument("forceValue value must be non-null");
$(EvalState *evalState)->forceValue(*v, nix::noPos);
}|]
canonicalRawType :: RawValueType -> RawValueType
canonicalRawType :: RawValueType -> RawValueType
canonicalRawType = \case
RawValueType
App -> RawValueType
Thunk
RawValueType
Blackhole -> RawValueType
Thunk
RawValueType
PrimOp -> RawValueType
Lambda
RawValueType
PrimOpApp -> RawValueType
Lambda
RawValueType
x -> RawValueType
x