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

module Database.Cayley.Client (

      Quad (..)

    -- * Connection
    , defaultCayleyConfig
    , connectCayley

    -- * Operations
    , query
    , Shape
    , queryShape
    , write
    , writeQuad
    , writeQuads
    , writeNQuadFile
    , delete
    , deleteQuad
    , deleteQuads

    -- * Utils
    , createQuad
    , isValid
    , results

    ) where

import           Control.Applicative                   ((<|>))
import           Control.Lens.Fold                     ((^?))
import           Control.Monad.Catch
import           Control.Monad.Reader
import qualified Data.Aeson                            as A
import qualified Data.Aeson.Lens                       as L
import qualified Data.Attoparsec.Text                  as APT
import qualified Data.Text                             as T
import           Data.Text.Encoding                    (encodeUtf8)
import           Network.HTTP.Client
import           Network.HTTP.Client.MultipartFormData

import           Database.Cayley.Client.Internal
import           Database.Cayley.Types

-- | Get a connection to Cayley with the given configuration.
--
-- >λ> conn <- connectCayley defaultCayleyConfig
--
connectCayley :: CayleyConfig -> IO CayleyConnection
connectCayley :: CayleyConfig -> IO CayleyConnection
connectCayley CayleyConfig
c =
  ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
    IO Manager
-> (Manager -> IO CayleyConnection) -> IO CayleyConnection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Manager
m -> CayleyConnection -> IO CayleyConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (CayleyConnection -> IO CayleyConnection)
-> CayleyConnection -> IO CayleyConnection
forall a b. (a -> b) -> a -> b
$ CayleyConnection :: CayleyConfig -> Manager -> CayleyConnection
CayleyConnection { cayleyConfig :: CayleyConfig
cayleyConfig = CayleyConfig
c, manager :: Manager
manager = Manager
m }

-- | Perform a query, in Gremlin graph query language per default (or in MQL).
--
-- >λ> query conn "graph.Vertex('Humphrey Bogart').In('name').All()"
-- >Right (Array (fromList [Object (fromList [("id",String "/en/humphrey_bogart")])]))
--
query :: CayleyConnection
      -> Query
      -> IO (Either String A.Value)
query :: CayleyConnection -> Query -> IO (Either String Value)
query CayleyConnection{Manager
CayleyConfig
manager :: Manager
cayleyConfig :: CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConnection -> CayleyConfig
..} =
  Manager -> CayleyConfig -> Query -> IO (Either String Value)
doQuery Manager
manager CayleyConfig
cayleyConfig
  where
    doQuery :: Manager -> CayleyConfig -> Query -> IO (Either String Value)
doQuery Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
queryLang :: CayleyConfig -> QueryLang
apiVersion :: CayleyConfig -> APIVersion
serverName :: CayleyConfig -> String
serverPort :: CayleyConfig -> Int
queryLang :: QueryLang
apiVersion :: APIVersion
serverName :: String
serverPort :: Int
..} Query
q = do
      Maybe Value
r <- Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
             Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/query/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QueryLang -> String
forall a. Show a => a -> String
show QueryLang
queryLang)
             Int
serverPort (ByteString -> RequestBody
RequestBodyBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Query -> ByteString
encodeUtf8 Query
q)
      Either String Value -> IO (Either String Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$
        case Maybe Value
r of
          Just Value
a  ->
            case Value
a Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Query -> Traversal' Value Value
forall t. AsValue t => Query -> Traversal' t Value
L.key Query
"result" of
              Just Value
v  -> Value -> Either String Value
forall a b. b -> Either a b
Right Value
v
              Maybe Value
Nothing ->
                case Value
a Value -> Getting (First Query) Value Query -> Maybe Query
forall s a. s -> Getting (First a) s a -> Maybe a
^? Query -> Traversal' Value Value
forall t. AsValue t => Query -> Traversal' t Value
L.key Query
"error" ((Value -> Const (First Query) Value)
 -> Value -> Const (First Query) Value)
-> Getting (First Query) Value Query
-> Getting (First Query) Value Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Query) Value Query
forall t. AsPrimitive t => Prism' t Query
L._String of
                  Just Query
e  -> String -> Either String Value
forall a b. a -> Either a b
Left (Query -> String
forall a. Show a => a -> String
show Query
e)
                  Maybe Query
Nothing -> String -> Either String Value
forall a b. a -> Either a b
Left String
"No JSON response from Cayley server"
          Maybe Value
Nothing -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Can't get any response from Cayley server"

-- | Return the description of the given executed query.
queryShape :: CayleyConnection
           -> Query
           -> IO (Either String Shape)
queryShape :: CayleyConnection -> Query -> IO (Either String Shape)
queryShape CayleyConnection{Manager
CayleyConfig
manager :: Manager
cayleyConfig :: CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConnection -> CayleyConfig
..} =
  Manager -> CayleyConfig -> Query -> IO (Either String Shape)
forall b.
FromJSON b =>
Manager -> CayleyConfig -> Query -> IO (Either String b)
doShape Manager
manager CayleyConfig
cayleyConfig
  where
    doShape :: Manager -> CayleyConfig -> Query -> IO (Either String b)
doShape Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
queryLang :: QueryLang
apiVersion :: APIVersion
serverName :: String
serverPort :: Int
queryLang :: CayleyConfig -> QueryLang
apiVersion :: CayleyConfig -> APIVersion
serverName :: CayleyConfig -> String
serverPort :: CayleyConfig -> Int
..} Query
q = do
      Maybe Value
r <- Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
             Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/shape/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QueryLang -> String
forall a. Show a => a -> String
show QueryLang
queryLang)
             Int
serverPort (ByteString -> RequestBody
RequestBodyBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Query -> ByteString
encodeUtf8 Query
q)
      Either String b -> IO (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$
        case Maybe Value
r of
          Just Value
o  ->
            case Value -> Result b
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
o of
              A.Success b
s -> b -> Either String b
forall a b. b -> Either a b
Right b
s
              A.Error String
e   -> String -> Either String b
forall a b. a -> Either a b
Left (String
"Not a shape (\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\")")
          Maybe Value
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left String
"API request error"

-- | Write a 'Quad' with the given subject, predicate, object and optional
-- label. Throw result or extract amount of query 'results'
-- from it.
--
-- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love")
-- >Just (Object (fromList [("result",String "Successfully wrote 1 quads.")]))
--
writeQuad :: CayleyConnection
          -> Subject
          -> Predicate
          -> Object
          -> Maybe Label
          -> IO (Maybe A.Value)
writeQuad :: CayleyConnection
-> Query -> Query -> Query -> Maybe Query -> IO (Maybe Value)
writeQuad CayleyConnection
c Query
s Query
p Query
o Maybe Query
l =
  CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection
c [Quad :: Query -> Query -> Query -> Maybe Query -> Quad
Quad { subject :: Query
subject = Query
s, predicate :: Query
predicate = Query
p, object :: Query
object = Query
o, label :: Maybe Query
label = Maybe Query
l }]

-- | Write the given 'Quad'.
write :: CayleyConnection
      -> Quad
      -> IO (Maybe A.Value)
write :: CayleyConnection -> Quad -> IO (Maybe Value)
write CayleyConnection
c Quad
q = CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection
c [Quad
q]

-- | Delete the 'Quad' defined by the given subject, predicate, object
-- and optional label.
deleteQuad :: CayleyConnection
           -> Subject
           -> Predicate
           -> Object
           -> Maybe Label
           -> IO (Maybe A.Value)
deleteQuad :: CayleyConnection
-> Query -> Query -> Query -> Maybe Query -> IO (Maybe Value)
deleteQuad CayleyConnection
c Query
s Query
p Query
o Maybe Query
l =
  CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection
c [Quad :: Query -> Query -> Query -> Maybe Query -> Quad
Quad { subject :: Query
subject = Query
s, predicate :: Query
predicate = Query
p, object :: Query
object = Query
o, label :: Maybe Query
label = Maybe Query
l }]

-- | Delete the given 'Quad'.
delete :: CayleyConnection -> Quad -> IO (Maybe A.Value)
delete :: CayleyConnection -> Quad -> IO (Maybe Value)
delete CayleyConnection
c Quad
q = CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection
c [Quad
q]

-- | Write the given list of 'Quad'(s).
writeQuads :: CayleyConnection
           -> [Quad]
           -> IO (Maybe A.Value)
writeQuads :: CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection{Manager
CayleyConfig
manager :: Manager
cayleyConfig :: CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConnection -> CayleyConfig
..} =
  Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
writeQuads' Manager
manager CayleyConfig
cayleyConfig
  where
    writeQuads' :: Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
writeQuads' Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
queryLang :: QueryLang
apiVersion :: APIVersion
serverName :: String
serverPort :: Int
queryLang :: CayleyConfig -> QueryLang
apiVersion :: CayleyConfig -> APIVersion
serverName :: CayleyConfig -> String
serverPort :: CayleyConfig -> Int
..} [Quad]
qs =
      Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
        Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/write")
        Int
serverPort ([Quad] -> RequestBody
toRequestBody [Quad]
qs)

-- | Delete the given list of 'Quad'(s).
deleteQuads :: CayleyConnection
            -> [Quad]
            -> IO (Maybe A.Value)
deleteQuads :: CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection{Manager
CayleyConfig
manager :: Manager
cayleyConfig :: CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConnection -> CayleyConfig
..} =
  Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
doDeletions Manager
manager CayleyConfig
cayleyConfig
  where
    doDeletions :: Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
doDeletions Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
queryLang :: QueryLang
apiVersion :: APIVersion
serverName :: String
serverPort :: Int
queryLang :: CayleyConfig -> QueryLang
apiVersion :: CayleyConfig -> APIVersion
serverName :: CayleyConfig -> String
serverPort :: CayleyConfig -> Int
..} [Quad]
qs =
      Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
        Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/delete")
        Int
serverPort ([Quad] -> RequestBody
toRequestBody [Quad]
qs)

-- | Write a N-Quad file.
--
-- >λ> writeNQuadFile conn "testdata.nq"
-- >Just (Object (fromList [("result",String "Successfully wrote 11 quads.")]))
--
writeNQuadFile :: (MonadThrow m, MonadIO m)
               => CayleyConnection
               -> FilePath
               -> m (Maybe A.Value)
writeNQuadFile :: CayleyConnection -> String -> m (Maybe Value)
writeNQuadFile CayleyConnection{Manager
CayleyConfig
manager :: Manager
cayleyConfig :: CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConnection -> CayleyConfig
..} =
  Manager -> CayleyConfig -> String -> m (Maybe Value)
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
Manager -> CayleyConfig -> String -> m (Maybe Value)
doWrite Manager
manager CayleyConfig
cayleyConfig
  where
    doWrite :: Manager -> CayleyConfig -> String -> m (Maybe Value)
doWrite Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
queryLang :: QueryLang
apiVersion :: APIVersion
serverName :: String
serverPort :: Int
queryLang :: CayleyConfig -> QueryLang
apiVersion :: CayleyConfig -> APIVersion
serverName :: CayleyConfig -> String
serverPort :: CayleyConfig -> Int
..} String
fp = do
      Request
r <- String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/write/file/nquad")
             m Request -> (Request -> m Request) -> m Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
r -> Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
r { port :: Int
port = Int
serverPort }
      Either SomeException (Response ByteString)
t <- IO (Either SomeException (Response ByteString))
-> m (Either SomeException (Response ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Response ByteString))
 -> m (Either SomeException (Response ByteString)))
-> IO (Either SomeException (Response ByteString))
-> m (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$
             IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (Response ByteString)
 -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$
               (Request -> Manager -> IO (Response ByteString))
-> Manager -> Request -> IO (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Request -> Manager -> IO (Response ByteString)
httpLbs Manager
m
                 (Request -> IO (Response ByteString))
-> IO Request -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Part] -> Request -> IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Query -> String -> Part
partFileSource Query
"NQuadFile" String
fp] Request
r
      Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$
        case Either SomeException (Response ByteString)
t of
          Right Response ByteString
b -> ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
b)
          Left SomeException
e  -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$
            [Pair] -> Value
A.object [Query
"error" Query -> Query -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Query -> v -> kv
A..= String -> Query
T.pack (SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException))]

-- | A valid 'Quad' has its subject, predicate and object not empty.
isValid :: Quad -> Bool
isValid :: Quad -> Bool
isValid Quad{Maybe Query
Query
label :: Maybe Query
object :: Query
predicate :: Query
subject :: Query
label :: Quad -> Maybe Query
object :: Quad -> Query
predicate :: Quad -> Query
subject :: Quad -> Query
..} = Query
T.empty Query -> [Query] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Query
subject, Query
predicate, Query
object]

-- | Given a subject, a predicate, an object and an optional label,
-- create a valid 'Quad'.
createQuad :: Subject
           -> Predicate
           -> Object
           -> Maybe Label
           -> Maybe Quad
createQuad :: Query -> Query -> Query -> Maybe Query -> Maybe Quad
createQuad Query
s Query
p Query
o Maybe Query
l =
  if Query
T.empty Query -> [Query] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Query
s,Query
p,Query
o]
    then Quad -> Maybe Quad
forall a. a -> Maybe a
Just Quad :: Query -> Query -> Query -> Maybe Query -> Quad
Quad { subject :: Query
subject = Query
s, predicate :: Query
predicate = Query
p, object :: Query
object = Query
o, label :: Maybe Query
label = Maybe Query
l }
    else Maybe Quad
forall a. Maybe a
Nothing

-- | Get amount of results from a write/delete 'Quad'(s) operation,
-- or an explicite error message.
--
-- >λ> writeNQuadFile conn "testdata.nq" >>= results
-- >Right 11
--
results :: Maybe A.Value
        -> IO (Either String Int)
results :: Maybe Value -> IO (Either String Int)
results Maybe Value
m = Either String Int -> IO (Either String Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Int -> IO (Either String Int))
-> Either String Int -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$
  case Maybe Value
m of
    Just Value
v ->
      case Value
v Value -> Getting (First Query) Value Query -> Maybe Query
forall s a. s -> Getting (First a) s a -> Maybe a
^? Query -> Traversal' Value Value
forall t. AsValue t => Query -> Traversal' t Value
L.key Query
"result" ((Value -> Const (First Query) Value)
 -> Value -> Const (First Query) Value)
-> Getting (First Query) Value Query
-> Getting (First Query) Value Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Query) Value Query
forall t. AsPrimitive t => Prism' t Query
L._String of
        Just Query
r  ->
          case Parser Int -> Query -> Result Int
forall a. Parser a -> Query -> Result a
APT.parse Parser Int
getAmount Query
r of
            APT.Done Query
"" Int
i -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
i
            Result Int
_             -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Can't get amount of results"
        Maybe Query
Nothing ->
          case Value
v Value -> Getting (First Query) Value Query -> Maybe Query
forall s a. s -> Getting (First a) s a -> Maybe a
^? Query -> Traversal' Value Value
forall t. AsValue t => Query -> Traversal' t Value
L.key Query
"error" ((Value -> Const (First Query) Value)
 -> Value -> Const (First Query) Value)
-> Getting (First Query) Value Query
-> Getting (First Query) Value Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Query) Value Query
forall t. AsPrimitive t => Prism' t Query
L._String of
            Just Query
e  -> String -> Either String Int
forall a b. a -> Either a b
Left (Query -> String
forall a. Show a => a -> String
show Query
e)
            Maybe Query
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"No JSON response from Cayley server"
    Maybe Value
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Can't get any response from Cayley server"
  where
  getAmount :: Parser Int
getAmount = do
      Query
_ <- Query -> Parser Query
APT.string Query
"Successfully "
      Query
_ <- Query -> Parser Query
APT.string Query
"deleted " Parser Query -> Parser Query -> Parser Query
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Query -> Parser Query
APT.string Query
"wrote "
      Int
a <- Parser Int
forall a. Integral a => Parser a
APT.decimal
      Query
_ <- Query -> Parser Query
APT.string Query
" quads."
      Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
a