module AirGQL.ServerUtils (
  executeQuery,
) where

import Protolude (
  Applicative (pure),
  Either (Left, Right),
  FilePath,
  IO,
  Maybe (Just, Nothing),
  toList,
  ($),
  (&),
  (<&>),
 )
import Protolude qualified as P

import Conduit (sourceToList)
import Control.Arrow ((>>>))
import Data.Aeson (Object, Value (String))
import Data.Text (Text)
import Data.Text qualified as T
import Database.SQLite.Simple qualified as SS
import Language.GraphQL.Error (Error (Error), Response (Response))
import Language.GraphQL.JSON (graphql)
import System.FilePath (pathSeparator, (</>))

import AirGQL.GraphQL (getDerivedSchema)
import AirGQL.Lib (getTables)
import AirGQL.Types.SchemaConf (SchemaConf)
import AirGQL.Types.Types (
  GQLResponse (GQLResponse, data_, errors),
  gqlResponseToObject,
 )


executeQuery
  :: SchemaConf
  -> Text
  -> FilePath
  -> Text
  -> Object
  -> Maybe Text
  -> IO Object
executeQuery :: SchemaConf
-> Text -> FilePath -> Text -> Object -> Maybe Text -> IO Object
executeQuery SchemaConf
schemaConf Text
dbIdOrPath FilePath
reqDir Text
query Object
vars Maybe Text
opNameMb = do
  let dbFilePath :: FilePath
dbFilePath =
        if Char
pathSeparator Char -> Text -> Bool
`T.elem` Text
dbIdOrPath
          then Text -> FilePath
T.unpack Text
dbIdOrPath
          else FilePath
reqDir FilePath -> FilePath -> FilePath
</> FilePath
"main.sqlite"

  Connection
theConn <- FilePath -> IO Connection
SS.open FilePath
dbFilePath
  [TableEntryRaw]
tables <- Connection -> IO [TableEntryRaw]
getTables Connection
theConn
  Schema IO
schema <- SchemaConf
-> Connection -> Text -> [TableEntryRaw] -> IO (Schema IO)
getDerivedSchema SchemaConf
schemaConf Connection
theConn Text
dbIdOrPath [TableEntryRaw]
tables
  Either (ResponseEventStream IO Value) Object
result <- Schema IO
-> Maybe Text
-> Object
-> Text
-> IO (Either (ResponseEventStream IO Value) Object)
forall (m :: * -> *).
MonadCatch m =>
Schema m
-> Maybe Text
-> Object
-> Text
-> m (Either (ResponseEventStream m Value) Object)
graphql Schema IO
schema Maybe Text
opNameMb Object
vars Text
query
  Connection -> IO ()
SS.close Connection
theConn

  case Either (ResponseEventStream IO Value) Object
result of
    Left ResponseEventStream IO Value
errMsg -> do
      [Response Value]
errors <- ResponseEventStream IO Value -> IO [Response Value]
forall (m :: * -> *) a. Monad m => ConduitT () a m () -> m [a]
sourceToList ResponseEventStream IO Value
errMsg
      Object -> IO Object
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$
        GQLResponse -> Object
gqlResponseToObject (GQLResponse -> Object) -> GQLResponse -> Object
forall a b. (a -> b) -> a -> b
$
          GQLResponse
            { $sel:data_:GQLResponse :: Maybe Value
data_ = Maybe Value
forall a. Maybe a
Nothing
            , $sel:errors:GQLResponse :: Maybe [Value]
errors =
                [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$
                  [Response Value]
errors
                    [Response Value] -> (Response Value -> [Error]) -> [[Error]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((\(Response Value
_ Seq Error
errs) -> Seq Error
errs) (Response Value -> Seq Error)
-> (Seq Error -> [Error]) -> Response Value -> [Error]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Seq Error -> [Error]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
                    [[Error]] -> ([[Error]] -> [Error]) -> [Error]
forall a b. a -> (a -> b) -> b
& [[Error]] -> [Error]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat
                    [Error] -> (Error -> Value) -> [Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Error Text
msg [Location]
_ [Path]
_) -> Text -> Value
String Text
msg)
            }
    Right Object
response -> Object -> IO Object
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
response