morley-upgradeable-0.3: src/Lorentz/UStore/Instances.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-orphans #-}

module Lorentz.UStore.Instances
  ( ustoreFieldOps
  , ustoreSubmapOps
  ) where

import Prelude ((.))

import Lorentz.StoreClass
import Lorentz.UStore.Instr
import Lorentz.UStore.Types

ustoreFieldOps
  :: HasUField fname ftype templ
  => StoreFieldOps (UStore templ) fname ftype
ustoreFieldOps =
  StoreFieldOps
  { sopToField = ustoreToField . fieldNameToLabel
  , sopSetField = ustoreSetField . fieldNameToLabel
  }

instance HasUField fname ftype templ =>
         StoreHasField (UStore templ) fname ftype where
  storeFieldOps = ustoreFieldOps

ustoreSubmapOps
  :: HasUStore mname key value templ
  => StoreSubmapOps (UStore templ) mname key value
ustoreSubmapOps = StoreSubmapOps
  { sopMem = ustoreMem . fieldNameToLabel
  , sopGet = ustoreGet . fieldNameToLabel
  , sopUpdate = ustoreUpdate . fieldNameToLabel
  , sopDelete = ustoreDelete . fieldNameToLabel
  , sopInsert = ustoreInsert . fieldNameToLabel
  }

instance {-# OVERLAPPING #-}
         HasUStore mname key value templ =>
         StoreHasSubmap (UStore templ) mname key value where
  storeSubmapOps = ustoreSubmapOps