Client.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Grakn.Client
  ( Client(Client, keyspace, url)
  , Concept(Concept, cid, clabel, ctype, value)
  , GraknError
  , Result(AnswersResult, AnswerResult, AskResult, CountResult,
       DeleteResult)
  , Options(Options, infer)
  , defaultUrl
  , defaultKeyspace
  , execute
  , execute_
  ) where

import           Data.Aeson          (FromJSON, Object, parseJSON, withObject,
                                      (.:), (.:?))
import           Data.Aeson.Types    (Parser)
import           Data.Foldable       (asum)
import           Data.Map            (Map)
import           Data.Proxy          (Proxy (Proxy))
import           Data.Text           (Text)
import           Grakn.Property      (Label, Value, Var)
import           Grakn.Query         (IsQuery (queryString))
import           Network.HTTP.Client (defaultManagerSettings, newManager)
import           Servant.API         ((:>), Capture, JSON, PlainText, Post,
                                      QueryParam, ReqBody)
import           Servant.Client      (BaseUrl (BaseUrl), ClientEnv (ClientEnv),
                                      ClientM, Scheme (Http), ServantError,
                                      client, runClientM)

data Client = Client
  { url      :: BaseUrl
  , keyspace :: String
  }

newtype GraknError =
  GraknError String
  deriving (Eq, Show)

-- |A result of a query
data Result
  = AnswersResult [Map Var Concept]
  | AnswerResult (Map Var Concept)
  | DeleteResult
  | AskResult Bool
  | CountResult Integer
  deriving (Show, Eq)

-- |A concept in the knowledge base
data Concept = Concept
  { cid    :: Text
  , clabel :: Maybe Label
  , ctype  :: Maybe Label
  , value  :: Maybe Value
  } deriving (Show, Eq)

-- |The default Grakn URL, accessing localhost
defaultUrl :: BaseUrl
defaultUrl = BaseUrl Http "localhost" 4567 ""

-- |The default Grakn keyspace
defaultKeyspace :: String
defaultKeyspace = "grakn"

data Options = Options
  { infer :: Bool
  }

type ExecuteResponse = IO (Either ServantError Result)

execute :: IsQuery q => Client -> q -> ExecuteResponse
execute = executeOpts Nothing

execute_ :: IsQuery q => Options -> Client -> q -> ExecuteResponse
execute_ opts = executeOpts (Just opts)

executeOpts :: IsQuery q => Maybe Options -> Client -> q -> ExecuteResponse
executeOpts opts (Client u ks) query = do
  manager <- newManager defaultManagerSettings
  let env = ClientEnv manager u
  runClientM (graqlGet opts (queryString query) ks) env

type Infer = QueryParam "infer" Bool

type Query = ReqBody '[ PlainText] String

type Keyspace = Capture "keyspace" String

-- |A type describing the REST API we use to execute queries
type GraknAPI
   = "kb" :> Keyspace :> "graql" :> Infer :> Query :> Post '[ JSON] Result

graknAPI :: Proxy GraknAPI
graknAPI = Proxy

graqlGet :: Maybe Options -> String -> String -> ClientM Result
graqlGet opts query ks = client graknAPI ks (infer <$> opts) query

-- This is a helper method for chaining accessing optional JSON fields
(.:>) :: FromJSON a => Parser (Maybe Object) -> Text -> Parser (Maybe a)
maybeParser .:> key = traverse (.: key) =<< maybeParser

instance FromJSON Concept where
  parseJSON =
    withObject "Concept" $ \obj -> do
      cid <- obj .: "id"
      clabel <- obj .:? "label"
      ctype <- obj .:? "type" .:> "label"
      value <- obj .:? "value"
      return Concept {..}

instance FromJSON Result where
  parseJSON val =
    asum
      [ AnswersResult <$> parseJSON val
      , AnswerResult <$> parseJSON val
      , AskResult <$> parseJSON val
      , CountResult <$> parseJSON val
      , pure DeleteResult
      ]