{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use list comprehension" #-}
{-# HLINT ignore "Replace case with maybe" #-}

module AirGQL.GraphQL (
  getDerivedSchema,
  queryType,
  sqlDataToGQLValue,
  getMutationResponse,
  gqlValueToSQLData,
)
where

import Protolude (
  Applicative (pure),
  Bool (False, True),
  Double,
  Either (Left, Right),
  Eq ((==)),
  IO,
  Int,
  Integer,
  Maybe (Just, Nothing),
  MonadIO (liftIO),
  MonadReader (ask),
  Monoid (mempty),
  ReaderT,
  Semigroup ((<>)),
  Text,
  Traversable (sequence),
  fromIntegral,
  fromMaybe,
  notElem,
  otherwise,
  show,
  when,
  ($),
  (&),
  (&&),
  (.),
  (<$>),
  (<&>),
  (<=),
  (>),
  (>=),
 )
import Protolude qualified as P

import Control.Exception (throw)
import Control.Monad.Catch (catchAll)
import Data.Aeson (object, (.=))
import Data.HashMap.Strict qualified as HashMap
import Data.List (nub)
import Data.Ord (Ord (min))
import Data.Text (intercalate, isInfixOf, pack, toUpper)
import Data.Text qualified as T
import Database.SQLite.Simple (
  Connection,
  Query (Query),
  SQLData (SQLBlob, SQLFloat, SQLInteger, SQLNull, SQLText),
  changes,
  execute_,
  query,
  query_,
 )
import Database.SQLite.Simple qualified as SS
import DoubleXEncoding (doubleXDecode, doubleXEncodeGql)
import GHC.IO.Exception (userError)
import Language.GraphQL.AST.Document (Name)
import Language.GraphQL.Error (ResolverException (ResolverException))
import Language.GraphQL.Type as GQL (
  Arguments (Arguments),
  EnumType (EnumType),
  EnumValue (EnumValue),
  InputField (InputField),
  Resolver (EventStreamResolver, ValueResolver),
  ScalarType,
  Schema,
  Value (Boolean, Enum, Float, Int, List, Null, Object, String),
  boolean,
  float,
  int,
  schema,
  string,
 )
import Language.GraphQL.Type.In (
  InputObjectType (InputObjectType),
  Type (NamedInputObjectType),
 )
import Language.GraphQL.Type.In qualified as In
import Language.GraphQL.Type.Out qualified as Out
import Numeric (showFFloat)

import AirGQL.Config (
  maxGraphqlResultCount,
 )
import AirGQL.GQLWrapper (
  InArgument (InArgument, argDescMb, argType, valueMb),
  OutField (OutField, arguments, descriptionMb, fieldType),
  inArgumentToArgument,
  outFieldToField,
 )
import AirGQL.Introspection (getSchemaResolver, typeNameResolver)
import AirGQL.Lib (
  AccessMode (ReadAndWrite, ReadOnly, WriteOnly),
  ColumnEntry (column_name, datatype, datatype_gql),
  GqlTypeName (root),
  TableEntryRaw (name),
  column_name_gql,
  getColumns,
 )
import AirGQL.Types.OutObjectType (
  OutObjectType (OutObjectType, descriptionMb, fields, interfaceTypes, name),
  outObjectTypeToObjectType,
 )
import AirGQL.Types.PragmaConf (getSQLitePragmas)
import AirGQL.Types.SchemaConf (
  SchemaConf (accessMode, maxRowsPerTable, pragmaConf),
 )
import AirGQL.Types.Utils (encodeToText)
import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText)


typeNameToScalarType :: Maybe GqlTypeName -> ScalarType
typeNameToScalarType :: Maybe GqlTypeName -> ScalarType
typeNameToScalarType Maybe GqlTypeName
Nothing = ScalarType
string
typeNameToScalarType (Just GqlTypeName
typeName) =
  case GqlTypeName
typeName.root of
    Text
"Int" -> ScalarType
int
    Text
"Float" -> ScalarType
float
    Text
"String" -> ScalarType
string
    Text
"Boolean" -> ScalarType
boolean
    Text
_ -> ScalarType
string


-- | Prevent numbers of being shown with exponents (0.01 instead of 1e-2)
showFullPrecision :: Double -> Text
showFullPrecision :: Double -> Text
showFullPrecision Double
x =
  String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Double
x String
""


showGqlValue :: Value -> Text
showGqlValue :: Value -> Text
showGqlValue = \case
  String Text
str -> Text
str
  Int Int32
integer -> Int32 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int32
integer
  Float Double
double -> Double -> Text
showFullPrecision Double
double
  Boolean Bool
bool -> Bool -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Bool
bool
  Enum Text
text -> Text
text
  List [Value]
list -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ([Value]
list [Value] -> (Value -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> Text
showGqlValue) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  Object HashMap Text Value
obj -> Value -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
Object HashMap Text Value
obj
  Value
Null -> Text
"null"


gqlValueToSQLText :: Value -> Text
gqlValueToSQLText :: Value -> Text
gqlValueToSQLText = \case
  String Text
str -> Text -> Text
quoteText Text
str
  Int Int32
integer -> Int32 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int32
integer
  Float Double
double -> Double -> Text
showFullPrecision Double
double
  Boolean Bool
bool -> Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Bool
bool
  Enum Text
text -> Text
text
  List [Value]
list ->
    Text -> Text
quoteText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ([Value]
list [Value] -> (Value -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> Text
showGqlValue) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  Object HashMap Text Value
obj -> Text -> Text
quoteText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
Object HashMap Text Value
obj
  Value
Null -> Text
"NULL"


-- TODO: Add Support for GraphQL's type "ID"

-- | Convert any GraphQL value to a nullable String
gqlValueToNullableString :: Value -> Value
gqlValueToNullableString :: Value -> Value
gqlValueToNullableString Value
value =
  case Value
value of
    String Text
text -> Text -> Value
String Text
text
    Value
Null -> Value
Null
    Value
val -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Text
showGqlValue Value
val


colNamesWithValResolver :: [ColumnEntry] -> [(Text, Resolver IO)]
colNamesWithValResolver :: [ColumnEntry] -> [(Text, Resolver IO)]
colNamesWithValResolver [ColumnEntry]
columnEntries =
  [ColumnEntry]
columnEntries [ColumnEntry]
-> (ColumnEntry -> (Text, Resolver IO)) -> [(Text, Resolver IO)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
colEntry ->
    let
      fieldToResolve :: Field IO
fieldToResolve =
        Maybe Text -> Type IO -> Arguments -> Field IO
forall (m :: * -> *). Maybe Text -> Type m -> Arguments -> Field m
Out.Field
          (Text -> Maybe Text
forall a. a -> Maybe a
Just ColumnEntry
colEntry.column_name_gql)
          ( ScalarType -> Type IO
forall (m :: * -> *). ScalarType -> Type m
Out.NamedScalarType (ScalarType -> Type IO) -> ScalarType -> Type IO
forall a b. (a -> b) -> a -> b
$
              Maybe GqlTypeName -> ScalarType
typeNameToScalarType
                ColumnEntry
colEntry.datatype_gql
          )
          Arguments
forall a. Monoid a => a
mempty

      resolvedValue :: ReaderT Context IO Value
resolvedValue = do
        Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask
        Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$ case Context
context.values of
          Object HashMap Text Value
obj ->
            case HashMap Text Value
obj HashMap Text Value
-> (HashMap Text Value -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ColumnEntry
colEntry.column_name_gql of
              Maybe Value
Nothing -> Text -> Value
String Text
"Error: Field does not exist"
              Just Value
val ->
                case ColumnEntry
colEntry.datatype of
                  -- Coerce value to nullable String
                  -- if no datatype is set.
                  -- This happens for columns in views.
                  Text
"" -> Value -> Value
gqlValueToNullableString Value
val
                  Text
_ -> Value
val
          Value
_ -> Text -> Value
String Text
"Error: Value could not be retrieved"
    in
      ( ColumnEntry
colEntry.column_name_gql
      , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
fieldToResolve ReaderT Context IO Value
resolvedValue
      )


buildSortClause :: [ColumnEntry] -> [(Name, Value)] -> Text
buildSortClause :: [ColumnEntry] -> [(Text, Value)] -> Text
buildSortClause [ColumnEntry]
columnEntries [(Text, Value)]
orderElems =
  if [(Text, Value)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [(Text, Value)]
orderElems
    then
      if Text
"rowid" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` ([ColumnEntry]
columnEntries [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.toLower (Text -> Text) -> (ColumnEntry -> Text) -> ColumnEntry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnEntry -> Text
AirGQL.Lib.column_name)
        then Text
"ORDER BY rowid ASC"
        else Text
""
    else
      Text
"ORDER BY "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( [(Text, Value)]
orderElems
              [(Text, Value)]
-> ((Text, Value) -> (Text, Text)) -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(Text
name, Value
value) ->
                      ( Text
name
                      , case Value
value of
                          Enum Text
"ASC" -> Text
"ASC"
                          Enum Text
"asc" -> Text
"ASC"
                          Enum Text
"DESC" -> Text
"DESC"
                          Enum Text
"desc" -> Text
"DESC"
                          Value
_ -> Text
""
                      )
                  )
              [(Text, Text)] -> ((Text, Text) -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Text
name, Text
order) -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
order)
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
", "
           )


data Pagination = Pagination
  { Pagination -> Int
limit :: Int
  , Pagination -> Maybe Int
offset :: Maybe Int
  }


buildPaginationClause :: Maybe Pagination -> Text
buildPaginationClause :: Maybe Pagination -> Text
buildPaginationClause = \case
  Maybe Pagination
Nothing -> Text
""
  Just Pagination
pagination ->
    [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
      [ Text
"LIMIT "
      , Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Pagination
pagination.limit Int
maxGraphqlResultCount)
      , case Pagination
pagination.offset of
          Maybe Int
Nothing -> Text
""
          Just Int
offset -> Text
"\nOFFSET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
offset
      ]


getColNamesQuoted :: [ColumnEntry] -> [Text]
getColNamesQuoted :: [ColumnEntry] -> [Text]
getColNamesQuoted [ColumnEntry]
columnEntries =
  [ColumnEntry]
columnEntries
    [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \ColumnEntry
col ->
            ( if Text
"BLOB" Text -> Text -> Bool
`T.isPrefixOf` ColumnEntry
col.datatype
                then
                  Text
"IIF("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword ColumnEntry
col.column_name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" IS NOT NULL, rowid, NULL)"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" AS "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword ColumnEntry
col.column_name
                else Text -> Text
quoteKeyword ColumnEntry
col.column_name
            )
        )


opAndValToSql :: HashMap.HashMap Text Value -> [Text]
opAndValToSql :: HashMap Text Value -> [Text]
opAndValToSql HashMap Text Value
operatorAndValue =
  case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
operatorAndValue of
    [(Text
"eq", Value
value)] ->
      Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$
        if Value
value Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Null
          then Text
" IS NULL"
          else Text
" == " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value
    [(Text
"neq", Value
value)] ->
      if Value
value Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Null
        then Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
" IS NOT NULL"
        else
          [ Text
" != " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value
          , Text
" IS NULL"
          ]
    [(Text
"in", List [Value]
values)] ->
      let listValues :: Text
listValues = [Value]
values [Value] -> (Value -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> Text
gqlValueToSQLText [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
","
      in  [Text
" IN (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
listValues Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]
    [(Text
"nin", List [Value]
values)] ->
      let listValues :: Text
listValues = [Value]
values [Value] -> (Value -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> Text
gqlValueToSQLText [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
","
      in  [Text
" NOT IN (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
listValues Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> if Value -> [Value] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
P.elem Value
Null [Value]
values
              then []
              else [Text
" IS NULL"]
    [(Text
"gt", Value
value)] -> [Text
" > " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text
"gte", Value
value)] -> [Text
" >= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text
"lt", Value
value)] -> [Text
" < " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text
"lte", Value
value)] -> [Text
" <= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text
"like", Value
value)] -> [Text
" like " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text
"ilike", Value
value)] -> [Text
" like " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
gqlValueToSQLText Value
value]
    [(Text, Value)]
filter -> do
      IOError -> [Text]
forall a e. Exception e => e -> a
throw (IOError -> [Text]) -> IOError -> [Text]
forall a b. (a -> b) -> a -> b
$
        String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
          String
"Error: Filter "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)] -> String
forall a b. (Show a, StringConv String b) => a -> b
show [(Text, Value)]
filter
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not yet supported"


getWhereClause :: [(Text, Value)] -> Text
getWhereClause :: [(Text, Value)] -> Text
getWhereClause [(Text, Value)]
filterElements =
  if [(Text, Value)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [(Text, Value)]
filterElements
    then Text
" "
    else
      Text
"WHERE "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( [(Text, Value)]
filterElements
              [(Text, Value)] -> ((Text, Value) -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(Text
colName, Value
x) -> case Value
x of
                      Object HashMap Text Value
operatorAndValue ->
                        let orClauses :: Text
orClauses =
                              HashMap Text Value -> [Text]
opAndValToSql HashMap Text Value
operatorAndValue
                                [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text
colName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
                                [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
" OR "
                        in  Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
orClauses Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                      Value
_ -> Text
""
                  )
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
" AND "
           )


setCaseInsensitive :: Connection -> [(Text, Value)] -> IO ()
setCaseInsensitive :: Connection -> [(Text, Value)] -> IO ()
setCaseInsensitive Connection
connection [(Text, Value)]
filterElements = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( [(Text, Value)]
filterElements
        [(Text, Value)] -> ([(Text, Value)] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& ((Text, Value) -> Bool) -> [(Text, Value)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any
          ( \(Text
_, Value
value) -> case Value
value of
              Object HashMap Text Value
operatorAndValue ->
                case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
operatorAndValue of
                  [(Text
"ilike", Value
_)] -> Bool
True
                  [(Text, Value)]
_ -> Bool
False
              Value
_ -> Bool
False
          )
    )
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> Query -> IO ()
execute_ Connection
connection Query
"PRAGMA case_sensitive_like = False"


executeSqlQuery
  :: Connection
  -> Text
  -> [ColumnEntry]
  -> [(Text, Value)]
  -> [(Text, Value)]
  -> Maybe Pagination
  -> IO [[SQLData]]
executeSqlQuery :: Connection
-> Text
-> [ColumnEntry]
-> [(Text, Value)]
-> [(Text, Value)]
-> Maybe Pagination
-> IO [[SQLData]]
executeSqlQuery
  Connection
connection
  Text
tableName
  [ColumnEntry]
colEntries
  [(Text, Value)]
filterElems
  [(Text, Value)]
orderElems
  Maybe Pagination
paginationMb = do
    let
      sqlQuery :: Query
      sqlQuery :: Query
sqlQuery =
        Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
          Text
"SELECT "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ([ColumnEntry] -> [Text]
getColNamesQuoted [ColumnEntry]
colEntries)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"FROM "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
tableName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)] -> Text
getWhereClause [(Text, Value)]
filterElems
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ColumnEntry] -> [(Text, Value)] -> Text
buildSortClause [ColumnEntry]
colEntries [(Text, Value)]
orderElems
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Pagination -> Text
buildPaginationClause Maybe Pagination
paginationMb

    Connection -> [(Text, Value)] -> IO ()
setCaseInsensitive Connection
connection [(Text, Value)]
filterElems

    IO [[SQLData]] -> IO [[SQLData]]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> IO [[SQLData]])
-> IO [[SQLData]] -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO [[SQLData]]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
connection Query
sqlQuery


colNamesWithFilterField :: Text -> [ColumnEntry] -> [(Text, InputField)]
colNamesWithFilterField :: Text -> [ColumnEntry] -> [(Text, InputField)]
colNamesWithFilterField Text
tableName [ColumnEntry]
columnEntries =
  [ColumnEntry]
columnEntries [ColumnEntry]
-> (ColumnEntry -> (Text, InputField)) -> [(Text, InputField)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
colEntry ->
    let
      inputField :: InputField
inputField =
        Maybe Text -> Type -> Maybe Value -> InputField
InputField
          (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Filter for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnEntry
colEntry.column_name_gql)
          ( InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
              Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_filter")
                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Filter object for the column")
                ( let theInputField :: InputField
theInputField =
                        Maybe Text -> Type -> Maybe Value -> InputField
InputField
                          (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Value to compare to")
                          ( ScalarType -> Type
In.NamedScalarType (ScalarType -> Type) -> ScalarType -> Type
forall a b. (a -> b) -> a -> b
$
                              Maybe GqlTypeName -> ScalarType
typeNameToScalarType
                                ColumnEntry
colEntry.datatype_gql
                          )
                          Maybe Value
forall a. Maybe a
Nothing -- Default value
                      listInputField :: InputField
listInputField =
                        Maybe Text -> Type -> Maybe Value -> InputField
InputField
                          (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Values to compare to")
                          ( Type -> Type
In.ListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                              ScalarType -> Type
In.NamedScalarType (ScalarType -> Type) -> ScalarType -> Type
forall a b. (a -> b) -> a -> b
$
                                Maybe GqlTypeName -> ScalarType
typeNameToScalarType
                                  ColumnEntry
colEntry.datatype_gql
                          )
                          Maybe Value
forall a. Maybe a
Nothing -- Default value
                  in  [(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                        [ (Text
"eq", InputField
theInputField)
                        , (Text
"neq", InputField
theInputField)
                        , (Text
"gt", InputField
theInputField)
                        , (Text
"gte", InputField
theInputField)
                        , (Text
"lt", InputField
theInputField)
                        , (Text
"lte", InputField
theInputField)
                        , (Text
"like", InputField
theInputField)
                        , (Text
"ilike", InputField
theInputField)
                        , (Text
"in", InputField
listInputField)
                        , (Text
"nin", InputField
listInputField)
                        ]
                )
          )
          Maybe Value
forall a. Maybe a
Nothing -- Default value
    in
      ( ColumnEntry
colEntry.column_name_gql
      , InputField
inputField
      )


queryType
  :: Connection
  -> AccessMode
  -> Text
  -> [TableEntryRaw]
  -> IO (Out.ObjectType IO)
queryType :: Connection
-> AccessMode -> Text -> [TableEntryRaw] -> IO (ObjectType IO)
queryType Connection
connection AccessMode
accessMode Text
dbId [TableEntryRaw]
tables = do
  let
    documentation :: Text
    documentation :: Text
documentation =
      Text
"Available queries for database \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dbId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

    getOutField :: Text -> IO (Out.Field IO)
    getOutField :: Text -> IO (Field IO)
getOutField Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> IO [ColumnEntry]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> IO [ColumnEntry])
-> IO [ColumnEntry] -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      let
        colNamesWithOrderingTerm :: [(Text, InputField)]
        colNamesWithOrderingTerm :: [(Text, InputField)]
colNamesWithOrderingTerm =
          [ColumnEntry]
columnEntries [ColumnEntry]
-> (ColumnEntry -> (Text, InputField)) -> [(Text, InputField)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
colEntry ->
            ( ColumnEntry
colEntry.column_name_gql
            , Maybe Text -> Type -> Maybe Value -> InputField
InputField
                (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Ordering term for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnEntry
colEntry.column_name_gql)
                ( EnumType -> Type
In.NamedEnumType (EnumType -> Type) -> EnumType -> Type
forall a b. (a -> b) -> a -> b
$
                    Text -> Maybe Text -> HashMap Text EnumValue -> EnumType
EnumType
                      Text
"OrderingTerm"
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Ordering object for the column")
                      ( [(Text, EnumValue)] -> HashMap Text EnumValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                          [ (Text
"ASC", Maybe Text -> EnumValue
EnumValue (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ASC"))
                          , (Text
"asc", Maybe Text -> EnumValue
EnumValue (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ASC"))
                          , (Text
"DESC", Maybe Text -> EnumValue
EnumValue (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DESC"))
                          , (Text
"desc", Maybe Text -> EnumValue
EnumValue (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DESC"))
                          ]
                      )
                )
                Maybe Value
forall a. Maybe a
Nothing -- Default value
            )

        typeNameField :: Text -> [(Text, Resolver IO)]
        typeNameField :: Text -> [(Text, Resolver IO)]
typeNameField Text
nameOfTable =
          let
            typeNameOutField :: Field IO
typeNameOutField =
              OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
                OutField
                  { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"The type name of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfTable
                  , $sel:fieldType:OutField :: Type IO
fieldType = ScalarType -> Type IO
forall (m :: * -> *). ScalarType -> Type m
Out.NonNullScalarType ScalarType
string
                  , $sel:arguments:OutField :: Arguments
arguments = Arguments
forall k v. HashMap k v
HashMap.empty
                  }
          in
            [
              ( Text
"__typename"
              , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
typeNameOutField (ReaderT Context IO Value -> Resolver IO)
-> ReaderT Context IO Value -> Resolver IO
forall a b. (a -> b) -> a -> b
$
                  Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
                    Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
                      Text -> Text
doubleXEncodeGql Text
nameOfTable Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_row"
              )
            ]

      Field IO -> IO (Field IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field IO -> IO (Field IO)) -> Field IO -> IO (Field IO)
forall a b. (a -> b) -> a -> b
$
        OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
          OutField
            { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Provides entries from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            , $sel:fieldType:OutField :: Type IO
fieldType =
                Type IO -> Type IO
forall (m :: * -> *). Type m -> Type m
Out.ListType (Type IO -> Type IO) -> Type IO -> Type IO
forall a b. (a -> b) -> a -> b
$
                  ObjectType IO -> Type IO
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType IO -> Type IO) -> ObjectType IO -> Type IO
forall a b. (a -> b) -> a -> b
$
                    Text
-> Maybe Text
-> [InterfaceType IO]
-> HashMap Text (Resolver IO)
-> ObjectType IO
forall (m :: * -> *).
Text
-> Maybe Text
-> [InterfaceType m]
-> HashMap Text (Resolver m)
-> ObjectType m
Out.ObjectType
                      Text
tableName
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"short desc")
                      []
                      ( [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Resolver IO)] -> HashMap Text (Resolver IO))
-> [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall a b. (a -> b) -> a -> b
$
                          [ColumnEntry] -> [(Text, Resolver IO)]
colNamesWithValResolver [ColumnEntry]
columnEntries
                            [(Text, Resolver IO)]
-> [(Text, Resolver IO)] -> [(Text, Resolver IO)]
forall a. Semigroup a => a -> a -> a
<> Text -> [(Text, Resolver IO)]
typeNameField Text
tableName
                      )
            , $sel:arguments:OutField :: Arguments
arguments =
                [(Text, Argument)] -> Arguments
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                  [
                    ( Text
"filter"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Filter objects"
                          , $sel:argType:InArgument :: Type
argType =
                              InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                                  (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_filter")
                                  ( Text -> Maybe Text
forall a. a -> Maybe a
Just
                                      Text
"Filter objects for the specified columns"
                                  )
                                  ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Text -> [ColumnEntry] -> [(Text, InputField)]
colNamesWithFilterField Text
tableName [ColumnEntry]
columnEntries))
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ,
                    ( Text
"order_by"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Order by the specified columns"
                          , $sel:argType:InArgument :: Type
argType =
                              Type -> Type
In.ListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                                InputObjectType -> Type
In.NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                  Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                                    (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_order_by")
                                    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Options for ordering by columns")
                                    ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, InputField)]
colNamesWithOrderingTerm)
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ,
                    ( Text
"limit"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb =
                              Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Limit the number of returned rows."
                          , $sel:argType:InArgument :: Type
argType = ScalarType -> Type
In.NamedScalarType ScalarType
int
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ,
                    ( Text
"offset"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb =
                              Text -> Maybe Text
forall a. a -> Maybe a
Just
                                Text
"Change the index rows \
                                \start being returned from"
                          , $sel:argType:InArgument :: Type
argType = ScalarType -> Type
In.NamedScalarType ScalarType
int
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ]
            }
    -- -- TODO: Use for retrieving record by primary key
    -- , arguments = HashMap.fromList $ columnEntries
    --     <&> (\colEntry ->
    --           ( colEntry.column_name_gql :: Text
    --           , inArgumentToArgument $ InArgument
    --               { argDescMb = Just "Retrieve object by primary key"
    --               , argType = In.NamedScalarType $
    --                   typeNameToScalarType $ colEntry.datatype
    --               , valueMb = Nothing
    --               }
    --           )
    --         )

    getDbEntries :: Text -> Out.Resolve IO
    getDbEntries :: Text -> ReaderT Context IO Value
getDbEntries Text
tableName = do
      Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask
      [ColumnEntry]
colEntries <- IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry])
-> IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      [[SQLData]]
rows :: [[SQLData]] <- case Context
context.arguments of
        Arguments HashMap Text Value
args -> do
          [(Text, Value)]
filterElements <- case HashMap Text Value
args HashMap Text Value
-> (HashMap Text Value -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"filter" of
            Maybe Value
Nothing -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Just Value
colToFilter -> case Value
colToFilter of
              Object HashMap Text Value
filterObj -> case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
filterObj of
                [] -> IOError -> ReaderT Context IO [(Text, Value)]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO [(Text, Value)])
-> IOError -> ReaderT Context IO [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Error: Filter must not be empty"
                [(Text, Value)]
filterElements -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text, Value)]
filterElements
              Value
_ -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

          [(Text, Value)]
orderElements :: [(Name, Value)] <-
            case HashMap Text Value
args HashMap Text Value
-> (HashMap Text Value -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"order_by" of
              Maybe Value
Nothing -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
              Just Value
colToOrder -> case Value
colToOrder of
                List [Value]
objects ->
                  -- => [Value]
                  [Value]
objects
                    -- => IO [[(Name, Value)]]
                    [Value]
-> ([Value] -> ReaderT Context IO [[(Text, Value)]])
-> ReaderT Context IO [[(Text, Value)]]
forall a b. a -> (a -> b) -> b
& (Value -> ReaderT Context IO [(Text, Value)])
-> [Value] -> ReaderT Context IO [[(Text, Value)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
P.traverse
                      ( \case
                          Object HashMap Text Value
orderObject -> case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
orderObject of
                            [] -> IOError -> ReaderT Context IO [(Text, Value)]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO [(Text, Value)])
-> IOError -> ReaderT Context IO [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Error: Order must not be empty"
                            [(Text, Value)]
orderElements -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text, Value)]
orderElements
                          Value
_ -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] -- Should not be reachable
                      )
                    -- => IO [(Name, Value)]
                    ReaderT Context IO [[(Text, Value)]]
-> ([[(Text, Value)]] -> [(Text, Value)])
-> ReaderT Context IO [(Text, Value)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [[(Text, Value)]] -> [(Text, Value)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
P.join
                Value
_ -> [(Text, Value)] -> ReaderT Context IO [(Text, Value)]
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

          Maybe Int32
limitElements :: Maybe P.Int32 <-
            case HashMap Text Value
args HashMap Text Value
-> (HashMap Text Value -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"limit" of
              Just (Int Int32
limit)
                | Int32
limit Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 ->
                    Maybe Int32 -> ReaderT Context IO (Maybe Int32)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
limit)
                | Bool
otherwise ->
                    IOError -> ReaderT Context IO (Maybe Int32)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO (Maybe Int32))
-> IOError -> ReaderT Context IO (Maybe Int32)
forall a b. (a -> b) -> a -> b
$
                      String -> IOError
userError
                        String
"Error: limit must be positive"
              Maybe Value
_ -> Maybe Int32 -> ReaderT Context IO (Maybe Int32)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int32
forall a. Maybe a
Nothing

          Maybe Pagination
paginationMb :: Maybe Pagination <-
            case (Maybe Int32
limitElements, HashMap Text Value
args HashMap Text Value
-> (HashMap Text Value -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"offset") of
              (Just Int32
limit, Just (Int Int32
offset))
                | Int32
offset Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 ->
                    Maybe Pagination -> ReaderT Context IO (Maybe Pagination)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pagination -> ReaderT Context IO (Maybe Pagination))
-> Maybe Pagination -> ReaderT Context IO (Maybe Pagination)
forall a b. (a -> b) -> a -> b
$
                      Pagination -> Maybe Pagination
forall a. a -> Maybe a
Just (Pagination -> Maybe Pagination) -> Pagination -> Maybe Pagination
forall a b. (a -> b) -> a -> b
$
                        Int -> Maybe Int -> Pagination
Pagination
                          (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
limit)
                          (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
offset)
                | Bool
otherwise ->
                    IOError -> ReaderT Context IO (Maybe Pagination)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO (Maybe Pagination))
-> IOError -> ReaderT Context IO (Maybe Pagination)
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Error: offset must be positive"
              (Just Int32
limit, Maybe Value
_) ->
                Maybe Pagination -> ReaderT Context IO (Maybe Pagination)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pagination -> ReaderT Context IO (Maybe Pagination))
-> Maybe Pagination -> ReaderT Context IO (Maybe Pagination)
forall a b. (a -> b) -> a -> b
$
                  Pagination -> Maybe Pagination
forall a. a -> Maybe a
Just (Pagination -> Maybe Pagination) -> Pagination -> Maybe Pagination
forall a b. (a -> b) -> a -> b
$
                    Int -> Maybe Int -> Pagination
Pagination
                      (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
limit)
                      Maybe Int
forall a. Maybe a
Nothing
              (Maybe Int32
Nothing, Just (Int Int32
_)) ->
                IOError -> ReaderT Context IO (Maybe Pagination)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO (Maybe Pagination))
-> IOError -> ReaderT Context IO (Maybe Pagination)
forall a b. (a -> b) -> a -> b
$
                  String -> IOError
userError
                    String
"Error: cannot specify offset \
                    \without also specifying a limit"
              (Maybe Int32, Maybe Value)
_ -> Maybe Pagination -> ReaderT Context IO (Maybe Pagination)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pagination
forall a. Maybe a
Nothing

          let
            countQuery :: Query
            countQuery :: Query
countQuery =
              Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
                [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
                  [ Text
"SELECT COUNT() FROM"
                  , Text -> Text
quoteKeyword Text
tableName
                  , Text
"\n"
                  , [(Text, Value)] -> Text
getWhereClause [(Text, Value)]
filterElements
                  ]

          -- Will be equal `Just numRows` when the number of
          -- returned rows is too large.
          Maybe Int
tooManyReturnedRows :: Maybe Int <- case Maybe Pagination
paginationMb of
            -- Limit doesn't seem to affect COUNT(),
            -- so we consider it manually.
            Just Pagination
pagination
              | Pagination
pagination.limit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxGraphqlResultCount ->
                  Maybe Int -> ReaderT Context IO (Maybe Int)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
            Maybe Pagination
_ -> do
              [Only Int]
results <- IO [Only Int] -> ReaderT Context IO [Only Int]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Only Int] -> ReaderT Context IO [Only Int])
-> IO [Only Int] -> ReaderT Context IO [Only Int]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO [Only Int]
forall r. FromRow r => Connection -> Query -> IO [r]
SS.query_ Connection
connection Query
countQuery

              let numRows :: Int
numRows = case [Only Int] -> Maybe (Only Int)
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [Only Int]
results of
                    Just Only Int
numRowsOnly -> Only Int -> Int
forall a. Only a -> a
SS.fromOnly Only Int
numRowsOnly
                    Maybe (Only Int)
Nothing -> Int
0

              Maybe Int -> ReaderT Context IO (Maybe Int)
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> ReaderT Context IO (Maybe Int))
-> Maybe Int -> ReaderT Context IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$
                if Int
numRows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxGraphqlResultCount
                  then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
numRows
                  else Maybe Int
forall a. Maybe a
Nothing

          Maybe Int
-> (Int -> ReaderT Context IO Any) -> ReaderT Context IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
P.for_ Maybe Int
tooManyReturnedRows ((Int -> ReaderT Context IO Any) -> ReaderT Context IO ())
-> (Int -> ReaderT Context IO Any) -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ \Int
numRows -> do
            IOError -> ReaderT Context IO Any
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO Any)
-> IOError -> ReaderT Context IO Any
forall a b. (a -> b) -> a -> b
$
              String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
                  [ String
"The graphql API cannot return more than "
                  , Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show Int
maxGraphqlResultCount
                  , String
" entries at a time. Your query would have returned "
                  , Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show Int
numRows
                  , String
" rows. "
                  , String
"Consider setting the `limit` argument on your query: `{ "
                  , Text -> String
T.unpack Text
tableName
                  , String
" (limit: 50) { ... } }`"
                  ]

          IO [[SQLData]] -> ReaderT Context IO [[SQLData]]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> ReaderT Context IO [[SQLData]])
-> IO [[SQLData]] -> ReaderT Context IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$
            Connection
-> Text
-> [ColumnEntry]
-> [(Text, Value)]
-> [(Text, Value)]
-> Maybe Pagination
-> IO [[SQLData]]
executeSqlQuery
              Connection
connection
              Text
tableName
              [ColumnEntry]
colEntries
              [(Text, Value)]
filterElements
              [(Text, Value)]
orderElements
              Maybe Pagination
paginationMb

      Text
-> Text -> [ColumnEntry] -> [[SQLData]] -> ReaderT Context IO Value
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList Text
dbId Text
tableName [ColumnEntry]
colEntries [[SQLData]]
rows

    getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
    getResolvers :: IO (HashMap Text (Resolver IO))
getResolvers = do
      let
        getTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
        getTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
getTableTuple TableEntryRaw
table = do
          Field IO
outField <- Text -> IO (Field IO)
getOutField TableEntryRaw
table.name
          (Text, Resolver IO) -> IO (Text, Resolver IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Text -> Text
doubleXEncodeGql TableEntryRaw
table.name
            , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver
                Field IO
outField
                ( -- Exceptions must be converted to ResolverExceptions
                  -- to be picked up by GQL query executor
                  ReaderT Context IO Value
-> (SomeException -> ReaderT Context IO Value)
-> ReaderT Context IO Value
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
                    (Text -> ReaderT Context IO Value
getDbEntries TableEntryRaw
table.name)
                    (ResolverException -> ReaderT Context IO Value
forall a e. Exception e => e -> a
throw (ResolverException -> ReaderT Context IO Value)
-> (SomeException -> ResolverException)
-> SomeException
-> ReaderT Context IO Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ResolverException
forall e. Exception e => e -> ResolverException
ResolverException)
                )
            )

        getTableTuples :: IO [(Text, Resolver IO)]
        getTableTuples :: IO [(Text, Resolver IO)]
getTableTuples =
          [TableEntryRaw]
-> (TableEntryRaw -> IO (Text, Resolver IO))
-> IO [(Text, Resolver IO)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for [TableEntryRaw]
tables TableEntryRaw -> IO (Text, Resolver IO)
getTableTuple

      IO [(Text, Resolver IO)]
getTableTuples IO [(Text, Resolver IO)]
-> ([(Text, Resolver IO)] -> HashMap Text (Resolver IO))
-> IO (HashMap Text (Resolver IO))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

  -- -- TODO: Add support for retriving record by ID
  -- getResolversPrimaryKey :: IO (HashMap.HashMap Text (Resolver IO))
  -- getResolversPrimaryKey = do
  --   let
  --     getTableTuple table = do
  --       outField <- getOutField $ table.name
  --       pure
  --         ( table.name) <> "_by_pk"
  --         , ValueResolver
  --             outField
  --             (getDbEntries $ table.name)
  --         )

  --     getTableTuples :: IO [(Text, Resolver IO)]
  --     getTableTuples =
  --       sequence $ tables <&> getTableTuple

  --   getTableTuples <&> HashMap.fromList

  HashMap Text (Resolver IO)
resolvers <- IO (HashMap Text (Resolver IO))
getResolvers
  HashMap Text (Resolver IO)
schemaResolver <- Text
-> Connection
-> AccessMode
-> [TableEntryRaw]
-> IO (HashMap Text (Resolver IO))
getSchemaResolver Text
dbId Connection
connection AccessMode
accessMode [TableEntryRaw]
tables

  -- resolversPrimaryKey <- getResolversPrimaryKey
  let
    -- Resolve = ReaderT Context m Value
    wrapResolve :: ReaderT Context IO Value -> ReaderT Context IO Value
wrapResolve ReaderT Context IO Value
resolve = do
      Bool -> ReaderT Context IO () -> ReaderT Context IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AccessMode
accessMode AccessMode -> AccessMode -> Bool
forall a. Eq a => a -> a -> Bool
== AccessMode
WriteOnly) (ReaderT Context IO () -> ReaderT Context IO ())
-> ReaderT Context IO () -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ do
        ResolverException -> ReaderT Context IO ()
forall a e. Exception e => e -> a
throw (ResolverException -> ReaderT Context IO ())
-> ResolverException -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$
          IOError -> ResolverException
forall e. Exception e => e -> ResolverException
ResolverException (IOError -> ResolverException) -> IOError -> ResolverException
forall a b. (a -> b) -> a -> b
$
            String -> IOError
userError String
"Cannot read field using writeonly access code"
      ReaderT Context IO Value
resolve

    protectResolver :: Resolver IO -> Resolver IO
protectResolver = \case
      ValueResolver Field IO
field ReaderT Context IO Value
resolve ->
        Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
field (ReaderT Context IO Value -> ReaderT Context IO Value
wrapResolve ReaderT Context IO Value
resolve)
      EventStreamResolver Field IO
field ReaderT Context IO Value
resolve Subscribe IO
subscribe ->
        Field IO -> ReaderT Context IO Value -> Subscribe IO -> Resolver IO
forall (m :: * -> *).
Field m -> Resolve m -> Subscribe m -> Resolver m
EventStreamResolver Field IO
field (ReaderT Context IO Value -> ReaderT Context IO Value
wrapResolve ReaderT Context IO Value
resolve) Subscribe IO
subscribe

  ObjectType IO -> IO (ObjectType IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectType IO -> IO (ObjectType IO))
-> ObjectType IO -> IO (ObjectType IO)
forall a b. (a -> b) -> a -> b
$
    OutObjectType IO -> ObjectType IO
forall (m :: * -> *). OutObjectType m -> ObjectType m
outObjectTypeToObjectType (OutObjectType IO -> ObjectType IO)
-> OutObjectType IO -> ObjectType IO
forall a b. (a -> b) -> a -> b
$
      OutObjectType
        { $sel:name:OutObjectType :: Text
name = Text
"Query"
        , $sel:descriptionMb:OutObjectType :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
documentation
        , $sel:interfaceTypes:OutObjectType :: [InterfaceType IO]
interfaceTypes = []
        , $sel:fields:OutObjectType :: HashMap Text (Resolver IO)
fields =
            [HashMap Text (Resolver IO)] -> HashMap Text (Resolver IO)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
              [ HashMap Text (Resolver IO)
schemaResolver
              , HashMap Text (Resolver IO)
typeNameResolver
              , HashMap Text (Resolver IO)
resolvers
              -- , resolversPrimaryKey)
              ]
              HashMap Text (Resolver IO)
-> (Resolver IO -> Resolver IO) -> HashMap Text (Resolver IO)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Resolver IO -> Resolver IO
protectResolver
        }


-- | WARNING: Also change duplicate `sqlDataToAesonValue`
sqlDataToGQLValue :: Text -> SQLData -> Either Text Value
sqlDataToGQLValue :: Text -> SQLData -> Either Text Value
sqlDataToGQLValue Text
datatype SQLData
sqlData = case (Text
datatype, SQLData
sqlData) of
  (Text
_, SQLInteger Int64
int64) ->
    if Text -> Text -> Bool
isInfixOf Text
"BOOL" (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
toUpper Text
datatype
      then Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ case Int64
int64 of
        Int64
0 -> Bool -> Value
Boolean Bool
False
        Int64
_ -> Bool -> Value
Boolean Bool
True
      else
        if Int64
int64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
P.minBound :: P.Int32)
          Bool -> Bool -> Bool
&& Int64
int64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
P.maxBound :: P.Int32)
          then Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Int (Int32 -> Value) -> Int32 -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
int64 -- Int32
          else
            Text -> Either Text Value
forall a b. a -> Either a b
Left (Text -> Either Text Value) -> Text -> Either Text Value
forall a b. (a -> b) -> a -> b
$
              Text
"Integer "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int64
int64
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" would overflow. "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"This happens because SQLite uses 64-bit ints, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"but GraphQL uses 32-bit ints. "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Use a Number (64-bit float) or Text column instead."
  (Text
_, SQLFloat Double
double) -> Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Float Double
double
  (Text
_, SQLText Text
text) -> Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
text
  (Text
_, SQLBlob ByteString
byteString) -> Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. (Show a, StringConv String b) => a -> b
show ByteString
byteString
  (Text
_, SQLData
SQLNull) -> Value -> Either Text Value
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null


{-| Convert a GraphQL `Value` to a `SQLData`
TODO: ? -> SQLBlob $ string
-}
gqlValueToSQLData :: Value -> SQLData
gqlValueToSQLData :: Value -> SQLData
gqlValueToSQLData = \case
  Int Int32
int32 -> Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> Int64 -> SQLData
forall a b. (a -> b) -> a -> b
$ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
int32 -- Int64
  Float Double
double -> Double -> SQLData
SQLFloat Double
double
  String Text
text -> Text -> SQLData
SQLText Text
text
  Value
Null -> SQLData
SQLNull
  Boolean Bool
aBool ->
    if Bool
aBool
      then Int64 -> SQLData
SQLInteger Int64
1
      else Int64 -> SQLData
SQLInteger Int64
0
  Enum Text
name -> Text -> SQLData
SQLText Text
name
  List [Value]
aList -> Text -> SQLData
SQLText (Text -> SQLData) -> Text -> SQLData
forall a b. (a -> b) -> a -> b
$ [Value] -> Text
forall a b. (Show a, StringConv String b) => a -> b
show [Value]
aList
  Object HashMap Text Value
obj -> Text -> SQLData
SQLText (Text -> SQLData) -> Text -> SQLData
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Text
forall a b. (Show a, StringConv String b) => a -> b
show HashMap Text Value
obj


mutationTypeNameField :: Text -> (Text, Resolver IO)
mutationTypeNameField :: Text -> (Text, Resolver IO)
mutationTypeNameField Text
nameOfTable =
  let
    typeNameOutField :: Field IO
typeNameOutField =
      OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
        OutField
          { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"The type name of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfTable
          , $sel:fieldType:OutField :: Type IO
fieldType = ScalarType -> Type IO
forall (m :: * -> *). ScalarType -> Type m
Out.NonNullScalarType ScalarType
string
          , $sel:arguments:OutField :: Arguments
arguments = Arguments
forall k v. HashMap k v
HashMap.empty
          }
  in
    ( Text
"__typename"
    , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
typeNameOutField (ReaderT Context IO Value -> Resolver IO)
-> ReaderT Context IO Value -> Resolver IO
forall a b. (a -> b) -> a -> b
$
        Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
          Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
            Text -> Text
doubleXEncodeGql Text
nameOfTable Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_mutation_response"
    )


getMutationResponse
  :: AccessMode
  -> Text
  -> [ColumnEntry]
  -> Out.Type IO
getMutationResponse :: AccessMode -> Text -> [ColumnEntry] -> Type IO
getMutationResponse AccessMode
accessMode Text
tableName [ColumnEntry]
columnEntries =
  ObjectType IO -> Type IO
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType IO -> Type IO) -> ObjectType IO -> Type IO
forall a b. (a -> b) -> a -> b
$
    OutObjectType IO -> ObjectType IO
forall (m :: * -> *). OutObjectType m -> ObjectType m
outObjectTypeToObjectType (OutObjectType IO -> ObjectType IO)
-> OutObjectType IO -> ObjectType IO
forall a b. (a -> b) -> a -> b
$
      OutObjectType
        { $sel:name:OutObjectType :: Text
name = Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_mutation_response"
        , $sel:descriptionMb:OutObjectType :: Maybe Text
descriptionMb =
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
              Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" mutation response description"
        , $sel:interfaceTypes:OutObjectType :: [InterfaceType IO]
interfaceTypes = []
        , $sel:fields:OutObjectType :: HashMap Text (Resolver IO)
fields =
            [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Resolver IO)] -> HashMap Text (Resolver IO))
-> [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall a b. (a -> b) -> a -> b
$
              [
                ( Text
"affected_rows"
                , let
                    field :: Out.Field m
                    field :: forall (m :: * -> *). Field m
field =
                      OutField m -> Field m
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField m -> Field m) -> OutField m -> Field m
forall a b. (a -> b) -> a -> b
$
                        OutField
                          { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"nonNullInt description"
                          , $sel:fieldType:OutField :: Type m
fieldType = ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
Out.NonNullScalarType ScalarType
int
                          , $sel:arguments:OutField :: Arguments
arguments = Arguments
forall k v. HashMap k v
HashMap.empty
                          }

                    value :: ReaderT Out.Context IO Value
                    value :: ReaderT Context IO Value
value = do
                      Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask
                      case Context
context Context -> (Context -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Context -> Value
Out.values of
                        Object HashMap Text Value
obj ->
                          Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
                            Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> Value
Int Int32
0) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$
                              Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"affected_rows" HashMap Text Value
obj
                        Value
_ -> Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Int Int32
0
                  in
                    Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
forall (m :: * -> *). Field m
field ReaderT Context IO Value
value
                )
              , Text -> (Text, Resolver IO)
mutationTypeNameField Text
tableName
              ]
                [(Text, Resolver IO)]
-> [(Text, Resolver IO)] -> [(Text, Resolver IO)]
forall a. Semigroup a => a -> a -> a
<> case AccessMode
accessMode of
                  AccessMode
WriteOnly -> []
                  AccessMode
_ ->
                    [
                      ( Text
"returning"
                      , let
                          field :: Out.Field IO
                          field :: Field IO
field =
                            OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
                              OutField
                                { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb =
                                    Text -> Maybe Text
forall a. a -> Maybe a
Just
                                      Text
"Non null seturning description"
                                , $sel:fieldType:OutField :: Type IO
fieldType =
                                    Type IO -> Type IO
forall (m :: * -> *). Type m -> Type m
Out.NonNullListType (Type IO -> Type IO) -> Type IO -> Type IO
forall a b. (a -> b) -> a -> b
$
                                      ObjectType IO -> Type IO
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType IO -> Type IO) -> ObjectType IO -> Type IO
forall a b. (a -> b) -> a -> b
$
                                        Text
-> Maybe Text
-> [InterfaceType IO]
-> HashMap Text (Resolver IO)
-> ObjectType IO
forall (m :: * -> *).
Text
-> Maybe Text
-> [InterfaceType m]
-> HashMap Text (Resolver m)
-> ObjectType m
Out.ObjectType
                                          Text
"returning"
                                          (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"short desc")
                                          []
                                          ( [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Resolver IO)] -> HashMap Text (Resolver IO))
-> [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall a b. (a -> b) -> a -> b
$
                                              [ColumnEntry] -> [(Text, Resolver IO)]
colNamesWithValResolver [ColumnEntry]
columnEntries
                                          )
                                , $sel:arguments:OutField :: Arguments
arguments = Arguments
forall k v. HashMap k v
HashMap.empty
                                }

                          value :: ReaderT Out.Context IO Value
                          value :: ReaderT Context IO Value
value = do
                            Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask
                            case Context
context Context -> (Context -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Context -> Value
Out.values of
                              Object HashMap Text Value
obj ->
                                Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
                                  Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (HashMap Text Value -> Value
Object HashMap Text Value
forall a. Monoid a => a
P.mempty) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$
                                    Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"returning" HashMap Text Value
obj
                              Value
_ -> Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
Object HashMap Text Value
forall a. Monoid a => a
P.mempty
                        in
                          Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver Field IO
field ReaderT Context IO Value
value
                      )
                    ]
        }


rowsToList :: (MonadIO m) => Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList :: forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList Text
dbId Text
tableName [ColumnEntry]
columnEntries [[SQLData]]
updatedRows =
  let
    buildMetadataJson :: Text -> Text -> Text
    buildMetadataJson :: Text -> Text -> Text
buildMetadataJson Text
colName Text
rowid =
      [Pair] -> Value
object [Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Text -> Text -> Text -> Text
colToFileUrl Text
dbId Text
tableName Text
colName Text
rowid]
        Value -> (Value -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Value -> Text
forall a. ToJSON a => a -> Text
encodeToText

    parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
    parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
parseSqlData (ColumnEntry
colEntry, SQLData
colVal) =
      if Text
"BLOB" Text -> Text -> Bool
`T.isPrefixOf` ColumnEntry
colEntry.datatype
        then
          (Text, Value) -> Either (Text, Text) (Text, Value)
forall a. a -> Either (Text, Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( ColumnEntry
colEntry.column_name_gql
            , case SQLData
colVal of
                SQLData
SQLNull -> Value
Null
                SQLInteger Int64
id ->
                  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Text
buildMetadataJson ColumnEntry
colEntry.column_name (Int64 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int64
id)
                SQLText Text
id ->
                  Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Text
buildMetadataJson ColumnEntry
colEntry.column_name Text
id
                SQLData
_ -> Value
Null
            )
        else case Text -> SQLData -> Either Text Value
sqlDataToGQLValue ColumnEntry
colEntry.datatype SQLData
colVal of
          Left Text
err ->
            (Text, Text) -> Either (Text, Text) (Text, Value)
forall a b. a -> Either a b
Left
              (ColumnEntry
colEntry.column_name_gql, Text
err)
          Right Value
gqlData ->
            (Text, Value) -> Either (Text, Text) (Text, Value)
forall a b. b -> Either a b
Right
              (ColumnEntry
colEntry.column_name_gql, Value
gqlData)
  in
    [[SQLData]]
updatedRows
      [[SQLData]]
-> ([SQLData] -> Either [(Text, Text)] Value)
-> [Either [(Text, Text)] Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \[SQLData]
row ->
              -- => [(ColumnEntry, SQLData)]
              [ColumnEntry] -> [SQLData] -> [(ColumnEntry, SQLData)]
forall a b. [a] -> [b] -> [(a, b)]
P.zip [ColumnEntry]
columnEntries [SQLData]
row
                -- => [Either (Text, Text) (Text, Value)]
                [(ColumnEntry, SQLData)]
-> ((ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value))
-> [Either (Text, Text) (Text, Value)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
parseSqlData
                -- => Either [(Text, Text)] (Text, Value)
                [Either (Text, Text) (Text, Value)]
-> ([Either (Text, Text) (Text, Value)]
    -> Either [(Text, Text)] [(Text, Value)])
-> Either [(Text, Text)] [(Text, Value)]
forall a b. a -> (a -> b) -> b
& [Either (Text, Text) (Text, Value)]
-> Either [(Text, Text)] [(Text, Value)]
forall e b. [Either e b] -> Either [e] [b]
collectErrorList
                -- => Either [(Text, Text)] (HashMap Text Value)
                Either [(Text, Text)] [(Text, Value)]
-> ([(Text, Value)] -> HashMap Text Value)
-> Either [(Text, Text)] (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                -- => Either [(Text, Text)] Value
                Either [(Text, Text)] (HashMap Text Value)
-> (HashMap Text Value -> Value) -> Either [(Text, Text)] Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap Text Value -> Value
Object
          )
      -- => Either [[(Text, Text)]] [Value]
      [Either [(Text, Text)] Value]
-> ([Either [(Text, Text)] Value]
    -> Either [[(Text, Text)]] [Value])
-> Either [[(Text, Text)]] [Value]
forall a b. a -> (a -> b) -> b
& [Either [(Text, Text)] Value] -> Either [[(Text, Text)]] [Value]
forall e b. [Either e b] -> Either [e] [b]
collectErrorList
      Either [[(Text, Text)]] [Value]
-> (Either [[(Text, Text)]] [Value] -> m Value) -> m Value
forall a b. a -> (a -> b) -> b
& \case
        Right [Value]
values -> Value -> m Value
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
List [Value]
values
        Left [[(Text, Text)]]
errors ->
          let
            errorLines :: [Text]
errorLines =
              [[(Text, Text)]] -> [(Text, Text)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
P.join [[(Text, Text)]]
errors
                [(Text, Text)] -> ((Text, Text) -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
column, Text
err) -> Text
"On column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Text
column Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
          in
            IOError -> m Value
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> m Value) -> IOError -> m Value
forall a b. (a -> b) -> a -> b
$
              String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
                  Text
"Multiple errors occurred:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
P.unlines [Text]
errorLines


executeSqlMutation
  :: Connection
  -> Text
  -> HashMap.HashMap Text Value
  -> [ColumnEntry]
  -> [(Text, Value)]
  -> IO (Int, [[SQLData]])
executeSqlMutation :: Connection
-> Text
-> HashMap Text Value
-> [ColumnEntry]
-> [(Text, Value)]
-> IO (Int, [[SQLData]])
executeSqlMutation Connection
connection Text
tableName HashMap Text Value
args [ColumnEntry]
columnEntries [(Text, Value)]
filterElements = do
  let
    colNamesToUpdateRaw :: [Text]
    colNamesToUpdateRaw :: [Text]
colNamesToUpdateRaw =
      case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"set" HashMap Text Value
args of
        Just (Object HashMap Text Value
dataObj) -> HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Value
dataObj
        Maybe Value
_ -> []

    colNamesToUpdate :: [Text]
    colNamesToUpdate :: [Text]
colNamesToUpdate =
      [ColumnEntry]
columnEntries
        [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnEntry -> Text
column_name
        [Text] -> (Text -> Maybe Text) -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \Text
columnName ->
                if Text -> Text
doubleXEncodeGql Text
columnName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` [Text]
colNamesToUpdateRaw
                  then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
columnName
                  else Maybe Text
forall a. Maybe a
Nothing
            )
        [Maybe Text] -> ([Maybe Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
P.catMaybes

    columnNamesText :: Text
    columnNamesText :: Text
columnNamesText =
      [ColumnEntry]
columnEntries
        [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnEntry -> Text
column_name
        [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
quoteKeyword
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
", "

    setText :: Text
    setText :: Text
setText =
      [Text]
colNamesToUpdate
        [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Text
columnName -> Text -> Text
quoteKeyword Text
columnName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?")
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
", "

    valuesToSet :: [SQLData]
    valuesToSet :: [SQLData]
valuesToSet =
      case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"set" HashMap Text Value
args of
        Just (Object HashMap Text Value
dataObj) ->
          [ColumnEntry]
columnEntries
            [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnEntry -> Text
column_name
            [Text] -> (Text -> Maybe Value) -> [Maybe Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \Text
columnName ->
                    Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup
                      (Text -> Text
doubleXEncodeGql Text
columnName)
                      HashMap Text Value
dataObj
                )
            [Maybe Value] -> ([Maybe Value] -> [Value]) -> [Value]
forall a b. a -> (a -> b) -> b
& [Maybe Value] -> [Value]
forall a. [Maybe a] -> [a]
P.catMaybes
            [Value] -> (Value -> SQLData) -> [SQLData]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> SQLData
gqlValueToSQLData
        Maybe Value
_ -> []

  [[SQLData]]
updatedRows :: [[SQLData]] <-
    if Text
setText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
      then [[SQLData]] -> IO [[SQLData]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      else
        let
          sqlQuery :: Query
sqlQuery =
            Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
              Text
"UPDATE "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
tableName
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"SET "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
setText
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)] -> Text
getWhereClause [(Text, Value)]
filterElements
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"RETURNING "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNamesText

          colTypesToUpdate :: [Text]
          colTypesToUpdate :: [Text]
colTypesToUpdate =
            [ColumnEntry]
columnEntries
              [ColumnEntry] -> (ColumnEntry -> Maybe Text) -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \ColumnEntry
colEntry ->
                      if Text -> Text
doubleXEncodeGql ColumnEntry
colEntry.column_name
                        Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` [Text]
colNamesToUpdateRaw
                        then Text -> Maybe Text
forall a. a -> Maybe a
Just ColumnEntry
colEntry.datatype
                        else Maybe Text
forall a. Maybe a
Nothing
                  )
              [Maybe Text] -> ([Maybe Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
P.catMaybes

          valuesToSetNorm :: [SQLData]
valuesToSetNorm =
            [SQLData] -> [Text] -> [(SQLData, Text)]
forall a b. [a] -> [b] -> [(a, b)]
P.zip [SQLData]
valuesToSet [Text]
colTypesToUpdate
              [(SQLData, Text)] -> ((SQLData, Text) -> SQLData) -> [SQLData]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SQLData
val, Text
datatype) ->
                if (SQLData
val SQLData -> SQLData -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> SQLData
SQLText Text
"{}")
                  Bool -> Bool -> Bool
P.&& (Text
"BLOB" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toUpper Text
datatype)
                  then ByteString -> SQLData
SQLBlob ByteString
""
                  else SQLData
val
        in
          IO [[SQLData]]
-> (SomeException -> IO [[SQLData]]) -> IO [[SQLData]]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
            ( IO [[SQLData]] -> IO [[SQLData]]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> IO [[SQLData]])
-> IO [[SQLData]] -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ do
                Connection -> [(Text, Value)] -> IO ()
setCaseInsensitive Connection
connection [(Text, Value)]
filterElements
                Connection -> Query -> [SQLData] -> IO [[SQLData]]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
connection Query
sqlQuery [SQLData]
valuesToSetNorm
            )
            (ResolverException -> IO [[SQLData]]
forall a e. Exception e => e -> a
throw (ResolverException -> IO [[SQLData]])
-> (SomeException -> ResolverException)
-> SomeException
-> IO [[SQLData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ResolverException
forall e. Exception e => e -> ResolverException
ResolverException)

  IO (Int, [[SQLData]]) -> IO (Int, [[SQLData]])
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, [[SQLData]]) -> IO (Int, [[SQLData]]))
-> IO (Int, [[SQLData]]) -> IO (Int, [[SQLData]])
forall a b. (a -> b) -> a -> b
$
    Connection -> IO Int
changes Connection
connection
      IO Int
-> (IO Int -> IO (Int, [[SQLData]])) -> IO (Int, [[SQLData]])
forall a b. a -> (a -> b) -> b
& (Int -> (Int, [[SQLData]])) -> IO Int -> IO (Int, [[SQLData]])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap (,[[SQLData]]
updatedRows)


mutationType
  :: Connection
  -> Integer
  -> AccessMode
  -> Text
  -> [TableEntryRaw]
  -> IO (Maybe (Out.ObjectType IO))
mutationType :: Connection
-> Integer
-> AccessMode
-> Text
-> [TableEntryRaw]
-> IO (Maybe (ObjectType IO))
mutationType Connection
connection Integer
maxRowsPerTable AccessMode
accessMode Text
dbId [TableEntryRaw]
tables = do
  let
    documentation :: Text
documentation =
      Text
"Available queries for database \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dbId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

    getTableFilterType :: Text -> [ColumnEntry] -> InputObjectType
    getTableFilterType :: Text -> [ColumnEntry] -> InputObjectType
getTableFilterType Text
tableName [ColumnEntry]
columnEntries = do
      Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
        (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_filter")
        ( Text -> Maybe Text
forall a. a -> Maybe a
Just
            Text
"Filter objects for the specified columns"
        )
        ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Text -> [ColumnEntry] -> [(Text, InputField)]
colNamesWithFilterField Text
tableName [ColumnEntry]
columnEntries))

    getOutField :: Text -> IO (Out.Field IO)
    getOutField :: Text -> IO (Field IO)
getOutField Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> IO [ColumnEntry]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> IO [ColumnEntry])
-> IO [ColumnEntry] -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      let
        colNamesWithField :: [(Text, InputField)]
        colNamesWithField :: [(Text, InputField)]
colNamesWithField =
          [ColumnEntry]
columnEntries [ColumnEntry]
-> (ColumnEntry -> (Text, InputField)) -> [(Text, InputField)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
colEntry ->
            let
              inputField :: InputField
inputField =
                Maybe Text -> Type -> Maybe Value -> InputField
InputField
                  (Text -> Maybe Text
forall a. a -> Maybe a
Just ColumnEntry
colEntry.column_name_gql)
                  ( ScalarType -> Type
In.NamedScalarType (ScalarType -> Type) -> ScalarType -> Type
forall a b. (a -> b) -> a -> b
$
                      Maybe GqlTypeName -> ScalarType
typeNameToScalarType ColumnEntry
colEntry.datatype_gql
                  )
                  Maybe Value
forall a. Maybe a
Nothing -- Default value
            in
              ( ColumnEntry
colEntry.column_name_gql
              , InputField
inputField
              )

      let
        objectsType :: Argument
objectsType =
          InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
            InArgument
              { $sel:argDescMb:InArgument :: Maybe Text
argDescMb =
                  Text -> Maybe Text
forall a. a -> Maybe a
Just
                    Text
"Objects to be inserted into the database"
              , $sel:argType:InArgument :: Type
argType =
                  Type -> Type
In.ListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                    InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                      Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                        ( Text -> Text
doubleXEncodeGql Text
tableName
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_insert_input"
                        )
                        ( Text -> Maybe Text
forall a. a -> Maybe a
Just
                            Text
"Object to be inserted into the database"
                        )
                        ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, InputField)]
colNamesWithField)
              , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
              }

        onConflictDescription :: Text
onConflictDescription =
          Text
"Specifies how to handle brtoken unique constraints" :: Text

        columnEnumVariants :: [(Text, EnumValue)]
columnEnumVariants =
          [ColumnEntry]
columnEntries
            [ColumnEntry]
-> (ColumnEntry -> (Text, EnumValue)) -> [(Text, EnumValue)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
entry ->
              (ColumnEntry
entry.column_name_gql, Maybe Text -> EnumValue
EnumValue Maybe Text
forall a. Maybe a
Nothing)

        columnEnumType :: EnumType
columnEnumType =
          Text -> Maybe Text -> HashMap Text EnumValue -> EnumType
EnumType
            (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_column")
            (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This enum contains a variant for each colum in the table")
            ([(Text, EnumValue)] -> HashMap Text EnumValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, EnumValue)]
columnEnumVariants)

        onConflictType :: Argument
onConflictType =
          InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
            InArgument
              { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
onConflictDescription
              , $sel:argType:InArgument :: Type
argType =
                  Type -> Type
In.ListType
                    (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ InputObjectType -> Type
In.NonNullInputObjectType
                    (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                      ( Text -> Text
doubleXEncodeGql Text
tableName
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_upsert_on_conflict"
                      )
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
onConflictDescription)
                    (HashMap Text InputField -> InputObjectType)
-> HashMap Text InputField -> InputObjectType
forall a b. (a -> b) -> a -> b
$ [(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                      [
                        ( Text
"constraint"
                        , Maybe Text -> Type -> Maybe Value -> InputField
InputField
                            (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"columns to handle conflicts of")
                            ( Type -> Type
In.NonNullListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                                EnumType -> Type
In.NonNullEnumType EnumType
columnEnumType
                            )
                            Maybe Value
forall a. Maybe a
Nothing
                        )
                      ,
                        ( Text
"update_columns"
                        , Maybe Text -> Type -> Maybe Value -> InputField
InputField
                            (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"columns to override on conflict")
                            ( Type -> Type
In.NonNullListType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                                EnumType -> Type
In.NonNullEnumType EnumType
columnEnumType
                            )
                            Maybe Value
forall a. Maybe a
Nothing
                        )
                      ,
                        ( Text
"where"
                        , Maybe Text -> Type -> Maybe Value -> InputField
InputField
                            (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"filter specifying which conflicting columns to update")
                            ( InputObjectType -> Type
In.NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                Text -> [ColumnEntry] -> InputObjectType
getTableFilterType Text
tableName [ColumnEntry]
columnEntries
                            )
                            Maybe Value
forall a. Maybe a
Nothing
                        )
                      ]
              , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
              }

      Field IO -> IO (Field IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field IO -> IO (Field IO)) -> Field IO -> IO (Field IO)
forall a b. (a -> b) -> a -> b
$
        OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
          OutField
            { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"description"
            , $sel:fieldType:OutField :: Type IO
fieldType = AccessMode -> Text -> [ColumnEntry] -> Type IO
getMutationResponse AccessMode
accessMode Text
tableName [ColumnEntry]
columnEntries
            , $sel:arguments:OutField :: Arguments
arguments =
                [(Text, Argument)] -> Arguments
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                  [ (Text
"objects", Argument
objectsType)
                  , (Text
"on_conflict", Argument
onConflictType)
                  ]
            }

    getColValue :: HashMap.HashMap Text Value -> Text -> Value
    getColValue :: HashMap Text Value -> Text -> Value
getColValue HashMap Text Value
rowObj Text
columnName =
      Value -> Text -> HashMap Text Value -> Value
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault Value
Null (Text -> Text
doubleXEncodeGql Text
columnName) HashMap Text Value
rowObj

    executeDbInserts :: Text -> ReaderT Out.Context IO Value
    executeDbInserts :: Text -> ReaderT Context IO Value
executeDbInserts Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry])
-> IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask

      let
        columnNames :: [Text]
        columnNames :: [Text]
columnNames =
          [ColumnEntry]
columnEntries [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnEntry -> Text
column_name

        columnNamesText :: Text
        columnNamesText :: Text
columnNamesText =
          [Text]
columnNames
            [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
quoteKeyword
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
", "

        insertInDb :: Arguments -> ReaderT Out.Context IO (Int, [[SQLData]])
        insertInDb :: Arguments -> ReaderT Context IO (Int, [[SQLData]])
insertInDb (Arguments HashMap Text Value
argMap) = do
          let
            -- Yields for example:
            --   [ { name: "John", email: "john@example.com" }
            --   , { name: "Eve",  email: "eve@example.com" }
            --   ]
            entries :: Value
entries =
              Value -> Text -> HashMap Text Value -> Value
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault
                ([Value] -> Value
List [])
                Text
"objects"
                HashMap Text Value
argMap

            -- All colums that are contained in the entries
            containedColumns :: [Text]
            containedColumns :: [Text]
containedColumns =
              case Value
entries of
                List [Value]
values ->
                  ( [Value]
values
                      [Value] -> (Value -> [Text]) -> [[Text]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                        Object HashMap Text Value
rowObj ->
                          HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Value
rowObj
                        Value
_ -> []
                  )
                    [[Text]] -> ([[Text]] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat
                    [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub
                    [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
doubleXDecode
                Value
_ -> []

            boundVariableNames :: [Text]
            boundVariableNames :: [Text]
boundVariableNames =
              [Text]
containedColumns
                [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Text
name -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleXEncodeGql Text
name)

            onConflictArg :: [Value]
onConflictArg =
              case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"on_conflict" HashMap Text Value
argMap of
                Just (List [Value]
values) -> [Value]
values
                Maybe Value
_ -> []

          [Text]
onConflictClauses <- [Value]
-> (Value -> ReaderT Context IO Text) -> ReaderT Context IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for [Value]
onConflictArg ((Value -> ReaderT Context IO Text) -> ReaderT Context IO [Text])
-> (Value -> ReaderT Context IO Text) -> ReaderT Context IO [Text]
forall a b. (a -> b) -> a -> b
$ \case
            Object HashMap Text Value
fields -> do
              let
                getColumnList :: Text -> [Text]
getColumnList Text
fieldName = do
                  case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
fieldName HashMap Text Value
fields of
                    Just (List [Value]
elements) -> do
                      Value
element <- [Value]
elements
                      case Value
element of
                        Enum Text
columnName -> Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
columnName
                        Value
_ -> []
                    Maybe Value
_ -> []

                constraint :: [Text]
constraint = Text -> [Text]
getColumnList Text
"constraint"
                update :: [Text]
update = Text -> [Text]
getColumnList Text
"update_columns"

              [Text]
updateClauses <- [Text]
-> (Text -> ReaderT Context IO Text) -> ReaderT Context IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for [Text]
update ((Text -> ReaderT Context IO Text) -> ReaderT Context IO [Text])
-> (Text -> ReaderT Context IO Text) -> ReaderT Context IO [Text]
forall a b. (a -> b) -> a -> b
$ \Text
column -> do
                Bool -> ReaderT Context IO () -> ReaderT Context IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
column Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
containedColumns) (ReaderT Context IO () -> ReaderT Context IO ())
-> ReaderT Context IO () -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ do
                  IOError -> ReaderT Context IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO ())
-> IOError -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                      String
"Column "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
column
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cannot be set on conflicts without being explicitly provided"

                Text -> ReaderT Context IO Text
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT Context IO Text)
-> Text -> ReaderT Context IO Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Text
quoteKeyword Text
column
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = :"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleXEncodeGql Text
column

              let
                filterElements :: [(Text, Value)]
filterElements = case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"where" HashMap Text Value
fields of
                  Just (Object HashMap Text Value
filterObj) -> HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
filterObj
                  Maybe Value
_ -> []

              Text -> ReaderT Context IO Text
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT Context IO Text)
-> Text -> ReaderT Context IO Text
forall a b. (a -> b) -> a -> b
$
                Text
"ON CONFLICT ("
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( [Text]
constraint
                        [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
quoteKeyword
                        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
"<>"
                     )
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n DO UPDATE SET \n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
",\n" [Text]
updateClauses
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)] -> Text
getWhereClause [(Text, Value)]
filterElements
            Value
_ -> Text -> ReaderT Context IO Text
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

          let
            columnList :: Text
columnList =
              if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Text]
containedColumns
                then Text
""
                else
                  Text
" ("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( [Text]
containedColumns
                          [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
quoteKeyword
                          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
", "
                       )
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            insertedValues :: Text
insertedValues =
              if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Text]
boundVariableNames
                then Text
"DEFAULT VALUES"
                else
                  Text
"VALUES ("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
boundVariableNames
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            sqlQuery :: Query
sqlQuery =
              Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
                Text
"INSERT INTO "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
tableName
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnList
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insertedValues
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
P.unlines [Text]
onConflictClauses
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"RETURNING "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                  -- TODO: Only return the actually requested values
                  Text
columnNamesText

            sqlDataRows :: [[SQLData]]
            sqlDataRows :: [[SQLData]]
sqlDataRows =
              case Value
entries of
                List [Value]
values ->
                  [Value]
values [Value] -> (Value -> [SQLData]) -> [[SQLData]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                    Object HashMap Text Value
rowObj ->
                      [Text]
containedColumns
                        [Text] -> (Text -> Value) -> [Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap Text Value -> Text -> Value
getColValue HashMap Text Value
rowObj
                        [Value] -> (Value -> SQLData) -> [SQLData]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> SQLData
gqlValueToSQLData
                    Value
_ -> []
                Value
_ -> []

          -- Exception from SQLite must be converted into
          -- ResolverExceptions to be picked up by GQL query executor
          [[[SQLData]]]
returnedRows <-
            ReaderT Context IO [[[SQLData]]]
-> (SomeException -> ReaderT Context IO [[[SQLData]]])
-> ReaderT Context IO [[[SQLData]]]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
              ( IO [[[SQLData]]] -> ReaderT Context IO [[[SQLData]]]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[[SQLData]]] -> ReaderT Context IO [[[SQLData]]])
-> IO [[[SQLData]]] -> ReaderT Context IO [[[SQLData]]]
forall a b. (a -> b) -> a -> b
$ [[SQLData]] -> ([SQLData] -> IO [[SQLData]]) -> IO [[[SQLData]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
P.forM [[SQLData]]
sqlDataRows (([SQLData] -> IO [[SQLData]]) -> IO [[[SQLData]]])
-> ([SQLData] -> IO [[SQLData]]) -> IO [[[SQLData]]]
forall a b. (a -> b) -> a -> b
$ \[SQLData]
sqlDataRow -> do
                  [[Integer]]
numRowsRes :: [[Integer]] <-
                    Connection -> Query -> IO [[Integer]]
forall r. FromRow r => Connection -> Query -> IO [r]
query_
                      Connection
connection
                      (Query -> IO [[Integer]]) -> Query -> IO [[Integer]]
forall a b. (a -> b) -> a -> b
$ Text -> Query
Query
                      (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT COUNT() FROM "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
tableName

                  case [[Integer]]
numRowsRes of
                    [[Integer
numRows]] -> do
                      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
numRows Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
maxRowsPerTable) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        IOError -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$
                          String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                            String
"Please upgrade to a Pro account \
                            \to insert more than "
                              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a b. (Show a, StringConv String b) => a -> b
show Integer
maxRowsPerTable
                              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" rows into a table"
                    [[Integer]]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

                  Connection -> Query -> [NamedParam] -> IO [[SQLData]]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
SS.queryNamed Connection
connection Query
sqlQuery ([NamedParam] -> IO [[SQLData]]) -> [NamedParam] -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$
                    (Text -> SQLData -> NamedParam)
-> [Text] -> [SQLData] -> [NamedParam]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
P.zipWith Text -> SQLData -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
(SS.:=) [Text]
boundVariableNames [SQLData]
sqlDataRow
              )
              (ResolverException -> ReaderT Context IO [[[SQLData]]]
forall a e. Exception e => e -> a
throw (ResolverException -> ReaderT Context IO [[[SQLData]]])
-> (SomeException -> ResolverException)
-> SomeException
-> ReaderT Context IO [[[SQLData]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ResolverException
forall e. Exception e => e -> ResolverException
ResolverException)

          -- FIXME:
          --   This should probably be used, but sqlite-simple
          --   doesn't use only one query to execute the insert
          --   https://github.com/nurpax/sqlite-simple/issues/82
          -- liftIO $ changes connection
          (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[SQLData]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [[SQLData]]
sqlDataRows, [[[SQLData]]]
returnedRows [[[SQLData]]] -> ([[[SQLData]]] -> [[SQLData]]) -> [[SQLData]]
forall a b. a -> (a -> b) -> b
& [[[SQLData]]] -> [[SQLData]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat)

      (Int
numOfChanges, [[SQLData]]
returnedRows) <- Arguments -> ReaderT Context IO (Int, [[SQLData]])
insertInDb Context
context.arguments
      Value
returning <- Text
-> Text -> [ColumnEntry] -> [[SQLData]] -> ReaderT Context IO Value
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList Text
dbId Text
tableName [ColumnEntry]
columnEntries [[SQLData]]
returnedRows

      Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
        HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$
          [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
            [ (Text
"affected_rows", Int32 -> Value
Int (Int32 -> Value) -> Int32 -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numOfChanges)
            , (Text
"returning", Value
returning)
            ]

    -- Execute SQL query to update selected entries
    executeDbUpdates :: Text -> ReaderT Out.Context IO Value
    executeDbUpdates :: Text -> ReaderT Context IO Value
executeDbUpdates Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry])
-> IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask

      let Arguments HashMap Text Value
args = Context
context.arguments

      (Int
numOfChanges, [[SQLData]]
updatedRows) <- case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"filter" HashMap Text Value
args of
        Just (Object HashMap Text Value
filterObj) -> case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
filterObj of
          [] -> IOError -> ReaderT Context IO (Int, [[SQLData]])
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
P.throwIO (IOError -> ReaderT Context IO (Int, [[SQLData]]))
-> IOError -> ReaderT Context IO (Int, [[SQLData]])
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Error: Filter must not be empty"
          [(Text, Value)]
filterElements ->
            IO (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]]))
-> IO (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a b. (a -> b) -> a -> b
$
              Connection
-> Text
-> HashMap Text Value
-> [ColumnEntry]
-> [(Text, Value)]
-> IO (Int, [[SQLData]])
executeSqlMutation
                Connection
connection
                Text
tableName
                HashMap Text Value
args
                [ColumnEntry]
columnEntries
                [(Text, Value)]
filterElements
        Maybe Value
_ -> (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [])

      Value
returning <- Text
-> Text -> [ColumnEntry] -> [[SQLData]] -> ReaderT Context IO Value
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList Text
dbId Text
tableName [ColumnEntry]
columnEntries [[SQLData]]
updatedRows

      Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
        HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$
          [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
            [ (Text
"affected_rows", Int32 -> Value
Int (Int32 -> Value) -> Int32 -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
numOfChanges :: Int))
            , (Text
"returning", Value
returning)
            ]

    -- Execute SQL query to delete selected entries
    executeDbDeletions :: Text -> ReaderT Out.Context IO Value
    executeDbDeletions :: Text -> ReaderT Context IO Value
executeDbDeletions Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry])
-> IO [ColumnEntry] -> ReaderT Context IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName
      Context
context <- ReaderT Context IO Context
forall r (m :: * -> *). MonadReader r m => m r
ask

      let
        columnNamesText :: Text
        columnNamesText :: Text
columnNamesText =
          [ColumnEntry]
columnEntries
            [ColumnEntry] -> (ColumnEntry -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnEntry -> Text
column_name
            [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
quoteKeyword
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
intercalate Text
", "

        deleteEntry :: Text -> Text -> ReaderT Context IO (Int, [[SQLData]])
deleteEntry Text
columnName Text
value = do
          let sqlQuery :: Query
sqlQuery =
                Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
                  Text
"DELETE FROM "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
tableName
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \
                       \WHERE "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteKeyword Text
columnName
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?\n"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"RETURNING "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNamesText
          [[SQLData]]
deletedRows :: [[SQLData]] <-
            ReaderT Context IO [[SQLData]]
-> (SomeException -> ReaderT Context IO [[SQLData]])
-> ReaderT Context IO [[SQLData]]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
              (IO [[SQLData]] -> ReaderT Context IO [[SQLData]]
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> ReaderT Context IO [[SQLData]])
-> IO [[SQLData]] -> ReaderT Context IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> [Text] -> IO [[SQLData]]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
connection Query
sqlQuery [Text
value])
              (ResolverException -> ReaderT Context IO [[SQLData]]
forall a e. Exception e => e -> a
throw (ResolverException -> ReaderT Context IO [[SQLData]])
-> (SomeException -> ResolverException)
-> SomeException
-> ReaderT Context IO [[SQLData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ResolverException
forall e. Exception e => e -> ResolverException
ResolverException)
          Int
numChanges <- IO Int -> ReaderT Context IO Int
forall a. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ReaderT Context IO Int)
-> IO Int -> ReaderT Context IO Int
forall a b. (a -> b) -> a -> b
$ Connection -> IO Int
changes Connection
connection

          (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
numChanges, [[SQLData]]
deletedRows)

      (Int
numOfChanges, [[SQLData]]
deletedRows) <- case Context
context.arguments of
        Arguments HashMap Text Value
args -> case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"filter" HashMap Text Value
args of
          Just Value
colToFilter -> case Value
colToFilter of
            Object HashMap Text Value
filterObj -> case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
filterObj of
              [(Text
columnName, Object HashMap Text Value
operatorAndValue)] -> do
                case HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
operatorAndValue of
                  [(Text
"eq", String Text
value)] ->
                    Text -> Text -> ReaderT Context IO (Int, [[SQLData]])
deleteEntry Text
columnName Text
value
                  [(Text
"eq", Int Int32
value)] ->
                    Text -> Text -> ReaderT Context IO (Int, [[SQLData]])
deleteEntry Text
columnName (Text -> ReaderT Context IO (Int, [[SQLData]]))
-> Text -> ReaderT Context IO (Int, [[SQLData]])
forall a b. (a -> b) -> a -> b
$ Int32 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int32
value
                  [(Text, Value)]
_ -> (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [])
              [(Text, Value)]
_ -> (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [])
            Value
_ -> (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [])
          Maybe Value
Nothing -> (Int, [[SQLData]]) -> ReaderT Context IO (Int, [[SQLData]])
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [])

      Value
returning <- Text
-> Text -> [ColumnEntry] -> [[SQLData]] -> ReaderT Context IO Value
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [ColumnEntry] -> [[SQLData]] -> m Value
rowsToList Text
dbId Text
tableName [ColumnEntry]
columnEntries [[SQLData]]
deletedRows

      Value -> ReaderT Context IO Value
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReaderT Context IO Value)
-> Value -> ReaderT Context IO Value
forall a b. (a -> b) -> a -> b
$
        HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$
          [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
            [ (Text
"affected_rows", Int32 -> Value
Int (Int32 -> Value) -> Int32 -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numOfChanges)
            , (Text
"returning", Value
returning)
            ]

    getOutFieldUpdate :: Text -> IO (Out.Field IO)
    getOutFieldUpdate :: Text -> IO (Field IO)
getOutFieldUpdate Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> IO [ColumnEntry]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> IO [ColumnEntry])
-> IO [ColumnEntry] -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      let
        colNamesWithField :: [(Text, InputField)]
        colNamesWithField :: [(Text, InputField)]
colNamesWithField =
          [ColumnEntry]
columnEntries [ColumnEntry]
-> (ColumnEntry -> (Text, InputField)) -> [(Text, InputField)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntry
colEntry ->
            let
              inputField :: InputField
inputField =
                Maybe Text -> Type -> Maybe Value -> InputField
InputField
                  (Text -> Maybe Text
forall a. a -> Maybe a
Just ColumnEntry
colEntry.column_name_gql)
                  ( ScalarType -> Type
In.NamedScalarType (ScalarType -> Type) -> ScalarType -> Type
forall a b. (a -> b) -> a -> b
$
                      Maybe GqlTypeName -> ScalarType
typeNameToScalarType ColumnEntry
colEntry.datatype_gql
                  )
                  Maybe Value
forall a. Maybe a
Nothing -- Default value
            in
              ( ColumnEntry
colEntry.column_name_gql
              , InputField
inputField
              )

      Field IO -> IO (Field IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field IO -> IO (Field IO)) -> Field IO -> IO (Field IO)
forall a b. (a -> b) -> a -> b
$
        OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
          OutField
            { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Provides entries from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            , $sel:fieldType:OutField :: Type IO
fieldType = AccessMode -> Text -> [ColumnEntry] -> Type IO
getMutationResponse AccessMode
accessMode Text
tableName [ColumnEntry]
columnEntries
            , $sel:arguments:OutField :: Arguments
arguments =
                [(Text, Argument)] -> Arguments
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                  [
                    ( Text
"filter"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Filter objects"
                          , $sel:argType:InArgument :: Type
argType =
                              InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                Text -> [ColumnEntry] -> InputObjectType
getTableFilterType Text
tableName [ColumnEntry]
columnEntries
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ,
                    ( Text
"set"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Map with new values"
                          , $sel:argType:InArgument :: Type
argType =
                              InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                                  (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_set_input")
                                  (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"New values for the specified columns")
                                  ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, InputField)]
colNamesWithField)
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ]
            }

    getOutFieldDeletion :: Text -> IO (Out.Field IO)
    getOutFieldDeletion :: Text -> IO (Field IO)
getOutFieldDeletion Text
tableName = do
      [ColumnEntry]
columnEntries <- IO [ColumnEntry] -> IO [ColumnEntry]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColumnEntry] -> IO [ColumnEntry])
-> IO [ColumnEntry] -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName

      Field IO -> IO (Field IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field IO -> IO (Field IO)) -> Field IO -> IO (Field IO)
forall a b. (a -> b) -> a -> b
$
        OutField IO -> Field IO
forall (m :: * -> *). OutField m -> Field m
outFieldToField (OutField IO -> Field IO) -> OutField IO -> Field IO
forall a b. (a -> b) -> a -> b
$
          OutField
            { $sel:descriptionMb:OutField :: Maybe Text
descriptionMb = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Provides entries from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            , $sel:fieldType:OutField :: Type IO
fieldType = AccessMode -> Text -> [ColumnEntry] -> Type IO
getMutationResponse AccessMode
accessMode Text
tableName [ColumnEntry]
columnEntries
            , $sel:arguments:OutField :: Arguments
arguments =
                [(Text, Argument)] -> Arguments
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                  [
                    ( Text
"filter"
                    , InArgument -> Argument
inArgumentToArgument (InArgument -> Argument) -> InArgument -> Argument
forall a b. (a -> b) -> a -> b
$
                        InArgument
                          { $sel:argDescMb:InArgument :: Maybe Text
argDescMb = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Filter objects"
                          , $sel:argType:InArgument :: Type
argType =
                              InputObjectType -> Type
NamedInputObjectType (InputObjectType -> Type) -> InputObjectType -> Type
forall a b. (a -> b) -> a -> b
$
                                Text -> Maybe Text -> HashMap Text InputField -> InputObjectType
InputObjectType
                                  (Text -> Text
doubleXEncodeGql Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_filter")
                                  ( Text -> Maybe Text
forall a. a -> Maybe a
Just
                                      Text
"Filter objects for the specified columns"
                                  )
                                  ([(Text, InputField)] -> HashMap Text InputField
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Text -> [ColumnEntry] -> [(Text, InputField)]
colNamesWithFilterField Text
tableName [ColumnEntry]
columnEntries))
                          , $sel:valueMb:InArgument :: Maybe Value
valueMb = Maybe Value
forall a. Maybe a
Nothing
                          }
                    )
                  ]
            }
    -- -- TODO: Use for retrieving record by primary key
    -- , arguments = HashMap.fromList $ columnEntries
    --     <&> (\colEntry ->
    --           ( colEntry & column_name_gql :: Text
    --           , inArgumentToArgument $ InArgument
    --               { argDescMb = Just "Retrieve object by primary key"
    --               , argType = In.NamedScalarType $
    --                   typeNameToScalarType $ colEntry & datatype
    --               , valueMb = Nothing
    --               }
    --           )
    --         )

    getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
    getMutationResolvers :: IO (HashMap Text (Resolver IO))
getMutationResolvers = do
      let
        getInsertTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
        getInsertTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
getInsertTableTuple TableEntryRaw
table = do
          Field IO
outFieldInsertion <- Text -> IO (Field IO)
getOutField TableEntryRaw
table.name
          (Text, Resolver IO) -> IO (Text, Resolver IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Text
"insert_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleXEncodeGql TableEntryRaw
table.name
            , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver
                Field IO
outFieldInsertion
                (Text -> ReaderT Context IO Value
executeDbInserts TableEntryRaw
table.name)
            )

        getUpdateTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
        getUpdateTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
getUpdateTableTuple TableEntryRaw
table = do
          Field IO
outFieldUpdate <- Text -> IO (Field IO)
getOutFieldUpdate TableEntryRaw
table.name
          (Text, Resolver IO) -> IO (Text, Resolver IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Text
"update_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleXEncodeGql TableEntryRaw
table.name
            , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver
                Field IO
outFieldUpdate
                (Text -> ReaderT Context IO Value
executeDbUpdates TableEntryRaw
table.name)
            )

        getDeleteTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
        getDeleteTableTuple :: TableEntryRaw -> IO (Text, Resolver IO)
getDeleteTableTuple TableEntryRaw
table = do
          Field IO
outFieldDeletion <- Text -> IO (Field IO)
getOutFieldDeletion TableEntryRaw
table.name
          (Text, Resolver IO) -> IO (Text, Resolver IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Text
"delete_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleXEncodeGql TableEntryRaw
table.name
            , Field IO -> ReaderT Context IO Value -> Resolver IO
forall (m :: * -> *). Field m -> Resolve m -> Resolver m
ValueResolver
                Field IO
outFieldDeletion
                (Text -> ReaderT Context IO Value
executeDbDeletions TableEntryRaw
table.name)
            )

        getTableTuples :: IO [(Text, Resolver IO)]
        getTableTuples :: IO [(Text, Resolver IO)]
getTableTuples =
          [IO (Text, Resolver IO)] -> IO [(Text, Resolver IO)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO (Text, Resolver IO)] -> IO [(Text, Resolver IO)])
-> [IO (Text, Resolver IO)] -> IO [(Text, Resolver IO)]
forall a b. (a -> b) -> a -> b
$
            ([TableEntryRaw]
tables [TableEntryRaw]
-> (TableEntryRaw -> IO (Text, Resolver IO))
-> [IO (Text, Resolver IO)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TableEntryRaw -> IO (Text, Resolver IO)
getInsertTableTuple)
              [IO (Text, Resolver IO)]
-> [IO (Text, Resolver IO)] -> [IO (Text, Resolver IO)]
forall a. Semigroup a => a -> a -> a
<> ([TableEntryRaw]
tables [TableEntryRaw]
-> (TableEntryRaw -> IO (Text, Resolver IO))
-> [IO (Text, Resolver IO)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TableEntryRaw -> IO (Text, Resolver IO)
getUpdateTableTuple)
              [IO (Text, Resolver IO)]
-> [IO (Text, Resolver IO)] -> [IO (Text, Resolver IO)]
forall a. Semigroup a => a -> a -> a
<> ([TableEntryRaw]
tables [TableEntryRaw]
-> (TableEntryRaw -> IO (Text, Resolver IO))
-> [IO (Text, Resolver IO)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TableEntryRaw -> IO (Text, Resolver IO)
getDeleteTableTuple)

      IO [(Text, Resolver IO)]
getTableTuples IO [(Text, Resolver IO)]
-> ([(Text, Resolver IO)] -> HashMap Text (Resolver IO))
-> IO (HashMap Text (Resolver IO))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Text, Resolver IO)] -> HashMap Text (Resolver IO)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

  ObjectType IO -> Maybe (ObjectType IO)
forall a. a -> Maybe a
Just
    (ObjectType IO -> Maybe (ObjectType IO))
-> (HashMap Text (Resolver IO) -> ObjectType IO)
-> HashMap Text (Resolver IO)
-> Maybe (ObjectType IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Maybe Text
-> [InterfaceType IO]
-> HashMap Text (Resolver IO)
-> ObjectType IO
forall (m :: * -> *).
Text
-> Maybe Text
-> [InterfaceType m]
-> HashMap Text (Resolver m)
-> ObjectType m
Out.ObjectType
      Text
"Mutation"
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
documentation)
      []
    (HashMap Text (Resolver IO) -> Maybe (ObjectType IO))
-> IO (HashMap Text (Resolver IO)) -> IO (Maybe (ObjectType IO))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashMap Text (Resolver IO))
getMutationResolvers


-- | Automatically generated schema derived from the SQLite database
getDerivedSchema
  :: SchemaConf
  -> Connection
  -> Text
  -> [TableEntryRaw]
  -> IO (Schema IO)
getDerivedSchema :: SchemaConf
-> Connection -> Text -> [TableEntryRaw] -> IO (Schema IO)
getDerivedSchema SchemaConf
schemaConf Connection
connection Text
dbId [TableEntryRaw]
tables = do
  [Query]
sqlitePragmas <- PragmaConf -> IO [Query]
getSQLitePragmas SchemaConf
schemaConf.pragmaConf
  [Query] -> (Query -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
P.forM_ [Query]
sqlitePragmas (Connection -> Query -> IO ()
execute_ Connection
connection)

  ObjectType IO
queries <- Connection
-> AccessMode -> Text -> [TableEntryRaw] -> IO (ObjectType IO)
queryType Connection
connection SchemaConf
schemaConf.accessMode Text
dbId [TableEntryRaw]
tables
  Maybe (ObjectType IO)
mutations <-
    Connection
-> Integer
-> AccessMode
-> Text
-> [TableEntryRaw]
-> IO (Maybe (ObjectType IO))
mutationType
      Connection
connection
      SchemaConf
schemaConf.maxRowsPerTable
      SchemaConf
schemaConf.accessMode
      Text
dbId
      [TableEntryRaw]
tables

  Schema IO -> IO (Schema IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema IO -> IO (Schema IO)) -> Schema IO -> IO (Schema IO)
forall a b. (a -> b) -> a -> b
$
    ObjectType IO
-> Maybe (ObjectType IO)
-> Maybe (ObjectType IO)
-> Directives
-> Schema IO
forall (m :: * -> *).
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> Schema m
schema
      ObjectType IO
queries
      ( case SchemaConf
schemaConf.accessMode of
          AccessMode
ReadOnly -> Maybe (ObjectType IO)
forall a. Maybe a
Nothing
          AccessMode
WriteOnly -> Maybe (ObjectType IO)
mutations
          AccessMode
ReadAndWrite -> Maybe (ObjectType IO)
mutations
      )
      Maybe (ObjectType IO)
forall a. Maybe a
Nothing -- subscriptions
      Directives
forall a. Monoid a => a
mempty