module Hasql.Codecs.Vocab.OidCache
  ( OidCache,

    -- * Accessors
    toHashMap,
    lookupScalar,
    lookupArray,
    lookupTypeNameScalar,
    lookupTypeNameArray,
    lookupTypeInfo,

    -- * Constructors
    fromHashMap,
    empty,
    selectUnknownNames,
    insertScalar,
  )
where

import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HashSet
import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)
import Hasql.Codecs.Vocab.QualifiedTypeName qualified as QualifiedTypeName
import Hasql.Codecs.Vocab.TypeInfo qualified as TypeInfo
import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)

-- | Pure registry state containing the hash map and counter
newtype OidCache
  = OidCache
      -- | By name of the type.
      --
      -- > scalar name -> TypeInfo (scalar OID, array OID)
      (HashMap QualifiedTypeName TypeInfo.TypeInfo)
  deriving stock (Int -> OidCache -> ShowS
[OidCache] -> ShowS
OidCache -> String
(Int -> OidCache -> ShowS)
-> (OidCache -> String) -> ([OidCache] -> ShowS) -> Show OidCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OidCache -> ShowS
showsPrec :: Int -> OidCache -> ShowS
$cshow :: OidCache -> String
show :: OidCache -> String
$cshowList :: [OidCache] -> ShowS
showList :: [OidCache] -> ShowS
Show, OidCache -> OidCache -> Bool
(OidCache -> OidCache -> Bool)
-> (OidCache -> OidCache -> Bool) -> Eq OidCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OidCache -> OidCache -> Bool
== :: OidCache -> OidCache -> Bool
$c/= :: OidCache -> OidCache -> Bool
/= :: OidCache -> OidCache -> Bool
Eq)

instance Semigroup OidCache where
  OidCache HashMap QualifiedTypeName TypeInfo
byNameL <> :: OidCache -> OidCache -> OidCache
<> OidCache HashMap QualifiedTypeName TypeInfo
byNameR =
    HashMap QualifiedTypeName TypeInfo -> OidCache
OidCache (HashMap QualifiedTypeName TypeInfo
-> HashMap QualifiedTypeName TypeInfo
-> HashMap QualifiedTypeName TypeInfo
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
HashMap.union HashMap QualifiedTypeName TypeInfo
byNameR HashMap QualifiedTypeName TypeInfo
byNameL)

instance Monoid OidCache where
  mempty :: OidCache
mempty = HashMap QualifiedTypeName TypeInfo -> OidCache
OidCache HashMap QualifiedTypeName TypeInfo
forall a. Monoid a => a
mempty

{-# INLINEABLE empty #-}
empty :: OidCache
empty :: OidCache
empty =
  HashMap QualifiedTypeName TypeInfo -> OidCache
OidCache HashMap QualifiedTypeName TypeInfo
forall k v. HashMap k v
HashMap.empty

-- | Having a set of required type names, select those that are not present in the cache.
{-# INLINE selectUnknownNames #-}
selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName
selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName
selectUnknownNames HashSet QualifiedTypeName
keys (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  (QualifiedTypeName -> Bool)
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (\QualifiedTypeName
key -> Bool -> Bool
not (QualifiedTypeName -> HashMap QualifiedTypeName TypeInfo -> Bool
forall k a. Hashable k => k -> HashMap k a -> Bool
HashMap.member QualifiedTypeName
key HashMap QualifiedTypeName TypeInfo
byName)) HashSet QualifiedTypeName
keys

insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache
insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache
insertScalar Maybe Text
schema Text
name Word32
scalar Word32
array (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  HashMap QualifiedTypeName TypeInfo -> OidCache
OidCache (QualifiedTypeName
-> TypeInfo
-> HashMap QualifiedTypeName TypeInfo
-> HashMap QualifiedTypeName TypeInfo
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Maybe Text -> Text -> QualifiedTypeName
QualifiedTypeName.QualifiedTypeName Maybe Text
schema Text
name) (Word32 -> Word32 -> TypeInfo
TypeInfo.TypeInfo Word32
scalar Word32
array) HashMap QualifiedTypeName TypeInfo
byName)

{-# INLINE fromHashMap #-}
fromHashMap :: HashMap QualifiedTypeName TypeInfo.TypeInfo -> OidCache
fromHashMap :: HashMap QualifiedTypeName TypeInfo -> OidCache
fromHashMap HashMap QualifiedTypeName TypeInfo
byName = HashMap QualifiedTypeName TypeInfo -> OidCache
OidCache HashMap QualifiedTypeName TypeInfo
byName

-- * Accessors

{-# INLINE lookupScalar #-}
lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32
lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32
lookupScalar Maybe Text
schema Text
name (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text -> Text -> QualifiedTypeName
QualifiedTypeName.QualifiedTypeName Maybe Text
schema Text
name) HashMap QualifiedTypeName TypeInfo
byName Maybe TypeInfo -> (TypeInfo -> Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \TypeInfo
info -> TypeInfo -> Word32
TypeInfo.toBaseOid TypeInfo
info

{-# INLINE lookupArray #-}
lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32
lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32
lookupArray Maybe Text
schema Text
name (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text -> Text -> QualifiedTypeName
QualifiedTypeName.QualifiedTypeName Maybe Text
schema Text
name) HashMap QualifiedTypeName TypeInfo
byName Maybe TypeInfo -> (TypeInfo -> Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \TypeInfo
info -> TypeInfo -> Word32
TypeInfo.toArrayOid TypeInfo
info

{-# INLINE lookupTypeNameScalar #-}
lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32
lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32
lookupTypeNameScalar QualifiedTypeName
name (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup QualifiedTypeName
name HashMap QualifiedTypeName TypeInfo
byName Maybe TypeInfo -> (TypeInfo -> Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypeInfo -> Word32
TypeInfo.toBaseOid

{-# INLINE lookupTypeNameArray #-}
lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32
lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32
lookupTypeNameArray QualifiedTypeName
name (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup QualifiedTypeName
name HashMap QualifiedTypeName TypeInfo
byName Maybe TypeInfo -> (TypeInfo -> Word32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypeInfo -> Word32
TypeInfo.toArrayOid

{-# INLINE lookupTypeInfo #-}
lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo.TypeInfo
lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo
lookupTypeInfo QualifiedTypeName
name (OidCache HashMap QualifiedTypeName TypeInfo
byName) =
  QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup QualifiedTypeName
name HashMap QualifiedTypeName TypeInfo
byName

{-# INLINE toHashMap #-}
toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo.TypeInfo
toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo
toHashMap (OidCache HashMap QualifiedTypeName TypeInfo
byName) = HashMap QualifiedTypeName TypeInfo
byName