{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}

module Dovetail.Core.Record.Unsafe where

import Data.Foldable (fold)
import Data.Text (Text)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Dovetail
import Dovetail.Evaluate (builtIn)

env :: forall ctx. Env ctx
env :: Env ctx
env = do
  let _ModuleName :: ModuleName
_ModuleName = Text -> ModuleName
ModuleName Text
"Record.Unsafe"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- unsafeHas :: forall r1. String -> Record r1 -> Boolean
      ModuleName
-> Text
-> (Text -> HashMap Text (Value ctx) -> Eval ctx Bool)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> HashMap Text (Value ctx) -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"unsafeHas"
        \Text
k HashMap Text (Value ctx)
r -> 
          Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text (Value ctx) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
k HashMap Text (Value ctx)
r)
      -- unsafeGet :: forall r a. String -> Record r -> a
    , ModuleName
-> Text
-> (Text -> HashMap Text (Value ctx) -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> HashMap Text (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"unsafeGet"
        \Text
k HashMap Text (Value ctx)
r -> 
          case Text -> HashMap Text (Value ctx) -> Maybe (Value ctx)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
k HashMap Text (Value ctx)
r of
            Maybe (Value ctx)
Nothing -> 
              EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError (Text
"unsafeGet: key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" did not exist in record"))
            Just Value ctx
a ->
              Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
a
      -- unsafeSet :: forall r1 r2 a. String -> a -> Record r1 -> Record r2
    , ModuleName
-> Text
-> (Text
    -> Value ctx
    -> HashMap Text (Value ctx)
    -> Eval ctx (HashMap Text (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Value ctx -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeSet"
        \Text
k Value ctx
a HashMap Text (Value ctx)
r ->
          HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
-> Value ctx
-> HashMap Text (Value ctx)
-> HashMap Text (Value ctx)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
k Value ctx
a HashMap Text (Value ctx)
r)
      -- unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2
    , ModuleName
-> Text
-> (Text
    -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeDelete"
        \Text
k HashMap Text (Value ctx)
r -> 
          HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text (Value ctx) -> HashMap Text (Value ctx)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Text
k HashMap Text (Value ctx)
r)
    ]