{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.Cayley.Client (
Quad (..)
, defaultCayleyConfig
, connectCayley
, query
, Shape
, queryShape
, write
, writeQuad
, writeQuads
, writeNQuadFile
, delete
, deleteQuad
, deleteQuads
, 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
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 }
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"
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"
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 :: 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]
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 :: 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]
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)
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)
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))]
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]
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
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