graphql-engine/server/src-lib/Hasura/LogicalModel/Common.hs
Tom Harding 7e334e08a4 Import HashMap, not HM, Map, M...
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8947
GitOrigin-RevId: 18e52c928e1df535579e2077b4af6c2ce92bdcef
2023-04-26 15:43:44 +00:00

71 lines
2.4 KiB
Haskell

module Hasura.LogicalModel.Common
( toFieldInfo,
columnsFromFields,
logicalModelFieldsToFieldInfo,
)
where
import Data.Bifunctor (bimap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrd
import Data.Text.Extended (ToTxt (toTxt))
import Hasura.LogicalModel.Types (LogicalModelField (..))
import Hasura.NativeQuery.Types (NullableScalarType (..))
import Hasura.Prelude
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.Column (ColumnInfo (..), ColumnMutability (..), ColumnType (..), fromCol)
import Hasura.RQL.Types.Table (FieldInfo (..), FieldInfoMap)
import Language.GraphQL.Draft.Syntax qualified as G
columnsFromFields ::
InsOrd.InsOrdHashMap k (LogicalModelField b) ->
InsOrd.InsOrdHashMap k (NullableScalarType b)
columnsFromFields =
InsOrd.mapMaybe
( \case
LogicalModelScalarField
{ lmfType = nstType,
lmfNullable = nstNullable,
lmfDescription = nstDescription
} ->
Just (NullableScalarType {..})
_ -> Nothing
)
toFieldInfo :: forall b. (Backend b) => InsOrd.InsOrdHashMap (Column b) (NullableScalarType b) -> Maybe [FieldInfo b]
toFieldInfo fields =
traverseWithIndex
(\i -> fmap FIColumn . logicalModelToColumnInfo i)
(InsOrd.toList fields)
traverseWithIndex :: (Applicative m) => (Int -> aa -> m bb) -> [aa] -> m [bb]
traverseWithIndex f = zipWithM f [0 ..]
logicalModelToColumnInfo :: forall b. (Backend b) => Int -> (Column b, NullableScalarType b) -> Maybe (ColumnInfo b)
logicalModelToColumnInfo i (column, NullableScalarType {..}) = do
name <- G.mkName (toTxt column)
pure $
ColumnInfo
{ ciColumn = column,
ciName = name,
ciPosition = i,
ciType = ColumnScalar nstType,
ciIsNullable = nstNullable,
ciDescription = G.Description <$> nstDescription,
ciMutability = ColumnMutability {_cmIsInsertable = False, _cmIsUpdatable = False}
}
logicalModelFieldsToFieldInfo ::
forall b.
(Backend b) =>
InsOrd.InsOrdHashMap (Column b) (LogicalModelField b) ->
FieldInfoMap (FieldInfo b)
logicalModelFieldsToFieldInfo =
HashMap.fromList
. fmap (bimap (fromCol @b) FIColumn)
. fromMaybe mempty
. traverseWithIndex
(\i (column, lmf) -> (,) column <$> logicalModelToColumnInfo i (column, lmf))
. InsOrd.toList
. columnsFromFields