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

module Dovetail.Core.Record.Builder 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.Builder"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- copyRecord :: forall r1. Record r1 -> Record r1
      ModuleName
-> 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 @(HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
        ModuleName
_ModuleName Text
"copyRecord"
        HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      -- unsafeInsert :: forall a r1 r2. 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
"unsafeInsert"
        \Text
k Value ctx
v HashMap Text (Value ctx)
m ->
          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
v HashMap Text (Value ctx)
m)
      -- unsafeModify :: forall a b r1 r2. String -> (a -> b) -> Record r1 -> Record r2
    , ModuleName
-> Text
-> (Text
    -> (Value ctx -> Eval ctx (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 -> Eval ctx (Value ctx)) -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeModify"
        \Text
k Value ctx -> Eval ctx (Value ctx)
f HashMap Text (Value ctx)
m -> do
          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)
m of
            Just Value ctx
old -> do
              Value ctx
new <- Value ctx -> Eval ctx (Value ctx)
f Value ctx
old
              HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
-> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall a b. (a -> b) -> a -> b
$ 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
new HashMap Text (Value ctx)
m
            Maybe (Value ctx)
Nothing ->
              HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text (Value ctx)
m
      -- 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)
m ->
          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)
m)
      -- unsafeRename :: forall r1 r2. String -> String -> Record r1 -> Record r2
    , ModuleName
-> Text
-> (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 -> Text -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeRename"
        \Text
k1 Text
k2 HashMap Text (Value ctx)
m -> do
          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
k1 HashMap Text (Value ctx)
m of
            Just Value ctx
v -> do
              HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
-> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall a b. (a -> b) -> a -> b
$ 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
k2 Value ctx
v (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
k1 HashMap Text (Value ctx)
m)
            Maybe (Value ctx)
Nothing -> 
              HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text (Value ctx)
m
    ]