-- | This module defines the type class 'PostgresAnnotatedFieldJSON'.
module Hasura.Backends.Postgres.Translate.Select.AnnotatedFieldJSON
  ( PostgresAnnotatedFieldJSON (..),
  )
where

import Data.Text qualified as T
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.Translate.Select.Internal.Helpers (withJsonBuildObj)
import Hasura.Prelude
import Hasura.RQL.Types.Common (FieldName (getFieldNameTxt))
import Hasura.SQL.Backend (PostgresKind (..))

class PostgresAnnotatedFieldJSON (pgKind :: PostgresKind) where
  annRowToJson :: FieldName -> [(FieldName, S.SQLExp)] -> (S.ColumnAlias, S.SQLExp)

instance PostgresAnnotatedFieldJSON 'Vanilla where
  annRowToJson :: FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
annRowToJson = FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
pgAnnRowToJson

instance PostgresAnnotatedFieldJSON 'Citus where
  annRowToJson :: FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
annRowToJson FieldName
fieldAlias [(FieldName, SQLExp)]
fieldExps =
    -- Due to the restrictions Citus imposes on joins between tables of various
    -- distribution types we cannot use row_to_json and have to only rely on
    -- json_build_object.
    FieldName -> [SQLExp] -> (ColumnAlias, SQLExp)
withJsonBuildObj FieldName
fieldAlias ([SQLExp] -> (ColumnAlias, SQLExp))
-> [SQLExp] -> (ColumnAlias, SQLExp)
forall a b. (a -> b) -> a -> b
$ ((FieldName, SQLExp) -> [SQLExp])
-> [(FieldName, SQLExp)] -> [SQLExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FieldName, SQLExp) -> [SQLExp]
toJsonBuildObjectExps [(FieldName, SQLExp)]
fieldExps
    where
      toJsonBuildObjectExps :: (FieldName, SQLExp) -> [SQLExp]
toJsonBuildObjectExps (FieldName
fieldName, SQLExp
fieldExp) =
        [Text -> SQLExp
S.SELit (Text -> SQLExp) -> Text -> SQLExp
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt FieldName
fieldName, SQLExp
fieldExp]

instance PostgresAnnotatedFieldJSON 'Cockroach where
  annRowToJson :: FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
annRowToJson = FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
pgAnnRowToJson

pgAnnRowToJson :: FieldName -> [(FieldName, S.SQLExp)] -> (S.ColumnAlias, S.SQLExp)
pgAnnRowToJson :: FieldName -> [(FieldName, SQLExp)] -> (ColumnAlias, SQLExp)
pgAnnRowToJson FieldName
fieldAlias [(FieldName, SQLExp)]
fieldExps =
  -- postgres ignores anything beyond 63 chars for an iden
  -- in this case, we'll need to use json_build_object function
  -- json_build_object is slower than row_to_json hence it is only
  -- used when needed
  if ((FieldName, SQLExp) -> Bool) -> [(FieldName, SQLExp)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63) (Int -> Bool)
-> ((FieldName, SQLExp) -> Int) -> (FieldName, SQLExp) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int)
-> ((FieldName, SQLExp) -> Text) -> (FieldName, SQLExp) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt (FieldName -> Text)
-> ((FieldName, SQLExp) -> FieldName)
-> (FieldName, SQLExp)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName, SQLExp) -> FieldName
forall a b. (a, b) -> a
fst) [(FieldName, SQLExp)]
fieldExps
    then FieldName -> [SQLExp] -> (ColumnAlias, SQLExp)
withJsonBuildObj FieldName
fieldAlias ([SQLExp] -> (ColumnAlias, SQLExp))
-> [SQLExp] -> (ColumnAlias, SQLExp)
forall a b. (a -> b) -> a -> b
$ ((FieldName, SQLExp) -> [SQLExp])
-> [(FieldName, SQLExp)] -> [SQLExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FieldName, SQLExp) -> [SQLExp]
toJsonBuildObjectExps [(FieldName, SQLExp)]
fieldExps
    else FieldName -> [Extractor] -> (ColumnAlias, SQLExp)
withRowToJSON FieldName
fieldAlias ([Extractor] -> (ColumnAlias, SQLExp))
-> [Extractor] -> (ColumnAlias, SQLExp)
forall a b. (a -> b) -> a -> b
$ ((FieldName, SQLExp) -> Extractor)
-> [(FieldName, SQLExp)] -> [Extractor]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, SQLExp) -> Extractor
forall a. IsIdentifier a => (a, SQLExp) -> Extractor
toRowToJsonExtr [(FieldName, SQLExp)]
fieldExps
  where
    toJsonBuildObjectExps :: (FieldName, SQLExp) -> [SQLExp]
toJsonBuildObjectExps (FieldName
fieldName, SQLExp
fieldExp) =
      [Text -> SQLExp
S.SELit (Text -> SQLExp) -> Text -> SQLExp
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt FieldName
fieldName, SQLExp
fieldExp]

    toRowToJsonExtr :: (a, SQLExp) -> Extractor
toRowToJsonExtr (a
fieldName, SQLExp
fieldExp) =
      SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
fieldExp (Maybe ColumnAlias -> Extractor) -> Maybe ColumnAlias -> Extractor
forall a b. (a -> b) -> a -> b
$ ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ a -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias a
fieldName

    -- uses row_to_json to build a json object
    withRowToJSON ::
      FieldName -> [S.Extractor] -> (S.ColumnAlias, S.SQLExp)
    withRowToJSON :: FieldName -> [Extractor] -> (ColumnAlias, SQLExp)
withRowToJSON FieldName
parAls [Extractor]
extrs =
      (FieldName -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias FieldName
parAls, SQLExp
jsonRow)
      where
        jsonRow :: SQLExp
jsonRow = [Extractor] -> SQLExp
S.applyRowToJson [Extractor]
extrs