{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-typed-holes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_HADDOCK hide #-}

{-# HLINT ignore "Use newtype instead of data" #-}

module Database.Cozo.Internal (
  open',
  close',
  runQuery',
  importRelations',
  exportRelations',
  backup',
  restore',
  importFromBackup',
  Connection,
  InternalCozoError (..),
  CozoNullResultPtrException (..),
) where

import Control.Exception (Exception)
import Control.Monad ((<=<))
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Coerce (coerce)
import Database.Cozo.Internal.Bindings (
  cozoBackup,
  cozoCloseDB,
  cozoExportRelations,
  cozoFreeStr,
  cozoImportFromBackup,
  cozoImportRelations,
  cozoOpenDB,
  cozoRestore,
  cozoRunQuery,
 )
import Foreign (
  Ptr,
  Storable (peek),
  fromBool,
  maybePeek,
  new,
  toBool,
 )
import Foreign.C.Types (CChar, CInt)
import GHC.Generics (Generic)

newtype Connection = Connection (Ptr CInt)

{- |
Wrapper around primitive failure states.
-}
newtype InternalCozoError
  = InternalCozoError ByteString
  deriving (Int -> InternalCozoError -> ShowS
[InternalCozoError] -> ShowS
InternalCozoError -> String
(Int -> InternalCozoError -> ShowS)
-> (InternalCozoError -> String)
-> ([InternalCozoError] -> ShowS)
-> Show InternalCozoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalCozoError -> ShowS
showsPrec :: Int -> InternalCozoError -> ShowS
$cshow :: InternalCozoError -> String
show :: InternalCozoError -> String
$cshowList :: [InternalCozoError] -> ShowS
showList :: [InternalCozoError] -> ShowS
Show, InternalCozoError -> InternalCozoError -> Bool
(InternalCozoError -> InternalCozoError -> Bool)
-> (InternalCozoError -> InternalCozoError -> Bool)
-> Eq InternalCozoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalCozoError -> InternalCozoError -> Bool
== :: InternalCozoError -> InternalCozoError -> Bool
$c/= :: InternalCozoError -> InternalCozoError -> Bool
/= :: InternalCozoError -> InternalCozoError -> Bool
Eq, (forall x. InternalCozoError -> Rep InternalCozoError x)
-> (forall x. Rep InternalCozoError x -> InternalCozoError)
-> Generic InternalCozoError
forall x. Rep InternalCozoError x -> InternalCozoError
forall x. InternalCozoError -> Rep InternalCozoError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InternalCozoError -> Rep InternalCozoError x
from :: forall x. InternalCozoError -> Rep InternalCozoError x
$cto :: forall x. Rep InternalCozoError x -> InternalCozoError
to :: forall x. Rep InternalCozoError x -> InternalCozoError
Generic)

instance Exception InternalCozoError

data CozoNullResultPtrException = CozoNullResultPtrException deriving (Int -> CozoNullResultPtrException -> ShowS
[CozoNullResultPtrException] -> ShowS
CozoNullResultPtrException -> String
(Int -> CozoNullResultPtrException -> ShowS)
-> (CozoNullResultPtrException -> String)
-> ([CozoNullResultPtrException] -> ShowS)
-> Show CozoNullResultPtrException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoNullResultPtrException -> ShowS
showsPrec :: Int -> CozoNullResultPtrException -> ShowS
$cshow :: CozoNullResultPtrException -> String
show :: CozoNullResultPtrException -> String
$cshowList :: [CozoNullResultPtrException] -> ShowS
showList :: [CozoNullResultPtrException] -> ShowS
Show, CozoNullResultPtrException -> CozoNullResultPtrException -> Bool
(CozoNullResultPtrException -> CozoNullResultPtrException -> Bool)
-> (CozoNullResultPtrException
    -> CozoNullResultPtrException -> Bool)
-> Eq CozoNullResultPtrException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoNullResultPtrException -> CozoNullResultPtrException -> Bool
== :: CozoNullResultPtrException -> CozoNullResultPtrException -> Bool
$c/= :: CozoNullResultPtrException -> CozoNullResultPtrException -> Bool
/= :: CozoNullResultPtrException -> CozoNullResultPtrException -> Bool
Eq, (forall x.
 CozoNullResultPtrException -> Rep CozoNullResultPtrException x)
-> (forall x.
    Rep CozoNullResultPtrException x -> CozoNullResultPtrException)
-> Generic CozoNullResultPtrException
forall x.
Rep CozoNullResultPtrException x -> CozoNullResultPtrException
forall x.
CozoNullResultPtrException -> Rep CozoNullResultPtrException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CozoNullResultPtrException -> Rep CozoNullResultPtrException x
from :: forall x.
CozoNullResultPtrException -> Rep CozoNullResultPtrException x
$cto :: forall x.
Rep CozoNullResultPtrException x -> CozoNullResultPtrException
to :: forall x.
Rep CozoNullResultPtrException x -> CozoNullResultPtrException
Generic)

instance Exception CozoNullResultPtrException

{- |
Open a connection to a cozo database

- engine: \"mem\", \"sqlite\" or \"rocksdb\"
- path: utf8 encoded filepath
- options: engine-specific options. \"{}\" is an acceptable empty value.
-}
open' ::
  -- | engine: \"mem\", \"sqlite\" or \"rocksdb\"
  ByteString ->
  -- | path: utf8 encoded filepath
  ByteString ->
  -- | options: engine-specific options. \"{}\" is an acceptable emtpy value.
  ByteString ->
  IO (Either InternalCozoError Connection)
open' :: ByteString
-> ByteString
-> ByteString
-> IO (Either InternalCozoError Connection)
open' ByteString
engineBs ByteString
pathBs ByteString
optionBs =
  ByteString
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
engineBs ((CString -> IO (Either InternalCozoError Connection))
 -> IO (Either InternalCozoError Connection))
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a b. (a -> b) -> a -> b
$ \CString
engine ->
    ByteString
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
pathBs ((CString -> IO (Either InternalCozoError Connection))
 -> IO (Either InternalCozoError Connection))
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a b. (a -> b) -> a -> b
$ \CString
path ->
      ByteString
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
optionBs ((CString -> IO (Either InternalCozoError Connection))
 -> IO (Either InternalCozoError Connection))
-> (CString -> IO (Either InternalCozoError Connection))
-> IO (Either InternalCozoError Connection)
forall a b. (a -> b) -> a -> b
$ \CString
options -> do
        Ptr CInt
intPtr <- forall a. Storable a => a -> IO (Ptr a)
new @CInt CInt
0
        CString
openMessagePtr <- CString -> CString -> CString -> Ptr CInt -> IO CString
cozoOpenDB CString
engine CString
path CString
options Ptr CInt
intPtr
        !Maybe ByteString
mOpenMessage <- (CString -> IO ByteString) -> CString -> IO (Maybe ByteString)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO ByteString
B.packCString CString
openMessagePtr
        IO (Either InternalCozoError Connection)
-> (ByteString -> IO (Either InternalCozoError Connection))
-> Maybe ByteString
-> IO (Either InternalCozoError Connection)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Either InternalCozoError Connection
-> IO (Either InternalCozoError Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either InternalCozoError Connection
 -> IO (Either InternalCozoError Connection))
-> (Ptr CInt -> Either InternalCozoError Connection)
-> Ptr CInt
-> IO (Either InternalCozoError Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Either InternalCozoError Connection
forall a b. b -> Either a b
Right (Connection -> Either InternalCozoError Connection)
-> (Ptr CInt -> Connection)
-> Ptr CInt
-> Either InternalCozoError Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CInt -> Connection
Connection (Ptr CInt -> IO (Either InternalCozoError Connection))
-> Ptr CInt -> IO (Either InternalCozoError Connection)
forall a b. (a -> b) -> a -> b
$ Ptr CInt
intPtr)
          (\ByteString
errStr -> (InternalCozoError -> Either InternalCozoError Connection
forall a b. a -> Either a b
Left (InternalCozoError -> Either InternalCozoError Connection)
-> (ByteString -> InternalCozoError)
-> ByteString
-> Either InternalCozoError Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalCozoError
InternalCozoError (ByteString -> Either InternalCozoError Connection)
-> ByteString -> Either InternalCozoError Connection
forall a b. (a -> b) -> a -> b
$ ByteString
errStr) Either InternalCozoError Connection
-> IO () -> IO (Either InternalCozoError Connection)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CString -> IO ()
cozoFreeStr CString
openMessagePtr)
          Maybe ByteString
mOpenMessage

{- |
True if the database was closed and False if it was already closed or if it
does not exist.
-}
close' :: Connection -> IO Bool
close' :: Connection -> IO Bool
close' = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool) -> (CInt -> IO CBool) -> CInt -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO CBool
cozoCloseDB (CInt -> IO Bool)
-> (Connection -> IO CInt) -> Connection -> IO Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CInt -> IO CInt)
-> (Connection -> Ptr CInt) -> Connection -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Ptr CInt
forall a b. Coercible a b => a -> b
coerce

{- |
Run a query.

The `CozoError` that might arise from this function is a `CozoNullResultPtr`.
If there are any errors internal to cozo, those will be returned as part of the
JSON string returned in the Right value. Simple returning a Right value does not
mean the query was successful.

- script: utf8 encoded script to execute
- params_raw: a utf8 encoded, JSON formatted map of parameters for use in the script.
-}
runQuery' ::
  Connection ->
  ByteString ->
  ByteString ->
  IO (Either CozoNullResultPtrException ByteString)
runQuery' :: Connection
-> ByteString
-> ByteString
-> IO (Either CozoNullResultPtrException ByteString)
runQuery' Connection
c ByteString
q ByteString
p =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
q ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
q' ->
    ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
p ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
p' ->
      (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (\CInt
i -> CInt -> CString -> CString -> CBool -> IO CString
cozoRunQuery CInt
i CString
q' CString
p' (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
False)) Connection
c

{- |
Import data in relations.

Triggers are not run for relations, if you wish to activate triggers, use a query
  with parameters.

The given bytestring is a utf8, JSON formatted payload of relations.
In the same form as that given by `exportRelations'`
-}
importRelations' ::
  Connection ->
  ByteString ->
  IO (Either CozoNullResultPtrException ByteString)
importRelations' :: Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
importRelations' Connection
c ByteString
payloadBs =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
payloadBs ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
payload ->
    (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (CInt -> CString -> IO CString
`cozoImportRelations` CString
payload) Connection
c

{- |
Export relations into JSON

The given bytestring must be a utf8 encoded JSON payload. See the manual for expected
fields.
-}
exportRelations' ::
  Connection ->
  ByteString ->
  IO (Either CozoNullResultPtrException ByteString)
exportRelations' :: Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
exportRelations' Connection
c ByteString
payloadBs =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
payloadBs ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
payload ->
    (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (CInt -> CString -> IO CString
`cozoExportRelations` CString
payload) Connection
c

{- |
Backup a database.

Accepts the path of the output file.
-}
backup' :: Connection -> ByteString -> IO (Either CozoNullResultPtrException ByteString)
backup' :: Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
backup' Connection
c ByteString
pathBs =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
pathBs ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
path ->
    (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (CInt -> CString -> IO CString
`cozoBackup` CString
path) Connection
c

{- |
Restore a database from a backup.
-}
restore' :: Connection -> ByteString -> IO (Either CozoNullResultPtrException ByteString)
restore' :: Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
restore' Connection
c ByteString
pathBs =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
pathBs ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
path ->
    (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (CInt -> CString -> IO CString
`cozoRestore` CString
path) Connection
c

{- |
Import relations from a backup.

Note that triggers are not run for the relations.
To run triggers, use a query with parameters.

- payload: @"{'path': ..., 'relations': [...]}"@
-}
importFromBackup' ::
  Connection ->
  ByteString ->
  IO (Either CozoNullResultPtrException ByteString)
importFromBackup' :: Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
importFromBackup' Connection
c ByteString
payloadBs =
  ByteString
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
payloadBs ((CString -> IO (Either CozoNullResultPtrException ByteString))
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CString -> IO (Either CozoNullResultPtrException ByteString))
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
payload ->
    (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn (CInt -> CString -> IO CString
`cozoImportFromBackup` CString
payload) Connection
c

{- |
Helper function for using cozo bindings that do an action and return a
string that needs to be freed.
-}
cozoCharPtrFn ::
  (CInt -> IO (Ptr CChar)) ->
  Connection ->
  IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn :: (CInt -> IO CString)
-> Connection -> IO (Either CozoNullResultPtrException ByteString)
cozoCharPtrFn CInt -> IO CString
a (Connection Ptr CInt
intPtr) = do
  CInt
dbId <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intPtr
  CString
rPtr <- CInt -> IO CString
a CInt
dbId
  !Maybe ByteString
mR <- (CString -> IO ByteString) -> CString -> IO (Maybe ByteString)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO ByteString
B.packCString CString
rPtr
  case Maybe ByteString
mR of
    Maybe ByteString
Nothing -> Either CozoNullResultPtrException ByteString
-> IO (Either CozoNullResultPtrException ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CozoNullResultPtrException ByteString
 -> IO (Either CozoNullResultPtrException ByteString))
-> (CozoNullResultPtrException
    -> Either CozoNullResultPtrException ByteString)
-> CozoNullResultPtrException
-> IO (Either CozoNullResultPtrException ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CozoNullResultPtrException
-> Either CozoNullResultPtrException ByteString
forall a b. a -> Either a b
Left (CozoNullResultPtrException
 -> IO (Either CozoNullResultPtrException ByteString))
-> CozoNullResultPtrException
-> IO (Either CozoNullResultPtrException ByteString)
forall a b. (a -> b) -> a -> b
$ CozoNullResultPtrException
CozoNullResultPtrException
    Just ByteString
r -> ByteString -> Either CozoNullResultPtrException ByteString
forall a b. b -> Either a b
Right ByteString
r Either CozoNullResultPtrException ByteString
-> IO () -> IO (Either CozoNullResultPtrException ByteString)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CString -> IO ()
cozoFreeStr CString
rPtr