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

module Dovetail.Core.Record.Unsafe.Union where

import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Text (Text)
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.Union"

  -- unsafeUnionFn :: forall r1 r2 r3. Fn2 (Record r1) (Record r2) (Record r3)
  ModuleName
-> Text
-> (HashMap 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 @(HashMap Text (Value ctx) -> HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx)))
    ModuleName
_ModuleName Text
"unsafeUnionFn"
    \HashMap Text (Value ctx)
r1 HashMap Text (Value ctx)
r2 ->
      HashMap Text (Value ctx) -> Eval ctx (HashMap Text (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx)
-> HashMap Text (Value ctx) -> HashMap Text (Value ctx)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union HashMap Text (Value ctx)
r1 HashMap Text (Value ctx)
r2)