{-# HLINT ignore "Use const" #-}
{-# HLINT ignore "Eta reduce" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-typed-holes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{- |
Module      : Database.Cozo
Description : Wrappers and types for the Cozo C API
License     : MPL-2.0
Maintainer  : hencutJohnson@gmail.com

Included are some wrapping functions for Cozo's C API and data types to deserialize them.
-}
module Database.Cozo (
  -- * Data
  CozoResult (..),
  CozoOkay (..),
  NamedRows (..),
  CozoBad (..),
  CozoRelationExportPayload (..),
  CozoException (..),

  -- * Functions
  open,
  close,
  runQuery,
  backup,
  restore,
  importRelations,
  exportRelations,
  importFromBackup,

  -- ** Lower Level Wrappers
  open',
  close',
  runQuery',
  backup',
  restore',
  importRelations',
  exportRelations',
  importFromBackup',

  -- * Re-exports
  Connection,
  CozoNullResultPtrException,
  Database.Cozo.Internal.InternalCozoError,
  Key,
  KeyMap,
  KM.empty,
  KM.singleton,
  KM.insert,
  KM.fromList,
  Value (..),
) where

import Control.Exception (Exception)
import Data.Aeson (
  FromJSON (parseJSON),
  Options (fieldLabelModifier),
  ToJSON (..),
  Value (..),
  defaultOptions,
  eitherDecodeStrict,
  fromEncoding,
  genericParseJSON,
  genericToEncoding,
  genericToJSON,
  withObject,
  (.:),
 )
import Data.Aeson.KeyMap (Key, KeyMap)
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types (Encoding, Parser)
import Data.Bifunctor (Bifunctor (bimap, first))
import Data.ByteString (ByteString, toStrict)
import Data.ByteString.Builder (toLazyByteString)
import Data.Char (toLower)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Database.Cozo.Internal (
  Connection,
  CozoNullResultPtrException,
  InternalCozoError,
  backup',
  close',
  exportRelations',
  importFromBackup',
  importRelations',
  open',
  restore',
  runQuery',
 )
import GHC.Generics (Generic)

{- |
Relation information with headers, their values, and another `NamedRows` if
it exists.
-}
data NamedRows = NamedRows
  { NamedRows -> [Text]
namedRowsHeaders :: [Text]
  , NamedRows -> [[Value]]
namedRowsRows :: [[Value]]
  , NamedRows -> Maybe NamedRows
namedRowsNext :: Maybe NamedRows
  }
  deriving (Int -> NamedRows -> ShowS
[NamedRows] -> ShowS
NamedRows -> String
(Int -> NamedRows -> ShowS)
-> (NamedRows -> String)
-> ([NamedRows] -> ShowS)
-> Show NamedRows
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedRows -> ShowS
showsPrec :: Int -> NamedRows -> ShowS
$cshow :: NamedRows -> String
show :: NamedRows -> String
$cshowList :: [NamedRows] -> ShowS
showList :: [NamedRows] -> ShowS
Show, NamedRows -> NamedRows -> Bool
(NamedRows -> NamedRows -> Bool)
-> (NamedRows -> NamedRows -> Bool) -> Eq NamedRows
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedRows -> NamedRows -> Bool
== :: NamedRows -> NamedRows -> Bool
$c/= :: NamedRows -> NamedRows -> Bool
/= :: NamedRows -> NamedRows -> Bool
Eq, (forall x. NamedRows -> Rep NamedRows x)
-> (forall x. Rep NamedRows x -> NamedRows) -> Generic NamedRows
forall x. Rep NamedRows x -> NamedRows
forall x. NamedRows -> Rep NamedRows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedRows -> Rep NamedRows x
from :: forall x. NamedRows -> Rep NamedRows x
$cto :: forall x. Rep NamedRows x -> NamedRows
to :: forall x. Rep NamedRows x -> NamedRows
Generic)

instance FromJSON NamedRows where
  parseJSON :: Value -> Parser NamedRows
  parseJSON :: Value -> Parser NamedRows
parseJSON =
    Options -> Value -> Parser NamedRows
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
9 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

instance ToJSON NamedRows where
  toJSON :: NamedRows -> Value
  toJSON :: NamedRows -> Value
toJSON =
    Options -> NamedRows -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
9 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )
  toEncoding :: NamedRows -> Encoding
  toEncoding :: NamedRows -> Encoding
toEncoding =
    Options -> NamedRows -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
9 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

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

instance FromJSON ConstJSON where
  parseJSON :: Value -> Parser ConstJSON
  parseJSON :: Value -> Parser ConstJSON
parseJSON Value
_ = ConstJSON -> Parser ConstJSON
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstJSON
ConstJSON

{- |
A failure that cannot be recovered from easily.
-}
data CozoException
  = -- | An internal error may occur when a connection is first being established
    -- but not after that.
    CozoExceptionInternal InternalCozoError
  | -- | If any operation in the underlying C API returns a null pointer instead
    -- of a pointer to a valid string, this error will be returned.
    CozoErrorNullPtr CozoNullResultPtrException
  | -- | The result of any operation fails to be deserialized appropriately.
    -- This is a problem with the wrapper for the API and should be
    -- submitted as an issue if it ever arises.
    CozoJSONParseException String
  | -- | A non-query operation such as a backup or import failed.
    -- These usually occur because the user is trying to import or export a
    -- relation that does not exist in the target database.
    CozoOperationFailed Text
  deriving (Int -> CozoException -> ShowS
[CozoException] -> ShowS
CozoException -> String
(Int -> CozoException -> ShowS)
-> (CozoException -> String)
-> ([CozoException] -> ShowS)
-> Show CozoException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoException -> ShowS
showsPrec :: Int -> CozoException -> ShowS
$cshow :: CozoException -> String
show :: CozoException -> String
$cshowList :: [CozoException] -> ShowS
showList :: [CozoException] -> ShowS
Show, CozoException -> CozoException -> Bool
(CozoException -> CozoException -> Bool)
-> (CozoException -> CozoException -> Bool) -> Eq CozoException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoException -> CozoException -> Bool
== :: CozoException -> CozoException -> Bool
$c/= :: CozoException -> CozoException -> Bool
/= :: CozoException -> CozoException -> Bool
Eq, (forall x. CozoException -> Rep CozoException x)
-> (forall x. Rep CozoException x -> CozoException)
-> Generic CozoException
forall x. Rep CozoException x -> CozoException
forall x. CozoException -> Rep CozoException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CozoException -> Rep CozoException x
from :: forall x. CozoException -> Rep CozoException x
$cto :: forall x. Rep CozoException x -> CozoException
to :: forall x. Rep CozoException x -> CozoException
Generic)

instance Exception CozoException

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

instance FromJSON CozoMessage where
  parseJSON :: Value -> Parser CozoMessage
  parseJSON :: Value -> Parser CozoMessage
parseJSON =
    Options -> Value -> Parser CozoMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
7 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

cozoMessageToException :: CozoMessage -> CozoException
cozoMessageToException :: CozoMessage -> CozoException
cozoMessageToException (CozoMessage Text
m) = Text -> CozoException
CozoOperationFailed Text
m

{- |
A map of names and the relations they contain.
This type is intended to be used as input to an import function
or otherwise stored as JSON.
-}
newtype CozoRelationExportPayload = CozoRelationExportPayload
  { CozoRelationExportPayload -> KeyMap NamedRows
cozoRelationExportPayloadData :: KeyMap NamedRows
  }
  deriving (Int -> CozoRelationExportPayload -> ShowS
[CozoRelationExportPayload] -> ShowS
CozoRelationExportPayload -> String
(Int -> CozoRelationExportPayload -> ShowS)
-> (CozoRelationExportPayload -> String)
-> ([CozoRelationExportPayload] -> ShowS)
-> Show CozoRelationExportPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoRelationExportPayload -> ShowS
showsPrec :: Int -> CozoRelationExportPayload -> ShowS
$cshow :: CozoRelationExportPayload -> String
show :: CozoRelationExportPayload -> String
$cshowList :: [CozoRelationExportPayload] -> ShowS
showList :: [CozoRelationExportPayload] -> ShowS
Show, CozoRelationExportPayload -> CozoRelationExportPayload -> Bool
(CozoRelationExportPayload -> CozoRelationExportPayload -> Bool)
-> (CozoRelationExportPayload -> CozoRelationExportPayload -> Bool)
-> Eq CozoRelationExportPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoRelationExportPayload -> CozoRelationExportPayload -> Bool
== :: CozoRelationExportPayload -> CozoRelationExportPayload -> Bool
$c/= :: CozoRelationExportPayload -> CozoRelationExportPayload -> Bool
/= :: CozoRelationExportPayload -> CozoRelationExportPayload -> Bool
Eq, (forall x.
 CozoRelationExportPayload -> Rep CozoRelationExportPayload x)
-> (forall x.
    Rep CozoRelationExportPayload x -> CozoRelationExportPayload)
-> Generic CozoRelationExportPayload
forall x.
Rep CozoRelationExportPayload x -> CozoRelationExportPayload
forall x.
CozoRelationExportPayload -> Rep CozoRelationExportPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CozoRelationExportPayload -> Rep CozoRelationExportPayload x
from :: forall x.
CozoRelationExportPayload -> Rep CozoRelationExportPayload x
$cto :: forall x.
Rep CozoRelationExportPayload x -> CozoRelationExportPayload
to :: forall x.
Rep CozoRelationExportPayload x -> CozoRelationExportPayload
Generic)

instance FromJSON CozoRelationExportPayload where
  parseJSON :: Value -> Parser CozoRelationExportPayload
  parseJSON :: Value -> Parser CozoRelationExportPayload
parseJSON =
    Options -> Value -> Parser CozoRelationExportPayload
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
25 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

{- |
An intermediate type for decoding structures that return an object with a 'message' field
when the 'ok' field is false.
-}
newtype IntermediateCozoMessageOnNotOK a = IntermediateCozoMessageOnNotOK
  { forall a. IntermediateCozoMessageOnNotOK a -> Either CozoMessage a
runIntermediateCozoMessageOnNotOK :: Either CozoMessage a
  }
  deriving (Int -> IntermediateCozoMessageOnNotOK a -> ShowS
[IntermediateCozoMessageOnNotOK a] -> ShowS
IntermediateCozoMessageOnNotOK a -> String
(Int -> IntermediateCozoMessageOnNotOK a -> ShowS)
-> (IntermediateCozoMessageOnNotOK a -> String)
-> ([IntermediateCozoMessageOnNotOK a] -> ShowS)
-> Show (IntermediateCozoMessageOnNotOK a)
forall a.
Show a =>
Int -> IntermediateCozoMessageOnNotOK a -> ShowS
forall a. Show a => [IntermediateCozoMessageOnNotOK a] -> ShowS
forall a. Show a => IntermediateCozoMessageOnNotOK a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a.
Show a =>
Int -> IntermediateCozoMessageOnNotOK a -> ShowS
showsPrec :: Int -> IntermediateCozoMessageOnNotOK a -> ShowS
$cshow :: forall a. Show a => IntermediateCozoMessageOnNotOK a -> String
show :: IntermediateCozoMessageOnNotOK a -> String
$cshowList :: forall a. Show a => [IntermediateCozoMessageOnNotOK a] -> ShowS
showList :: [IntermediateCozoMessageOnNotOK a] -> ShowS
Show, IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
(IntermediateCozoMessageOnNotOK a
 -> IntermediateCozoMessageOnNotOK a -> Bool)
-> (IntermediateCozoMessageOnNotOK a
    -> IntermediateCozoMessageOnNotOK a -> Bool)
-> Eq (IntermediateCozoMessageOnNotOK a)
forall a.
Eq a =>
IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
== :: IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
$c/= :: forall a.
Eq a =>
IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
/= :: IntermediateCozoMessageOnNotOK a
-> IntermediateCozoMessageOnNotOK a -> Bool
Eq, (forall x.
 IntermediateCozoMessageOnNotOK a
 -> Rep (IntermediateCozoMessageOnNotOK a) x)
-> (forall x.
    Rep (IntermediateCozoMessageOnNotOK a) x
    -> IntermediateCozoMessageOnNotOK a)
-> Generic (IntermediateCozoMessageOnNotOK a)
forall x.
Rep (IntermediateCozoMessageOnNotOK a) x
-> IntermediateCozoMessageOnNotOK a
forall x.
IntermediateCozoMessageOnNotOK a
-> Rep (IntermediateCozoMessageOnNotOK a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (IntermediateCozoMessageOnNotOK a) x
-> IntermediateCozoMessageOnNotOK a
forall a x.
IntermediateCozoMessageOnNotOK a
-> Rep (IntermediateCozoMessageOnNotOK a) x
$cfrom :: forall a x.
IntermediateCozoMessageOnNotOK a
-> Rep (IntermediateCozoMessageOnNotOK a) x
from :: forall x.
IntermediateCozoMessageOnNotOK a
-> Rep (IntermediateCozoMessageOnNotOK a) x
$cto :: forall a x.
Rep (IntermediateCozoMessageOnNotOK a) x
-> IntermediateCozoMessageOnNotOK a
to :: forall x.
Rep (IntermediateCozoMessageOnNotOK a) x
-> IntermediateCozoMessageOnNotOK a
Generic)

instance (FromJSON a) => FromJSON (IntermediateCozoMessageOnNotOK a) where
  parseJSON :: Value -> Parser (IntermediateCozoMessageOnNotOK a)
  parseJSON :: Value -> Parser (IntermediateCozoMessageOnNotOK a)
parseJSON =
    String
-> (Value -> Parser (IntermediateCozoMessageOnNotOK a))
-> (Value -> Parser (IntermediateCozoMessageOnNotOK a))
-> Value
-> Parser (IntermediateCozoMessageOnNotOK a)
forall a.
String
-> (Value -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
eitherOkay
      String
"IntermediateCozoRelationExport"
      ((CozoMessage -> IntermediateCozoMessageOnNotOK a)
-> Parser CozoMessage -> Parser (IntermediateCozoMessageOnNotOK a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either CozoMessage a -> IntermediateCozoMessageOnNotOK a
forall a. Either CozoMessage a -> IntermediateCozoMessageOnNotOK a
IntermediateCozoMessageOnNotOK (Either CozoMessage a -> IntermediateCozoMessageOnNotOK a)
-> (CozoMessage -> Either CozoMessage a)
-> CozoMessage
-> IntermediateCozoMessageOnNotOK a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CozoMessage -> Either CozoMessage a
forall a b. a -> Either a b
Left) (Parser CozoMessage -> Parser (IntermediateCozoMessageOnNotOK a))
-> (Value -> Parser CozoMessage)
-> Value
-> Parser (IntermediateCozoMessageOnNotOK a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser CozoMessage
forall a. FromJSON a => Value -> Parser a
parseJSON)
      ((a -> IntermediateCozoMessageOnNotOK a)
-> Parser a -> Parser (IntermediateCozoMessageOnNotOK a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either CozoMessage a -> IntermediateCozoMessageOnNotOK a
forall a. Either CozoMessage a -> IntermediateCozoMessageOnNotOK a
IntermediateCozoMessageOnNotOK (Either CozoMessage a -> IntermediateCozoMessageOnNotOK a)
-> (a -> Either CozoMessage a)
-> a
-> IntermediateCozoMessageOnNotOK a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either CozoMessage a
forall a b. b -> Either a b
Right) (Parser a -> Parser (IntermediateCozoMessageOnNotOK a))
-> (Value -> Parser a)
-> Value
-> Parser (IntermediateCozoMessageOnNotOK a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)

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

instance ToJSON IntermediateCozoImportFromRelationInput where
  toJSON :: IntermediateCozoImportFromRelationInput -> Value
  toJSON :: IntermediateCozoImportFromRelationInput -> Value
toJSON =
    Options -> IntermediateCozoImportFromRelationInput -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
39 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )
  toEncoding :: IntermediateCozoImportFromRelationInput -> Encoding
  toEncoding :: IntermediateCozoImportFromRelationInput -> Encoding
toEncoding =
    Options -> IntermediateCozoImportFromRelationInput -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
39 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

{- |
An intermediate type for packing a list of named relations into an object with the form
\"{'relations': [...]}\"
-}
newtype IntermediateCozoRelationInput = IntermediateCozoRelationInput
  { IntermediateCozoRelationInput -> [Text]
intermediateCozoRelationInputRelations :: [Text]
  }
  deriving (Int -> IntermediateCozoRelationInput -> ShowS
[IntermediateCozoRelationInput] -> ShowS
IntermediateCozoRelationInput -> String
(Int -> IntermediateCozoRelationInput -> ShowS)
-> (IntermediateCozoRelationInput -> String)
-> ([IntermediateCozoRelationInput] -> ShowS)
-> Show IntermediateCozoRelationInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntermediateCozoRelationInput -> ShowS
showsPrec :: Int -> IntermediateCozoRelationInput -> ShowS
$cshow :: IntermediateCozoRelationInput -> String
show :: IntermediateCozoRelationInput -> String
$cshowList :: [IntermediateCozoRelationInput] -> ShowS
showList :: [IntermediateCozoRelationInput] -> ShowS
Show, IntermediateCozoRelationInput
-> IntermediateCozoRelationInput -> Bool
(IntermediateCozoRelationInput
 -> IntermediateCozoRelationInput -> Bool)
-> (IntermediateCozoRelationInput
    -> IntermediateCozoRelationInput -> Bool)
-> Eq IntermediateCozoRelationInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntermediateCozoRelationInput
-> IntermediateCozoRelationInput -> Bool
== :: IntermediateCozoRelationInput
-> IntermediateCozoRelationInput -> Bool
$c/= :: IntermediateCozoRelationInput
-> IntermediateCozoRelationInput -> Bool
/= :: IntermediateCozoRelationInput
-> IntermediateCozoRelationInput -> Bool
Eq, (forall x.
 IntermediateCozoRelationInput
 -> Rep IntermediateCozoRelationInput x)
-> (forall x.
    Rep IntermediateCozoRelationInput x
    -> IntermediateCozoRelationInput)
-> Generic IntermediateCozoRelationInput
forall x.
Rep IntermediateCozoRelationInput x
-> IntermediateCozoRelationInput
forall x.
IntermediateCozoRelationInput
-> Rep IntermediateCozoRelationInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
IntermediateCozoRelationInput
-> Rep IntermediateCozoRelationInput x
from :: forall x.
IntermediateCozoRelationInput
-> Rep IntermediateCozoRelationInput x
$cto :: forall x.
Rep IntermediateCozoRelationInput x
-> IntermediateCozoRelationInput
to :: forall x.
Rep IntermediateCozoRelationInput x
-> IntermediateCozoRelationInput
Generic)

instance ToJSON IntermediateCozoRelationInput where
  toJSON :: IntermediateCozoRelationInput -> Value
  toJSON :: IntermediateCozoRelationInput -> Value
toJSON =
    Options -> IntermediateCozoRelationInput -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
29 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )
  toEncoding ::
    IntermediateCozoRelationInput ->
    Encoding
  toEncoding :: IntermediateCozoRelationInput -> Encoding
toEncoding =
    Options -> IntermediateCozoRelationInput -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
29 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

{- |
An okay result from a query.

Contains result headers, and rows among other things.
-}
data CozoOkay = CozoOkay
  { CozoOkay -> NamedRows
cozoOkayNamedRows :: NamedRows
  , CozoOkay -> Double
cozoOkayTook :: Double
  }
  deriving (Int -> CozoOkay -> ShowS
[CozoOkay] -> ShowS
CozoOkay -> String
(Int -> CozoOkay -> ShowS)
-> (CozoOkay -> String) -> ([CozoOkay] -> ShowS) -> Show CozoOkay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoOkay -> ShowS
showsPrec :: Int -> CozoOkay -> ShowS
$cshow :: CozoOkay -> String
show :: CozoOkay -> String
$cshowList :: [CozoOkay] -> ShowS
showList :: [CozoOkay] -> ShowS
Show, CozoOkay -> CozoOkay -> Bool
(CozoOkay -> CozoOkay -> Bool)
-> (CozoOkay -> CozoOkay -> Bool) -> Eq CozoOkay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoOkay -> CozoOkay -> Bool
== :: CozoOkay -> CozoOkay -> Bool
$c/= :: CozoOkay -> CozoOkay -> Bool
/= :: CozoOkay -> CozoOkay -> Bool
Eq, (forall x. CozoOkay -> Rep CozoOkay x)
-> (forall x. Rep CozoOkay x -> CozoOkay) -> Generic CozoOkay
forall x. Rep CozoOkay x -> CozoOkay
forall x. CozoOkay -> Rep CozoOkay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CozoOkay -> Rep CozoOkay x
from :: forall x. CozoOkay -> Rep CozoOkay x
$cto :: forall x. Rep CozoOkay x -> CozoOkay
to :: forall x. Rep CozoOkay x -> CozoOkay
Generic)

instance FromJSON CozoOkay where
  parseJSON :: Value -> Parser CozoOkay
  parseJSON :: Value -> Parser CozoOkay
parseJSON =
    String
-> (KeyMap Value -> Parser CozoOkay) -> Value -> Parser CozoOkay
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"CozoOkay" ((KeyMap Value -> Parser CozoOkay) -> Value -> Parser CozoOkay)
-> (KeyMap Value -> Parser CozoOkay) -> Value -> Parser CozoOkay
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o ->
      NamedRows -> Double -> CozoOkay
CozoOkay
        (NamedRows -> Double -> CozoOkay)
-> Parser NamedRows -> Parser (Double -> CozoOkay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NamedRows
forall a. FromJSON a => Value -> Parser a
parseJSON (KeyMap Value -> Value
Object KeyMap Value
o)
        Parser (Double -> CozoOkay) -> Parser Double -> Parser CozoOkay
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o
        KeyMap Value -> Key -> Parser Double
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"took"

{- |
A bad result from a query.

Contains information on what went wrong.
-}
data CozoBad = CozoBad
  { CozoBad -> Maybe Text
cozoBadDisplay :: Maybe Text
  , CozoBad -> Text
cozoBadMessage :: Text
  , CozoBad -> Maybe Text
cozoBadSeverity :: Maybe Text
  }
  deriving (Int -> CozoBad -> ShowS
[CozoBad] -> ShowS
CozoBad -> String
(Int -> CozoBad -> ShowS)
-> (CozoBad -> String) -> ([CozoBad] -> ShowS) -> Show CozoBad
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoBad -> ShowS
showsPrec :: Int -> CozoBad -> ShowS
$cshow :: CozoBad -> String
show :: CozoBad -> String
$cshowList :: [CozoBad] -> ShowS
showList :: [CozoBad] -> ShowS
Show, CozoBad -> CozoBad -> Bool
(CozoBad -> CozoBad -> Bool)
-> (CozoBad -> CozoBad -> Bool) -> Eq CozoBad
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoBad -> CozoBad -> Bool
== :: CozoBad -> CozoBad -> Bool
$c/= :: CozoBad -> CozoBad -> Bool
/= :: CozoBad -> CozoBad -> Bool
Eq, (forall x. CozoBad -> Rep CozoBad x)
-> (forall x. Rep CozoBad x -> CozoBad) -> Generic CozoBad
forall x. Rep CozoBad x -> CozoBad
forall x. CozoBad -> Rep CozoBad x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CozoBad -> Rep CozoBad x
from :: forall x. CozoBad -> Rep CozoBad x
$cto :: forall x. Rep CozoBad x -> CozoBad
to :: forall x. Rep CozoBad x -> CozoBad
Generic)

instance FromJSON CozoBad where
  parseJSON :: Value -> Parser CozoBad
  parseJSON :: Value -> Parser CozoBad
parseJSON =
    Options -> Value -> Parser CozoBad
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier = \String
s ->
              case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
7 String
s of
                [] -> []
                Char
x : String
xs -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
          }
      )

newtype CozoResult = CozoResult {CozoResult -> Either CozoBad CozoOkay
runCozoResult :: Either CozoBad CozoOkay}
  deriving (Int -> CozoResult -> ShowS
[CozoResult] -> ShowS
CozoResult -> String
(Int -> CozoResult -> ShowS)
-> (CozoResult -> String)
-> ([CozoResult] -> ShowS)
-> Show CozoResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CozoResult -> ShowS
showsPrec :: Int -> CozoResult -> ShowS
$cshow :: CozoResult -> String
show :: CozoResult -> String
$cshowList :: [CozoResult] -> ShowS
showList :: [CozoResult] -> ShowS
Show, CozoResult -> CozoResult -> Bool
(CozoResult -> CozoResult -> Bool)
-> (CozoResult -> CozoResult -> Bool) -> Eq CozoResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CozoResult -> CozoResult -> Bool
== :: CozoResult -> CozoResult -> Bool
$c/= :: CozoResult -> CozoResult -> Bool
/= :: CozoResult -> CozoResult -> Bool
Eq, (forall x. CozoResult -> Rep CozoResult x)
-> (forall x. Rep CozoResult x -> CozoResult) -> Generic CozoResult
forall x. Rep CozoResult x -> CozoResult
forall x. CozoResult -> Rep CozoResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CozoResult -> Rep CozoResult x
from :: forall x. CozoResult -> Rep CozoResult x
$cto :: forall x. Rep CozoResult x -> CozoResult
to :: forall x. Rep CozoResult x -> CozoResult
Generic)

instance FromJSON CozoResult where
  parseJSON :: Value -> Parser CozoResult
  parseJSON :: Value -> Parser CozoResult
parseJSON =
    String
-> (Value -> Parser CozoResult)
-> (Value -> Parser CozoResult)
-> Value
-> Parser CozoResult
forall a.
String
-> (Value -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
eitherOkay
      String
"CozoResult"
      ((CozoBad -> CozoResult) -> Parser CozoBad -> Parser CozoResult
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either CozoBad CozoOkay -> CozoResult
CozoResult (Either CozoBad CozoOkay -> CozoResult)
-> (CozoBad -> Either CozoBad CozoOkay) -> CozoBad -> CozoResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CozoBad -> Either CozoBad CozoOkay
forall a b. a -> Either a b
Left) (Parser CozoBad -> Parser CozoResult)
-> (Value -> Parser CozoBad) -> Value -> Parser CozoResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser CozoBad
forall a. FromJSON a => Value -> Parser a
parseJSON)
      ((CozoOkay -> CozoResult) -> Parser CozoOkay -> Parser CozoResult
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either CozoBad CozoOkay -> CozoResult
CozoResult (Either CozoBad CozoOkay -> CozoResult)
-> (CozoOkay -> Either CozoBad CozoOkay) -> CozoOkay -> CozoResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CozoOkay -> Either CozoBad CozoOkay
forall a b. b -> Either a b
Right) (Parser CozoOkay -> Parser CozoResult)
-> (Value -> Parser CozoOkay) -> Value -> Parser CozoResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser CozoOkay
forall a. FromJSON a => Value -> Parser a
parseJSON)

{- |
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 :: Text -> Text -> Text -> IO (Either CozoException Connection)
open :: Text -> Text -> Text -> IO (Either CozoException Connection)
open Text
engine Text
path Text
options =
  (InternalCozoError -> CozoException)
-> Either InternalCozoError Connection
-> Either CozoException Connection
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first InternalCozoError -> CozoException
CozoExceptionInternal
    (Either InternalCozoError Connection
 -> Either CozoException Connection)
-> IO (Either InternalCozoError Connection)
-> IO (Either CozoException Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> ByteString
-> ByteString
-> IO (Either InternalCozoError Connection)
open'
      (Text -> ByteString
encodeUtf8 Text
engine)
      (Text -> ByteString
encodeUtf8 Text
path)
      (Text -> ByteString
encodeUtf8 Text
options)

{- |
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 = Connection -> IO Bool
close'

{- |
Run a utf8 encoded query with a map of parameters.

Parameters are declared with
text names and can be any valid JSON type. They are referenced in a query by a \"$\"
preceding their name.
-}
runQuery ::
  Connection ->
  Text ->
  KeyMap Value ->
  IO (Either CozoException CozoResult)
runQuery :: Connection
-> Text -> KeyMap Value -> IO (Either CozoException CozoResult)
runQuery Connection
c Text
query KeyMap Value
params = do
  Either CozoNullResultPtrException ByteString
r <-
    Connection
-> ByteString
-> ByteString
-> IO (Either CozoNullResultPtrException ByteString)
runQuery'
      Connection
c
      (Text -> ByteString
encodeUtf8 Text
query)
      ( ByteString -> ByteString
toStrict
          (ByteString -> ByteString)
-> (KeyMap Value -> ByteString) -> KeyMap Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
          (Builder -> ByteString)
-> (KeyMap Value -> Builder) -> KeyMap Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding
          (Encoding -> Builder)
-> (KeyMap Value -> Encoding) -> KeyMap Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
          (KeyMap Value -> ByteString) -> KeyMap Value -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyMap Value
params
      )
  Either CozoException CozoResult
-> IO (Either CozoException CozoResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CozoException CozoResult
 -> IO (Either CozoException CozoResult))
-> Either CozoException CozoResult
-> IO (Either CozoException CozoResult)
forall a b. (a -> b) -> a -> b
$ (CozoNullResultPtrException -> CozoException)
-> Either CozoNullResultPtrException ByteString
-> Either CozoException ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CozoNullResultPtrException -> CozoException
CozoErrorNullPtr Either CozoNullResultPtrException ByteString
r Either CozoException ByteString
-> (ByteString -> Either CozoException CozoResult)
-> Either CozoException CozoResult
forall a b.
Either CozoException a
-> (a -> Either CozoException b) -> Either CozoException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either CozoException CozoResult
forall a. FromJSON a => ByteString -> Either CozoException a
cozoDecode

{- |
Backup a database.

Accepts the path of the output file.
-}
backup :: Connection -> Text -> IO (Either CozoException ())
backup :: Connection -> Text -> IO (Either CozoException ())
backup Connection
c Text
path =
  Either CozoNullResultPtrException ByteString
-> Either CozoException ()
decodeCozoCharPtrFn
    (Either CozoNullResultPtrException ByteString
 -> Either CozoException ())
-> IO (Either CozoNullResultPtrException ByteString)
-> IO (Either CozoException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
backup' Connection
c (Text -> ByteString
encodeUtf8 Text
path)

{- |
Restore a database from a backup.
-}
restore :: Connection -> Text -> IO (Either CozoException ())
restore :: Connection -> Text -> IO (Either CozoException ())
restore Connection
c Text
path =
  Either CozoNullResultPtrException ByteString
-> Either CozoException ()
decodeCozoCharPtrFn
    (Either CozoNullResultPtrException ByteString
 -> Either CozoException ())
-> IO (Either CozoNullResultPtrException ByteString)
-> IO (Either CozoException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
restore' Connection
c (Text -> ByteString
encodeUtf8 Text
path)

{- |
Import data in relations.

Triggers are not run for relations, if you wish to activate triggers, use a query
  with parameters.
-}
importRelations ::
  Connection ->
  CozoRelationExportPayload ->
  IO (Either CozoException ())
importRelations :: Connection
-> CozoRelationExportPayload -> IO (Either CozoException ())
importRelations Connection
c (CozoRelationExportPayload KeyMap NamedRows
km) =
  Either CozoNullResultPtrException ByteString
-> Either CozoException ()
decodeCozoCharPtrFn
    (Either CozoNullResultPtrException ByteString
 -> Either CozoException ())
-> IO (Either CozoNullResultPtrException ByteString)
-> IO (Either CozoException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
importRelations' Connection
c (KeyMap NamedRows -> ByteString
forall a. ToJSON a => a -> ByteString
strictToEncoding KeyMap NamedRows
km)

{- |
Export the relations specified by the given names.
-}
exportRelations ::
  Connection ->
  [Text] ->
  IO (Either CozoException CozoRelationExportPayload)
exportRelations :: Connection
-> [Text] -> IO (Either CozoException CozoRelationExportPayload)
exportRelations Connection
c [Text]
bs = do
  Either CozoNullResultPtrException ByteString
r <-
    Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
exportRelations'
      Connection
c
      ( IntermediateCozoRelationInput -> ByteString
forall a. ToJSON a => a -> ByteString
strictToEncoding
          (IntermediateCozoRelationInput -> ByteString)
-> ([Text] -> IntermediateCozoRelationInput)
-> [Text]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> IntermediateCozoRelationInput
IntermediateCozoRelationInput
          ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text]
bs
      )
  Either CozoException CozoRelationExportPayload
-> IO (Either CozoException CozoRelationExportPayload)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either CozoException CozoRelationExportPayload
 -> IO (Either CozoException CozoRelationExportPayload))
-> Either CozoException CozoRelationExportPayload
-> IO (Either CozoException CozoRelationExportPayload)
forall a b. (a -> b) -> a -> b
$ (CozoNullResultPtrException -> CozoException)
-> Either CozoNullResultPtrException ByteString
-> Either CozoException ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CozoNullResultPtrException -> CozoException
CozoErrorNullPtr Either CozoNullResultPtrException ByteString
r
    Either CozoException ByteString
-> (ByteString
    -> Either
         CozoException
         (IntermediateCozoMessageOnNotOK CozoRelationExportPayload))
-> Either
     CozoException
     (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
forall a b.
Either CozoException a
-> (a -> Either CozoException b) -> Either CozoException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> CozoException)
-> Either
     String (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
-> Either
     CozoException
     (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> CozoException
CozoJSONParseException
    (Either
   String (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
 -> Either
      CozoException
      (IntermediateCozoMessageOnNotOK CozoRelationExportPayload))
-> (ByteString
    -> Either
         String (IntermediateCozoMessageOnNotOK CozoRelationExportPayload))
-> ByteString
-> Either
     CozoException
     (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict @(IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
    Either
  CozoException
  (IntermediateCozoMessageOnNotOK CozoRelationExportPayload)
-> (IntermediateCozoMessageOnNotOK CozoRelationExportPayload
    -> Either CozoException CozoRelationExportPayload)
-> Either CozoException CozoRelationExportPayload
forall a b.
Either CozoException a
-> (a -> Either CozoException b) -> Either CozoException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CozoMessage -> CozoException)
-> Either CozoMessage CozoRelationExportPayload
-> Either CozoException CozoRelationExportPayload
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CozoMessage -> CozoException
cozoMessageToException
    (Either CozoMessage CozoRelationExportPayload
 -> Either CozoException CozoRelationExportPayload)
-> (IntermediateCozoMessageOnNotOK CozoRelationExportPayload
    -> Either CozoMessage CozoRelationExportPayload)
-> IntermediateCozoMessageOnNotOK CozoRelationExportPayload
-> Either CozoException CozoRelationExportPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntermediateCozoMessageOnNotOK CozoRelationExportPayload
-> Either CozoMessage CozoRelationExportPayload
forall a. IntermediateCozoMessageOnNotOK a -> Either CozoMessage a
runIntermediateCozoMessageOnNotOK

{- |
Import the relations corresponding to the given names
from the specified path.
-}
importFromBackup :: Connection -> Text -> [Text] -> IO (Either CozoException ())
importFromBackup :: Connection -> Text -> [Text] -> IO (Either CozoException ())
importFromBackup Connection
c Text
path [Text]
relations =
  Either CozoNullResultPtrException ByteString
-> Either CozoException ()
decodeCozoCharPtrFn
    (Either CozoNullResultPtrException ByteString
 -> Either CozoException ())
-> IO (Either CozoNullResultPtrException ByteString)
-> IO (Either CozoException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString -> IO (Either CozoNullResultPtrException ByteString)
importFromBackup'
      Connection
c
      (IntermediateCozoImportFromRelationInput -> ByteString
forall a. ToJSON a => a -> ByteString
strictToEncoding (IntermediateCozoImportFromRelationInput -> ByteString)
-> IntermediateCozoImportFromRelationInput -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> IntermediateCozoImportFromRelationInput
IntermediateCozoImportFromRelationInput Text
path [Text]
relations)

decodeCozoCharPtrFn ::
  Either CozoNullResultPtrException ByteString ->
  Either CozoException ()
decodeCozoCharPtrFn :: Either CozoNullResultPtrException ByteString
-> Either CozoException ()
decodeCozoCharPtrFn Either CozoNullResultPtrException ByteString
e =
  (CozoNullResultPtrException -> CozoException)
-> Either CozoNullResultPtrException ByteString
-> Either CozoException ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CozoNullResultPtrException -> CozoException
CozoErrorNullPtr Either CozoNullResultPtrException ByteString
e
    Either CozoException ByteString
-> (ByteString
    -> Either CozoException (IntermediateCozoMessageOnNotOK ConstJSON))
-> Either CozoException (IntermediateCozoMessageOnNotOK ConstJSON)
forall a b.
Either CozoException a
-> (a -> Either CozoException b) -> Either CozoException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => ByteString -> Either CozoException a
cozoDecode @(IntermediateCozoMessageOnNotOK ConstJSON)
    Either CozoException (IntermediateCozoMessageOnNotOK ConstJSON)
-> (IntermediateCozoMessageOnNotOK ConstJSON
    -> Either CozoException ())
-> Either CozoException ()
forall a b.
Either CozoException a
-> (a -> Either CozoException b) -> Either CozoException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CozoMessage -> CozoException)
-> (ConstJSON -> ())
-> Either CozoMessage ConstJSON
-> Either CozoException ()
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CozoMessage -> CozoException
cozoMessageToException (() -> ConstJSON -> ()
forall a b. a -> b -> a
const ())
    (Either CozoMessage ConstJSON -> Either CozoException ())
-> (IntermediateCozoMessageOnNotOK ConstJSON
    -> Either CozoMessage ConstJSON)
-> IntermediateCozoMessageOnNotOK ConstJSON
-> Either CozoException ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntermediateCozoMessageOnNotOK ConstJSON
-> Either CozoMessage ConstJSON
forall a. IntermediateCozoMessageOnNotOK a -> Either CozoMessage a
runIntermediateCozoMessageOnNotOK

cozoDecode :: (FromJSON a) => ByteString -> Either CozoException a
cozoDecode :: forall a. FromJSON a => ByteString -> Either CozoException a
cozoDecode = (String -> CozoException)
-> Either String a -> Either CozoException a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> CozoException
CozoJSONParseException (Either String a -> Either CozoException a)
-> (ByteString -> Either String a)
-> ByteString
-> Either CozoException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict

{- |
Helper for defining JSON disjunctions that
switch on the value of an \"ok\" boolean field.
-}
eitherOkay ::
  String ->
  (Value -> Parser a) ->
  (Value -> Parser a) ->
  Value ->
  Parser a
eitherOkay :: forall a.
String
-> (Value -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
eitherOkay String
s Value -> Parser a
l Value -> Parser a
r =
  String -> (KeyMap Value -> Parser a) -> Value -> Parser a
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject
    String
s
    ( \KeyMap Value
o ->
        case Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"ok" KeyMap Value
o of
          Maybe Value
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Result did not contain \"ok\" field"
          Just Value
ok ->
            case Value
ok of
              Bool Bool
b ->
                if Bool
b then Value -> Parser a
r (KeyMap Value -> Value
Object KeyMap Value
o) else Value -> Parser a
l (KeyMap Value -> Value
Object KeyMap Value
o)
              Value
_ -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"ok\" field did not contain a Boolean."
    )

strictToEncoding :: (ToJSON a) => a -> ByteString
strictToEncoding :: forall a. ToJSON a => a -> ByteString
strictToEncoding =
  ByteString -> ByteString
toStrict
    (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding
    (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding