{-# LANGUAGE OverloadedStrings #-}

module PGIP.GraphQL.Resolver (resolve) where

import qualified PGIP.GraphQL.Resolver.DGraph as DGraphResolver
import qualified PGIP.GraphQL.Resolver.OMS as OMSResolver
import qualified PGIP.GraphQL.Resolver.Serialization as SerializationResolver
import qualified PGIP.GraphQL.Resolver.Signature as SignatureResolver
import qualified PGIP.GraphQL.Resolver.SignatureMorphism as SignatureMorphismResolver

import PGIP.GraphQL.Result as GraphQLResult

import PGIP.Shared

import Driver.Options

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Control.Monad.Fail as Fail

resolve :: HetcatsOpts -> Cache -> Text -> Map Text Text -> IO String
resolve :: HetcatsOpts -> Cache -> Text -> Map Text Text -> IO String
resolve opts :: HetcatsOpts
opts sessionReference :: Cache
sessionReference query :: Text
query variables :: Map Text Text
variables = do
  QueryType
queryType <- Text -> IO QueryType
determineQueryType Text
query
  Maybe Result
resultM <- case QueryType
queryType of
    QTSerialization -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "id" Map Text Text
variables of
      Nothing -> String -> IO (Maybe Result)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "Serialization query: Variable \"id\" not provided."
      Just idVar :: Text
idVar -> HetcatsOpts -> Cache -> String -> IO (Maybe Result)
SerializationResolver.resolve HetcatsOpts
opts Cache
sessionReference (String -> IO (Maybe Result)) -> String -> IO (Maybe Result)
forall a b. (a -> b) -> a -> b
$ Text -> String
unencloseQuotesAndUnpack Text
idVar
    QTDGraph -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "locId" Map Text Text
variables of
      Nothing -> String -> IO (Maybe Result)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "OMS query: Variable \"locId\" not provided."
      Just idVar :: Text
idVar -> HetcatsOpts -> Cache -> String -> IO (Maybe Result)
DGraphResolver.resolve HetcatsOpts
opts Cache
sessionReference (String -> IO (Maybe Result)) -> String -> IO (Maybe Result)
forall a b. (a -> b) -> a -> b
$ Text -> String
unencloseQuotesAndUnpack Text
idVar
    QTOMS -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "locId" Map Text Text
variables of
      Nothing -> String -> IO (Maybe Result)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "OMS query: Variable \"locId\" not provided."
      Just idVar :: Text
idVar -> HetcatsOpts -> Cache -> String -> IO (Maybe Result)
OMSResolver.resolve HetcatsOpts
opts Cache
sessionReference (String -> IO (Maybe Result)) -> String -> IO (Maybe Result)
forall a b. (a -> b) -> a -> b
$ Text -> String
unencloseQuotesAndUnpack Text
idVar
    QTSignature -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "id" Map Text Text
variables of
      Nothing -> String -> IO (Maybe Result)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "Signature query: Variable \"id\" not provided."
      Just idVar :: Text
idVar -> HetcatsOpts -> Cache -> Int -> IO (Maybe Result)
SignatureResolver.resolve HetcatsOpts
opts Cache
sessionReference (Int -> IO (Maybe Result)) -> Int -> IO (Maybe Result)
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
idVar
    QTSignatureMorphism -> case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "id" Map Text Text
variables of
      Nothing -> String -> IO (Maybe Result)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "SignatureMorphism query: Variable \"id\" not provided."
      Just idVar :: Text
idVar -> HetcatsOpts -> Cache -> Int -> IO (Maybe Result)
SignatureMorphismResolver.resolve HetcatsOpts
opts Cache
sessionReference (Int -> IO (Maybe Result)) -> Int -> IO (Maybe Result)
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
idVar
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ QueryType -> Maybe Result -> String
resultToResponse QueryType
queryType Maybe Result
resultM

unencloseQuotesAndUnpack :: Text.Text -> String
unencloseQuotesAndUnpack :: Text -> String
unencloseQuotesAndUnpack = Text -> String
Text.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.init (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.tail

resultToResponse :: QueryType -> Maybe GraphQLResult.Result -> String
resultToResponse :: QueryType -> Maybe Result -> String
resultToResponse queryType :: QueryType
queryType = String -> (Result -> String) -> Maybe Result -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
noData (QueryType -> String -> String
responseData QueryType
queryType (String -> String) -> (Result -> String) -> Result -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> String
GraphQLResult.toJson)

responseData :: QueryType -> String -> String
responseData :: QueryType -> String -> String
responseData queryType :: QueryType
queryType json :: String
json =
  let keyword :: String
keyword = case QueryType
queryType of
        QTDGraph -> "dgraph"
        QTOMS -> "oms"
        QTSerialization -> "serialization"
        QTSignature -> "signature"
        QTSignatureMorphism -> "signatureMorphism"
  in  "{\"data\": {\n  \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
keyword String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
json String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}}"

noData :: String
noData :: String
noData = "{\"data\": null}"

data QueryType = QTDGraph | QTOMS | QTSerialization | QTSignature | QTSignatureMorphism
                 deriving Int -> QueryType -> String -> String
[QueryType] -> String -> String
QueryType -> String
(Int -> QueryType -> String -> String)
-> (QueryType -> String)
-> ([QueryType] -> String -> String)
-> Show QueryType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QueryType] -> String -> String
$cshowList :: [QueryType] -> String -> String
show :: QueryType -> String
$cshow :: QueryType -> String
showsPrec :: Int -> QueryType -> String -> String
$cshowsPrec :: Int -> QueryType -> String -> String
Show

determineQueryType :: Text -> IO QueryType
determineQueryType :: Text -> IO QueryType
determineQueryType queryArg :: Text
queryArg
  | String -> Bool
isQueryPrefix "query DGraph" = QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
QTDGraph
  | String -> Bool
isQueryPrefix "query OMS" = QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
QTOMS
  | String -> Bool
isQueryPrefix "query Serialization" = QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
QTSerialization
  | String -> Bool
isQueryPrefix "query SignatureMorphism" = QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
QTSignatureMorphism
  | String -> Bool
isQueryPrefix "query Signature" = QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
QTSignature
  | Bool
otherwise =
      String -> IO QueryType
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail ("Query not supported.\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ "The query must begin with \"query X\", where X is one of "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ "DGraph, OMS, Serialization, Signature, SignatureMorphism\n"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ "This is due to a limitation of only mimicking a GraphQL API.")
  where
    isQueryPrefix :: String -> Bool
    isQueryPrefix :: String -> Bool
isQueryPrefix s :: String
s = Text -> Text -> Bool
Text.isPrefixOf (String -> Text
Text.pack String
s) Text
queryArg