mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
5b70da8138
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/10069 GitOrigin-RevId: 6bdde406a57e394f7bf4cc1bae2b6411cbb4ffe0
56 lines
2.8 KiB
Haskell
56 lines
2.8 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Hasura.LogicalModel.Fields (LogicalModelFieldsRM (..), LogicalModelFieldsLookupRT (..), runLogicalModelFieldsLookup) where
|
|
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Hasura.Backends.Postgres.Connection qualified as Postgres
|
|
import Hasura.LogicalModel.Types
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Session (UserInfoM)
|
|
import Hasura.Tracing (TraceT)
|
|
|
|
-- | Class for looking up Logical Models
|
|
class (Monad m) => LogicalModelFieldsRM b m where
|
|
lookupLogicalModelFields :: LogicalModelName -> m (Maybe (LogicalModelFields b))
|
|
getLogicalModelFieldsLookup :: m (LogicalModelFieldsLookup b)
|
|
|
|
instance (LogicalModelFieldsRM b m) => LogicalModelFieldsRM b (ReaderT r m) where
|
|
lookupLogicalModelFields = lift . lookupLogicalModelFields
|
|
getLogicalModelFieldsLookup = lift getLogicalModelFieldsLookup
|
|
|
|
instance (LogicalModelFieldsRM b m) => LogicalModelFieldsRM b (StateT s m) where
|
|
lookupLogicalModelFields = lift . lookupLogicalModelFields
|
|
getLogicalModelFieldsLookup = lift getLogicalModelFieldsLookup
|
|
|
|
instance (Monoid w, LogicalModelFieldsRM b m) => LogicalModelFieldsRM b (WriterT w m) where
|
|
lookupLogicalModelFields = lift . lookupLogicalModelFields
|
|
getLogicalModelFieldsLookup = lift getLogicalModelFieldsLookup
|
|
|
|
instance (LogicalModelFieldsRM b m) => LogicalModelFieldsRM b (TraceT m) where
|
|
lookupLogicalModelFields = lift . lookupLogicalModelFields
|
|
getLogicalModelFieldsLookup = lift getLogicalModelFieldsLookup
|
|
|
|
type LogicalModelFieldsLookup b = LogicalModelName -> Maybe (LogicalModelFields b)
|
|
|
|
toLogicalModelFieldsLookup :: (a -> LogicalModelFields b) -> HashMap LogicalModelName a -> LogicalModelFieldsLookup b
|
|
toLogicalModelFieldsLookup f h logicalModelName = f <$> HashMap.lookup logicalModelName h
|
|
|
|
newtype LogicalModelFieldsLookupRT b m a = LogicalModelFieldsLookupRT {runLogicalModelFieldsLookupRT :: LogicalModelFieldsLookup b -> m a}
|
|
deriving
|
|
(Functor, Applicative, Monad, MonadIO, MonadError e, MonadState s, MonadWriter w, Postgres.MonadTx, UserInfoM)
|
|
via (ReaderT (LogicalModelFieldsLookup b) m)
|
|
deriving (MonadTrans) via (ReaderT (LogicalModelFieldsLookup b))
|
|
|
|
runLogicalModelFieldsLookup :: (x -> LogicalModelFields b) -> HashMap LogicalModelName x -> LogicalModelFieldsLookupRT b m a -> m a
|
|
runLogicalModelFieldsLookup f h m =
|
|
runLogicalModelFieldsLookupRT m $ toLogicalModelFieldsLookup f h
|
|
|
|
instance (MonadReader r m) => MonadReader r (LogicalModelFieldsLookupRT b m) where
|
|
ask = lift ask
|
|
local f m = LogicalModelFieldsLookupRT (local f . runLogicalModelFieldsLookupRT m)
|
|
|
|
instance (Monad m) => LogicalModelFieldsRM b (LogicalModelFieldsLookupRT b m) where
|
|
lookupLogicalModelFields logicalModelName =
|
|
LogicalModelFieldsLookupRT $ pure . ($ logicalModelName)
|
|
getLogicalModelFieldsLookup = LogicalModelFieldsLookupRT pure
|