{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module                  : Language.Jsonnet.Value
-- Copyright               : (c) 2020-2021 Alexandre Moreno
-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0
-- Maintainer              : Alexandre Moreno <alexmorenocano@gmail.com>
-- Stability               : experimental
-- Portability             : non-portable
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 -- !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