{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module Language.Jsonnet.Value where
import Control.Lens (view)
import Control.Monad.Except
import Control.Monad.Reader
import Data.HashMap.Lazy (HashMap)
import Data.IORef
import Data.Map.Lazy (Map)
import Data.Scientific
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Generics
import Language.Jsonnet.Common
import Language.Jsonnet.Core
import Language.Jsonnet.Eval.Monad
import Language.Jsonnet.Pretty ()
import Unbound.Generics.LocallyNameless
type Eval = EvalM Value
type Env = Ctx Value
data Value
= VNull
| VBool !Bool
| VStr !Text
| VNum !Scientific
| VObj !Object
| VArr !(Vector Value)
| VThunk !Core !Env
| VIndir !Ref
| VPrim !Prim
| VClos !Lam !Env
| VFun !Fun
data VField = VField
{
VField -> Value
fieldKey :: Value,
VField -> Value
fieldValWHNF :: Value,
VField -> Value
fieldVal :: Value,
VField -> Visibility
fieldVis :: Visibility
}
deriving ((forall x. VField -> Rep VField x)
-> (forall x. Rep VField x -> VField) -> Generic VField
forall x. Rep VField x -> VField
forall x. VField -> Rep VField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VField x -> VField
$cfrom :: forall x. VField -> Rep VField x
Generic)
type Fun = Value -> Eval Value
type Object = HashMap Text VField
data Cell = Cell {Cell -> Value
cellVal :: Value, Cell -> Bool
cellIsWHNF :: Bool}
deriving ((forall x. Cell -> Rep Cell x)
-> (forall x. Rep Cell x -> Cell) -> Generic Cell
forall x. Rep Cell x -> Cell
forall x. Cell -> Rep Cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cell x -> Cell
$cfrom :: forall x. Cell -> Rep Cell x
Generic)
type Ref = IORef Cell
instance HasVisibility VField where
visible :: VField -> Bool
visible VField {Visibility
Value
fieldVis :: Visibility
fieldVal :: Value
fieldValWHNF :: Value
fieldKey :: Value
fieldVis :: VField -> Visibility
fieldVal :: VField -> Value
fieldValWHNF :: VField -> Value
fieldKey :: VField -> Value
..} = Visibility
fieldVis Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Visible
forced :: VField -> Bool
forced VField {Visibility
Value
fieldVis :: Visibility
fieldVal :: Value
fieldValWHNF :: Value
fieldKey :: Value
fieldVis :: VField -> Visibility
fieldVal :: VField -> Value
fieldValWHNF :: VField -> Value
fieldKey :: VField -> Value
..} = Visibility
fieldVis Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Forced
hidden :: VField -> Bool
hidden VField {Visibility
Value
fieldVis :: Visibility
fieldVal :: Value
fieldValWHNF :: Value
fieldKey :: Value
fieldVis :: VField -> Visibility
fieldVal :: VField -> Value
fieldValWHNF :: VField -> Value
fieldKey :: VField -> Value
..} = Visibility
fieldVis Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Hidden
class HasValue a where
inj :: a -> Value
proj :: Value -> Eval a
instance HasValue Value where
inj :: Value -> Value
inj = Value -> Value
forall a. a -> a
id
proj :: Value -> Eval Value
proj = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure
mkCell :: Value -> Cell
mkCell :: Value -> Cell
mkCell Value
v = Value -> Bool -> Cell
Cell Value
v Bool
False
mkIndirV :: MonadIO m => Value -> m Value
mkIndirV :: Value -> m Value
mkIndirV Value
v = Ref -> Value
VIndir (Ref -> Value) -> m Ref -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m Ref
forall (m :: * -> *). MonadIO m => Value -> m Ref
allocate Value
v
mkThunk :: Core -> Eval Value
mkThunk :: Core -> Eval Value
mkThunk Core
c = Core -> Env -> Value
VThunk Core
c (Env -> Value) -> EvalM Value Env -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Env (EvalState Value) Env -> EvalM Value Env
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Env (EvalState Value) Env
forall a1 a2. Lens (EvalState a1) (EvalState a2) (Ctx a1) (Ctx a2)
ctx
allocate :: MonadIO m => Value -> m (IORef Cell)
allocate :: Value -> m Ref
allocate = IO Ref -> m Ref
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ref -> m Ref) -> (Value -> IO Ref) -> Value -> m Ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell -> IO Ref
forall a. a -> IO (IORef a)
newIORef (Cell -> IO Ref) -> (Value -> Cell) -> Value -> IO Ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Cell
mkCell