project-m36-0.9.9: Relational Algebra Engine
Safe HaskellSafe-Inferred
LanguageHaskell2010

ProjectM36.Client

Description

Client interface to local and remote Project:M36 databases. To get started, connect with connectProjectM36, then run some database changes with executeDatabaseContextExpr, and issue queries using executeRelationalExpr.

Synopsis

Documentation

data ConnectionInfo Source #

Construct a ConnectionInfo to describe how to make the Connection. The database can be run within the current process or running remotely via RPC.

data Connection Source #

Constructors

InProcessConnection InProcessConnectionConf 
RemoteConnection RemoteConnectionConf 

type ServiceName = String Source #

Either a service name e.g., "http" or a numeric port number.

data ConnectionError Source #

There are several reasons why a connection can fail.

Instances

Instances details
Generic ConnectionError Source # 
Instance details

Defined in ProjectM36.Client

Associated Types

type Rep ConnectionError :: Type -> Type Source #

Show ConnectionError Source # 
Instance details

Defined in ProjectM36.Client

Eq ConnectionError Source # 
Instance details

Defined in ProjectM36.Client

type Rep ConnectionError Source # 
Instance details

Defined in ProjectM36.Client

type Rep ConnectionError = D1 ('MetaData "ConnectionError" "ProjectM36.Client" "project-m36-0.9.9-inplace" 'False) ((C1 ('MetaCons "SetupDatabaseDirectoryError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PersistenceError)) :+: C1 ('MetaCons "IOExceptionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IOException))) :+: (C1 ('MetaCons "NoSuchDatabaseByNameError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DatabaseName)) :+: (C1 ('MetaCons "DatabaseValidationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [MerkleValidationError])) :+: C1 ('MetaCons "LoginError" 'PrefixI 'False) (U1 :: Type -> Type))))

connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection) Source #

To create a Connection to a remote or local database, create a ConnectionInfo and call connectProjectM36.

close :: Connection -> IO () Source #

close cleans up the database access connection and closes any relevant sockets.

executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) Source #

Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.

executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ()) Source #

Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.

executeDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ()) Source #

Execute a database context IO-monad-based expression for the given session and connection. DatabaseContextIOExprs modify the DatabaseContext but cannot be purely implemented. this is almost completely identical to executeDatabaseContextExpr above

executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ()) Source #

Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

executeSchemaExpr :: SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ()) Source #

Schema expressions manipulate the isomorphic schemas for the current DatabaseContext.

executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation) Source #

A trans-graph expression is a relational query executed against the entirety of a transaction graph.

commit :: SessionId -> Connection -> IO (Either RelationalError ()) Source #

After modifying a DatabaseContext, commit the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.

rollback :: SessionId -> Connection -> IO (Either RelationalError ()) Source #

Discard any changes made in the current Session and DatabaseContext. This resets the disconnected transaction to reference the original database context of the parent transaction and is a very cheap operation.

typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) Source #

Return a relation whose type would match that of the relational expression if it were executed. This is useful for checking types and validating a relational expression's types.

inclusionDependencies :: SessionId -> Connection -> IO (Either RelationalError InclusionDependencies) Source #

Return a Map of the database's constraints at the context of the session and connection.

planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr) Source #

Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.

currentSchemaName :: SessionId -> Connection -> IO (Either RelationalError SchemaName) Source #

Returns the name of the currently selected isomorphic schema.

type HeadName = StringType Source #

A transaction graph's head name references the leaves of the transaction graph and can be used during session creation to indicate at which point in the graph commits should persist.

setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ()) Source #

Switch to the named isomorphic schema.

transactionGraphAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) Source #

Return a relation which represents the current state of the global transaction graph. The attributes are * current- boolean attribute representing whether or not the current session references this transaction * head- text attribute which is a non-empty HeadName iff the transaction references a head. * id- id attribute of the transaction * parents- a relation-valued attribute which contains a relation of transaction ids which are parent transaction to the transaction

relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) Source #

Returns the names and types of the relation variables in the current Session.

ddlAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) Source #

Returns a relation representing the complete DDL of the current DatabaseContext.

atomFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) Source #

Returns the names and types of the atom functions in the current Session.

headName :: SessionId -> Connection -> IO (Either RelationalError HeadName) Source #

Returns Just the name of the head of the current disconnected transaction or Nothing.

defaultServerPort :: Port Source #

Use this for connecting to remote servers on the default port.

headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId) Source #

Returns the transaction id for the connection's disconnected transaction committed parent transaction.

defaultDatabaseName :: DatabaseName Source #

Use this for connecting to remote servers with the default database name.

defaultRemoteConnectionInfo :: ConnectionInfo Source #

Create a connection configuration which connects to the localhost on the default server port and default server database name. The configured notification callback is set to ignore all events.

defaultHeadName :: HeadName Source #

Use this for connecting to remote servers with the default head name.

getDDLHash :: SessionId -> Connection -> IO (Either RelationalError SecureHash) Source #

Calculate a hash on the DDL of the current database context (not the graph). This is useful for validating on the client that the database schema meets the client's expectation. Any DDL change will change this hash. This hash does not change based on the current isomorphic schema being examined. This function is not affected by the current schema (since they are all isomorphic anyway, they should return the same hash).

data PersistenceStrategy Source #

The persistence strategy is a global database option which represents how to persist the database in the filesystem, if at all.

Constructors

NoPersistence

no filesystem persistence/memory-only database

MinimalPersistence FilePath

fsync off, not crash-safe

CrashSafePersistence FilePath

full fsync to disk (flushes kernel and physical drive buffers to ensure that the transaction is on non-volatile storage)

data RelationalExprBase a Source #

A relational expression represents query (read) operations on a database.

Instances

Instances details
Foldable RelationalExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => RelationalExprBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> RelationalExprBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> RelationalExprBase a -> m Source #

foldr :: (a -> b -> b) -> b -> RelationalExprBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> RelationalExprBase a -> b Source #

foldl :: (b -> a -> b) -> b -> RelationalExprBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> RelationalExprBase a -> b Source #

foldr1 :: (a -> a -> a) -> RelationalExprBase a -> a Source #

foldl1 :: (a -> a -> a) -> RelationalExprBase a -> a Source #

toList :: RelationalExprBase a -> [a] Source #

null :: RelationalExprBase a -> Bool Source #

length :: RelationalExprBase a -> Int Source #

elem :: Eq a => a -> RelationalExprBase a -> Bool Source #

maximum :: Ord a => RelationalExprBase a -> a Source #

minimum :: Ord a => RelationalExprBase a -> a Source #

sum :: Num a => RelationalExprBase a -> a Source #

product :: Num a => RelationalExprBase a -> a Source #

Traversable RelationalExprBase Source # 
Instance details

Defined in ProjectM36.Base

Functor RelationalExprBase Source # 
Instance details

Defined in ProjectM36.Base

Hashable RelationalExpr Source # 
Instance details

Defined in ProjectM36.Base

HashBytes RelationVariables Source # 
Instance details

Defined in ProjectM36.HashSecurely

Morph RelationalExpr Source # 
Instance details

Defined in ProjectM36.IsomorphicSchema

ResolveGraphRefTransactionMarker GraphRefRelationalExpr Source # 
Instance details

Defined in ProjectM36.RelationalExpression

KnownSymbol x => IsLabel x RelationalExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelVarName RelationalExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelationalExpr AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelationalExpr RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Generic (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (RelationalExprBase a) :: Type -> Type Source #

Read a => Read (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: RelationalExprBase a -> () Source #

Eq a => Eq (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Corecursive (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Recursive (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Serialise a => Serialise (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (RelationalExprBase a) = D1 ('MetaData "RelationalExprBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) ((((C1 ('MetaCons "MakeRelationFromExprs" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe [AttributeExprBase a])) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (TupleExprsBase a))) :+: C1 ('MetaCons "MakeStaticRelation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attributes) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationTupleSet))) :+: (C1 ('MetaCons "ExistingRelation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Relation)) :+: C1 ('MetaCons "RelationVariable" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)))) :+: ((C1 ('MetaCons "Project" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AttributeNamesBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "Union" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)))) :+: (C1 ('MetaCons "Join" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "Rename" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))))))) :+: (((C1 ('MetaCons "Difference" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "Group" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AttributeNamesBase a)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))))) :+: (C1 ('MetaCons "Ungroup" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "Restrict" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))))) :+: ((C1 ('MetaCons "Equals" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "NotEquals" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)))) :+: (C1 ('MetaCons "Extend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ExtendTupleExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "With" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(WithNameExprBase a, RelationalExprBase a)]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)))))))
type Base (RelationalExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

data DatabaseContextExprBase a Source #

Database context expressions modify the database context.

Instances

Instances details
Hashable DatabaseContextExpr Source # 
Instance details

Defined in ProjectM36.Base

Generic (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (DatabaseContextExprBase a) :: Type -> Type Source #

Read a => Read (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Eq a => Eq (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Serialise a => Serialise (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (DatabaseContextExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (DatabaseContextExprBase a) = D1 ('MetaData "DatabaseContextExprBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) ((((C1 ('MetaCons "NoOperation" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Define" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AttributeExprBase a]))) :+: (C1 ('MetaCons "Undefine" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName)) :+: C1 ('MetaCons "Assign" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))))) :+: ((C1 ('MetaCons "Insert" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a))) :+: C1 ('MetaCons "Delete" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)))) :+: (C1 ('MetaCons "Update" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeNameAtomExprMap) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)))) :+: (C1 ('MetaCons "AddInclusionDependency" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IncDepName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 InclusionDependency)) :+: C1 ('MetaCons "RemoveInclusionDependency" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IncDepName)))))) :+: (((C1 ('MetaCons "AddNotification" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotificationName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr))) :+: C1 ('MetaCons "RemoveNotification" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotificationName))) :+: (C1 ('MetaCons "AddTypeConstructor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorDef) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [DataConstructorDef])) :+: (C1 ('MetaCons "RemoveTypeConstructor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName)) :+: C1 ('MetaCons "RemoveAtomFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName))))) :+: ((C1 ('MetaCons "RemoveDatabaseContextFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName)) :+: C1 ('MetaCons "ExecuteDatabaseContextFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AtomExprBase a]))) :+: (C1 ('MetaCons "AddRegisteredQuery" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RegisteredQueryName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr)) :+: (C1 ('MetaCons "RemoveRegisteredQuery" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RegisteredQueryName)) :+: C1 ('MetaCons "MultipleExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [DatabaseContextExprBase a])))))))

data DatabaseContextIOExprBase a Source #

Adding an atom function should be nominally a DatabaseExpr except for the fact that it cannot be performed purely. Thus, we create the DatabaseContextIOExpr.

Instances

Instances details
Generic (DatabaseContextIOExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (DatabaseContextIOExprBase a) :: Type -> Type Source #

Show a => Show (DatabaseContextIOExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Eq a => Eq (DatabaseContextIOExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Serialise a => Serialise (DatabaseContextIOExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (DatabaseContextIOExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (DatabaseContextIOExprBase a) = D1 ('MetaData "DatabaseContextIOExprBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) ((C1 ('MetaCons "AddAtomFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TypeConstructor]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionBodyScript))) :+: C1 ('MetaCons "LoadAtomFunctions" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ObjModuleName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ObjFunctionName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath)))) :+: (C1 ('MetaCons "AddDatabaseContextFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TypeConstructor]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionBodyScript))) :+: (C1 ('MetaCons "LoadDatabaseContextFunctions" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ObjModuleName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ObjFunctionName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath))) :+: C1 ('MetaCons "CreateArbitraryRelation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AttributeExprBase a]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Range))))))

data Attribute Source #

A relation's type is composed of attribute names and types.

Instances

Instances details
Generic Attribute Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep Attribute :: Type -> Type Source #

Read Attribute Source # 
Instance details

Defined in ProjectM36.Base

Show Attribute Source # 
Instance details

Defined in ProjectM36.Base

NFData Attribute Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: Attribute -> () Source #

Eq Attribute Source # 
Instance details

Defined in ProjectM36.Base

Hashable Attribute Source # 
Instance details

Defined in ProjectM36.Base

HashBytes Attribute Source # 
Instance details

Defined in ProjectM36.HashSecurely

Methods

hashBytes :: Attribute -> Ctx -> Ctx Source #

Serialise Attribute Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep Attribute Source # 
Instance details

Defined in ProjectM36.Base

data MergeStrategy Source #

Constructors

UnionMergeStrategy

After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

UnionPreferMergeStrategy HeadName

Similar to a union merge, but, on conflict, prefer the unmerged section (relvar, function, etc.) from the branch named as the argument.

SelectedBranchMergeStrategy HeadName

Similar to the our/theirs merge strategy in git, the merge transaction's context is identical to that of the last transaction in the selected branch.

Instances

Instances details
Generic MergeStrategy Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep MergeStrategy :: Type -> Type Source #

Show MergeStrategy Source # 
Instance details

Defined in ProjectM36.Base

NFData MergeStrategy Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: MergeStrategy -> () Source #

Eq MergeStrategy Source # 
Instance details

Defined in ProjectM36.Base

Serialise MergeStrategy Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep MergeStrategy Source # 
Instance details

Defined in ProjectM36.Base

type Rep MergeStrategy = D1 ('MetaData "MergeStrategy" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "UnionMergeStrategy" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "UnionPreferMergeStrategy" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)) :+: C1 ('MetaCons "SelectedBranchMergeStrategy" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName))))

createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId) Source #

Create a new session at the transaction id and return the session's Id.

createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId) Source #

Call createSessionAtHead with a transaction graph's head's name to create a new session pinned to that head. This function returns a SessionId which can be used in other function calls to reference the point in the transaction graph.

closeSession :: SessionId -> Connection -> IO () Source #

Discards a session, eliminating any uncommitted changes present in the session.

data RelationCardinality Source #

Used to represent the number of tuples in a relation.

Constructors

Countable 
Finite Int 

Instances

Instances details
Generic RelationCardinality Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep RelationCardinality :: Type -> Type Source #

Show RelationCardinality Source # 
Instance details

Defined in ProjectM36.Base

Eq RelationCardinality Source # 
Instance details

Defined in ProjectM36.Base

Ord RelationCardinality Source # 
Instance details

Defined in ProjectM36.Base

Serialise RelationCardinality Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep RelationCardinality Source # 
Instance details

Defined in ProjectM36.Base

type Rep RelationCardinality = D1 ('MetaData "RelationCardinality" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "Countable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Finite" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

data TransactionGraphOperator Source #

Operators which manipulate a transaction graph and which transaction the current Session is based upon.

Instances

Instances details
Generic TransactionGraphOperator Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Associated Types

type Rep TransactionGraphOperator :: Type -> Type Source #

Show TransactionGraphOperator Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Eq TransactionGraphOperator Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Serialise TransactionGraphOperator Source # 
Instance details

Defined in ProjectM36.TransactionGraph

type Rep TransactionGraphOperator Source # 
Instance details

Defined in ProjectM36.TransactionGraph

type Rep TransactionGraphOperator = D1 ('MetaData "TransactionGraphOperator" "ProjectM36.TransactionGraph" "project-m36-0.9.9-inplace" 'False) (((C1 ('MetaCons "JumpToHead" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)) :+: C1 ('MetaCons "JumpToTransaction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId))) :+: (C1 ('MetaCons "WalkBackToTime" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UTCTime)) :+: C1 ('MetaCons "Branch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)))) :+: ((C1 ('MetaCons "DeleteBranch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)) :+: C1 ('MetaCons "MergeTransactions" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MergeStrategy) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)))) :+: (C1 ('MetaCons "Commit" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Rollback" 'PrefixI 'False) (U1 :: Type -> Type))))

autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ()) Source #

Similar to a git rebase, autoMergeToHead atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the HeadName and commits the merge. This is useful to reduce incidents of TransactionIsNotAHeadErrors but at the risk of merge errors (thus making it similar to rebasing). Alternatively, as an optimization, if a simple commit is possible (meaning that the head has not changed), then a fast-forward commit takes place instead.

type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup Source #

The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).

data TransactionIdLookup Source #

Record a lookup for a specific transaction in the graph.

Instances

Instances details
Generic TransactionIdLookup Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Associated Types

type Rep TransactionIdLookup :: Type -> Type Source #

Show TransactionIdLookup Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Eq TransactionIdLookup Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Serialise TransactionIdLookup Source # 
Instance details

Defined in ProjectM36.TransactionGraph

type Rep TransactionIdLookup Source # 
Instance details

Defined in ProjectM36.TransactionGraph

data TransactionIdHeadBacktrack Source #

Used for git-style head backtracking such as topic~3^2.

Constructors

TransactionIdHeadParentBacktrack Int

git equivalent of ~v: walk back n parents, arbitrarily choosing a parent when a choice must be made

TransactionIdHeadBranchBacktrack Int

git equivalent of ^: walk back one parent level to the nth arbitrarily-chosen parent

TransactionStampHeadBacktrack UTCTime

git equivalent of 'git-rev-list -n 1 --before X' find the first transaction which was created before the timestamp

Instances

Instances details
Generic TransactionIdHeadBacktrack Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Associated Types

type Rep TransactionIdHeadBacktrack :: Type -> Type Source #

Show TransactionIdHeadBacktrack Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Eq TransactionIdHeadBacktrack Source # 
Instance details

Defined in ProjectM36.TransactionGraph

Serialise TransactionIdHeadBacktrack Source # 
Instance details

Defined in ProjectM36.TransactionGraph

type Rep TransactionIdHeadBacktrack Source # 
Instance details

Defined in ProjectM36.TransactionGraph

type Rep TransactionIdHeadBacktrack = D1 ('MetaData "TransactionIdHeadBacktrack" "ProjectM36.TransactionGraph" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "TransactionIdHeadParentBacktrack" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: (C1 ('MetaCons "TransactionIdHeadBranchBacktrack" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "TransactionStampHeadBacktrack" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UTCTime))))

data Atom Source #

Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.

Instances

Instances details
Generic Atom Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep Atom :: Type -> Type Source #

Methods

from :: Atom -> Rep Atom x Source #

to :: Rep Atom x -> Atom Source #

Read Atom Source # 
Instance details

Defined in ProjectM36.Base

Show Atom Source # 
Instance details

Defined in ProjectM36.Base

NFData Atom Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: Atom -> () Source #

Eq Atom Source # 
Instance details

Defined in ProjectM36.Base

Methods

(==) :: Atom -> Atom -> Bool Source #

(/=) :: Atom -> Atom -> Bool Source #

Hashable Atom Source # 
Instance details

Defined in ProjectM36.Base

HashBytes Atom Source # 
Instance details

Defined in ProjectM36.HashSecurely

Methods

hashBytes :: Atom -> Ctx -> Ctx Source #

HashBytes AtomFunction Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes AtomFunctions Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes DatabaseContextFunction Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes DatabaseContextFunctions Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise Atom Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep Atom Source # 
Instance details

Defined in ProjectM36.Base

type Rep Atom = D1 ('MetaData "Atom" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (((C1 ('MetaCons "IntegerAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Integer)) :+: (C1 ('MetaCons "IntAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "ScientificAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Scientific)))) :+: (C1 ('MetaCons "DoubleAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double)) :+: (C1 ('MetaCons "TextAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Text)) :+: C1 ('MetaCons "DayAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Day))))) :+: ((C1 ('MetaCons "DateTimeAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UTCTime)) :+: (C1 ('MetaCons "ByteStringAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ByteString)) :+: C1 ('MetaCons "BoolAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)))) :+: ((C1 ('MetaCons "UUIDAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UUID)) :+: C1 ('MetaCons "RelationAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Relation))) :+: (C1 ('MetaCons "RelationalExprAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RelationalExpr)) :+: C1 ('MetaCons "ConstructedAtom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataConstructorName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 AtomType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Atom])))))))

data Session Source #

Represents a pointer into the database's transaction graph which the DatabaseContextExprs can then modify subsequently be committed to extend the transaction graph. The session contains staged (uncommitted) database changes as well as the means to switch between isomorphic schemas.

type NotificationCallback = NotificationName -> EvaluatedNotification -> IO () Source #

The type for notifications callbacks in the client. When a registered notification fires due to a changed relational expression evaluation, the server propagates the notifications to the clients in the form of the callback.

emptyNotificationCallback :: NotificationCallback Source #

The empty notification callback ignores all callbacks.

data EvaluatedNotification Source #

When a notification is fired, the reportOldExpr is evaluated in the commit's pre-change context while the reportNewExpr is evaluated in the post-change context and they are returned along with the original notification.

Instances

Instances details
Generic EvaluatedNotification Source # 
Instance details

Defined in ProjectM36.Client

Associated Types

type Rep EvaluatedNotification :: Type -> Type Source #

Show EvaluatedNotification Source # 
Instance details

Defined in ProjectM36.Client

Eq EvaluatedNotification Source # 
Instance details

Defined in ProjectM36.Client

Serialise EvaluatedNotification Source # 
Instance details

Defined in ProjectM36.Client

type Rep EvaluatedNotification Source # 
Instance details

Defined in ProjectM36.Client

type Rep EvaluatedNotification = D1 ('MetaData "EvaluatedNotification" "ProjectM36.Client" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "EvaluatedNotification" 'PrefixI 'True) (S1 ('MetaSel ('Just "notification") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Notification) :*: (S1 ('MetaSel ('Just "reportOldRelation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either RelationalError Relation)) :*: S1 ('MetaSel ('Just "reportNewRelation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either RelationalError Relation)))))

atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) Source #

Returns a listing of all available atom types.

inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency Source #

Create a uniqueness constraint for the attribute names and relational expression. Note that constraint can span multiple relation variables.

databaseContextExprForUniqueKey :: RelVarName -> [AttributeName] -> DatabaseContextExpr Source #

Create a DatabaseContextExpr which can be used to add a uniqueness constraint to attributes on one relation variable.

databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr Source #

Create a foreign key constraint from the first relation variable and attributes to the second.

createScriptedAtomFunction :: FunctionName -> [TypeConstructor] -> TypeConstructor -> FunctionBodyScript -> DatabaseContextIOExpr Source #

Create a DatabaseContextIOExpr which can be used to load a new atom function written in Haskell and loaded at runtime.

data AttributeExprBase a Source #

Create attributes dynamically.

Instances

Instances details
Foldable AttributeExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => AttributeExprBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> AttributeExprBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> AttributeExprBase a -> m Source #

foldr :: (a -> b -> b) -> b -> AttributeExprBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> AttributeExprBase a -> b Source #

foldl :: (b -> a -> b) -> b -> AttributeExprBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> AttributeExprBase a -> b Source #

foldr1 :: (a -> a -> a) -> AttributeExprBase a -> a Source #

foldl1 :: (a -> a -> a) -> AttributeExprBase a -> a Source #

toList :: AttributeExprBase a -> [a] Source #

null :: AttributeExprBase a -> Bool Source #

length :: AttributeExprBase a -> Int Source #

elem :: Eq a => a -> AttributeExprBase a -> Bool Source #

maximum :: Ord a => AttributeExprBase a -> a Source #

minimum :: Ord a => AttributeExprBase a -> a Source #

sum :: Num a => AttributeExprBase a -> a Source #

product :: Num a => AttributeExprBase a -> a Source #

Traversable AttributeExprBase Source # 
Instance details

Defined in ProjectM36.Base

Functor AttributeExprBase Source # 
Instance details

Defined in ProjectM36.Base

(KnownSymbol x, Atomable a) => IsLabel x (HaskAtomType a -> AttributeExpr) Source # 
Instance details

Defined in ProjectM36.Shortcuts

Generic (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (AttributeExprBase a) :: Type -> Type Source #

Read a => Read (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: AttributeExprBase a -> () Source #

Eq a => Eq (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Hashable a => Hashable (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes a => HashBytes (Maybe [AttributeExprBase a]) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise a => Serialise (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (AttributeExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

data TypeConstructorBase a Source #

Instances

Instances details
HashBytes TypeConstructor Source # 
Instance details

Defined in ProjectM36.HashSecurely

Generic (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (TypeConstructorBase a) :: Type -> Type Source #

Read a => Read (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: TypeConstructorBase a -> () Source #

Eq a => Eq (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

Hashable a => Hashable (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

Serialise a => Serialise (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (TypeConstructorBase a) Source # 
Instance details

Defined in ProjectM36.Base

data TypeConstructorDef Source #

Metadata definition for type constructors such as data Either a b.

Instances

Instances details
Generic TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep TypeConstructorDef :: Type -> Type Source #

Read TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Show TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

NFData TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: TypeConstructorDef -> () Source #

Eq TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Hashable TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

HashBytes TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes TypeConstructorMapping Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep TypeConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

data DataConstructorDef Source #

Used to define a data constructor in a type constructor context such as Left a | Right b

Instances

Instances details
Generic DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep DataConstructorDef :: Type -> Type Source #

Read DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Show DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

NFData DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: DataConstructorDef -> () Source #

Eq DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

Hashable DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

HashBytes DataConstructorDef Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes TypeConstructorMapping Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Serialise.Base

HashBytes [DataConstructorDef] Source # 
Instance details

Defined in ProjectM36.HashSecurely

type Rep DataConstructorDef Source # 
Instance details

Defined in ProjectM36.Base

data AttributeNamesBase a Source #

An AtomFunction has a name, a type, and a function body to execute when called.

The AttributeNamesBase structure represents a set of attribute names or the same set of names but inverted in the context of a relational expression. For example, if a relational expression has attributes named "a", "b", and "c", the InvertedAttributeNames of ("a","c") is ("b").

Instances

Instances details
Foldable AttributeNamesBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => AttributeNamesBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> AttributeNamesBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> AttributeNamesBase a -> m Source #

foldr :: (a -> b -> b) -> b -> AttributeNamesBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> AttributeNamesBase a -> b Source #

foldl :: (b -> a -> b) -> b -> AttributeNamesBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> AttributeNamesBase a -> b Source #

foldr1 :: (a -> a -> a) -> AttributeNamesBase a -> a Source #

foldl1 :: (a -> a -> a) -> AttributeNamesBase a -> a Source #

toList :: AttributeNamesBase a -> [a] Source #

null :: AttributeNamesBase a -> Bool Source #

length :: AttributeNamesBase a -> Int Source #

elem :: Eq a => a -> AttributeNamesBase a -> Bool Source #

maximum :: Ord a => AttributeNamesBase a -> a Source #

minimum :: Ord a => AttributeNamesBase a -> a Source #

sum :: Num a => AttributeNamesBase a -> a Source #

product :: Num a => AttributeNamesBase a -> a Source #

Traversable AttributeNamesBase Source # 
Instance details

Defined in ProjectM36.Base

Functor AttributeNamesBase Source # 
Instance details

Defined in ProjectM36.Base

Hashable AttributeNames Source # 
Instance details

Defined in ProjectM36.Base

ResolveGraphRefTransactionMarker GraphRefAttributeNames Source # 
Instance details

Defined in ProjectM36.RelationalExpression

IsList (AttributeNamesBase ()) Source # 
Instance details

Defined in ProjectM36.Shortcuts

Associated Types

type Item (AttributeNamesBase ()) Source #

Generic (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (AttributeNamesBase a) :: Type -> Type Source #

Read a => Read (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: AttributeNamesBase a -> () Source #

Eq a => Eq (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise a => Serialise (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Item (AttributeNamesBase ()) Source # 
Instance details

Defined in ProjectM36.Shortcuts

type Rep (AttributeNamesBase a) Source # 
Instance details

Defined in ProjectM36.Base

type RelVarName = StringType Source #

Relation variables are identified by their names.

data InclusionDependency Source #

Inclusion dependencies represent every possible database constraint. Constraints enforce specific, arbitrarily-complex rules to which the database context's relation variables must adhere unconditionally.

Instances

Instances details
Generic InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep InclusionDependency :: Type -> Type Source #

Read InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

Show InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

NFData InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

Eq InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

Hashable InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

HashBytes InclusionDependencies Source # 
Instance details

Defined in ProjectM36.HashSecurely

HashBytes InclusionDependency Source # 
Instance details

Defined in ProjectM36.HashSecurely

Morph InclusionDependencies Source # 
Instance details

Defined in ProjectM36.IsomorphicSchema

Morph InclusionDependency Source #

The names of inclusion dependencies might leak context about a different schema, but that's arbitrary and cannot be altered without having the user provide a renaming function or a new set of incDep names- seems extraneous.

Instance details

Defined in ProjectM36.IsomorphicSchema

Serialise InclusionDependency Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep InclusionDependency Source # 
Instance details

Defined in ProjectM36.Base

type Rep InclusionDependency = D1 ('MetaData "InclusionDependency" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "InclusionDependency" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalExpr)))

type AttributeName = StringType Source #

The AttributeName is the name of an attribute in a relation.

data DataFrameExpr Source #

A Relation can be converted to a DataFrame for sorting, limits, and offsets.

Instances

Instances details
Generic DataFrameExpr Source # 
Instance details

Defined in ProjectM36.DataFrame

Associated Types

type Rep DataFrameExpr :: Type -> Type Source #

Show DataFrameExpr Source # 
Instance details

Defined in ProjectM36.DataFrame

Serialise DataFrameExpr Source # 
Instance details

Defined in ProjectM36.Serialise.DataFrame

type Rep DataFrameExpr Source # 
Instance details

Defined in ProjectM36.DataFrame

data Order Source #

Instances

Instances details
Generic Order Source # 
Instance details

Defined in ProjectM36.DataFrame

Associated Types

type Rep Order :: Type -> Type Source #

Methods

from :: Order -> Rep Order x Source #

to :: Rep Order x -> Order Source #

Show Order Source # 
Instance details

Defined in ProjectM36.DataFrame

Eq Order Source # 
Instance details

Defined in ProjectM36.DataFrame

Methods

(==) :: Order -> Order -> Bool Source #

(/=) :: Order -> Order -> Bool Source #

Serialise Order Source # 
Instance details

Defined in ProjectM36.Serialise.DataFrame

type Rep Order Source # 
Instance details

Defined in ProjectM36.DataFrame

type Rep Order = D1 ('MetaData "Order" "ProjectM36.DataFrame" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "AscendingOrder" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DescendingOrder" 'PrefixI 'False) (U1 :: Type -> Type))

data RelationalError Source #

Constructors

NoSuchAttributeNamesError (Set AttributeName) 
TupleAttributeCountMismatchError Int 
EmptyAttributesError 
DuplicateAttributeNamesError (Set AttributeName) 
TupleAttributeTypeMismatchError Attributes 
AttributeCountMismatchError Int 
AttributeNamesMismatchError (Set AttributeName) 
AttributeNameInUseError AttributeName 
AttributeIsNotRelationValuedError AttributeName 
CouldNotInferAttributes 
RelVarNotDefinedError RelVarName 
RelVarAlreadyDefinedError RelVarName 
RelationTypeMismatchError Attributes Attributes 
InclusionDependencyCheckError IncDepName (Maybe RelationalError) 
InclusionDependencyNameInUseError IncDepName 
InclusionDependencyNameNotInUseError IncDepName 
ParseError Text 
PredicateExpressionError Text 
NoCommonTransactionAncestorError TransactionId TransactionId 
NoSuchTransactionError TransactionId 
RootTransactionTraversalError 
HeadNameSwitchingHeadProhibitedError HeadName 
NoSuchHeadNameError HeadName 
UnknownHeadError 
NewTransactionMayNotHaveChildrenError TransactionId 
ParentCountTraversalError Int Int 
NewTransactionMissingParentError TransactionId 
TransactionIsNotAHeadError TransactionId 
TransactionGraphCycleError TransactionId 
SessionIdInUseError TransactionId 
NoSuchSessionError TransactionId 
FailedToFindTransactionError TransactionId 
TransactionIdInUseError TransactionId 
NoSuchFunctionError FunctionName 
NoSuchTypeConstructorName TypeConstructorName 
TypeConstructorAtomTypeMismatch TypeConstructorName AtomType 
AtomTypeMismatchError AtomType AtomType 
TypeConstructorNameMismatch TypeConstructorName TypeConstructorName 
AtomTypeTypeConstructorReconciliationError AtomType TypeConstructorName 
DataConstructorNameInUseError DataConstructorName 
DataConstructorUsesUndeclaredTypeVariable TypeVarName 
TypeConstructorTypeVarsMismatch (Set TypeVarName) (Set TypeVarName) 
TypeConstructorTypeVarMissing TypeVarName 
TypeConstructorTypeVarsTypesMismatch TypeConstructorName TypeVarMap TypeVarMap 
DataConstructorTypeVarsMismatch DataConstructorName TypeVarMap TypeVarMap 
AtomFunctionTypeVariableResolutionError FunctionName TypeVarName 
AtomFunctionTypeVariableMismatch TypeVarName AtomType AtomType 
AtomTypeNameInUseError AtomTypeName 
IncompletelyDefinedAtomTypeWithConstructorError 
AtomTypeNameNotInUseError AtomTypeName 
AttributeNotSortableError Attribute 
FunctionNameInUseError FunctionName 
FunctionNameNotInUseError FunctionName 
EmptyCommitError 
FunctionArgumentCountMismatchError Int Int 
ConstructedAtomArgumentCountMismatchError Int Int 
NoSuchDataConstructorError DataConstructorName 
NoSuchTypeConstructorError TypeConstructorName 
InvalidAtomTypeName AtomTypeName 
AtomTypeNotSupported AttributeName 
AtomOperatorNotSupported Text 
EmptyTuplesError 
AtomTypeCountError [AtomType] [AtomType] 
AtomFunctionTypeError FunctionName Int AtomType AtomType 
AtomFunctionUserError AtomFunctionError 
PrecompiledFunctionRemoveError FunctionName 
RelationValuedAttributesNotSupportedError [AttributeName] 
NotificationNameInUseError NotificationName 
NotificationNameNotInUseError NotificationName 
ImportError ImportError' 
ExportError Text 
UnhandledExceptionError String 
MergeTransactionError MergeError 
ScriptError ScriptCompilationError 
LoadFunctionError 
SecurityLoadFunctionError 
DatabaseContextFunctionUserError DatabaseContextFunctionError 
DatabaseLoadError PersistenceError 
SubschemaNameInUseError SchemaName 
SubschemaNameNotInUseError SchemaName 
SchemaCreationError SchemaError 
ImproperDatabaseStateError 
NonConcreteSchemaPlanError 
NoUncommittedContextInEvalError 
TupleExprsReferenceMultipleMarkersError 
MerkleHashValidationError TransactionId MerkleHash MerkleHash 
RegisteredQueryValidationError RegisteredQueryName RelationalError 
RegisteredQueryNameInUseError RegisteredQueryName 
RegisteredQueryNameNotInUseError RegisteredQueryName 
MultipleErrors [RelationalError] 

Instances

Instances details
Generic RelationalError Source # 
Instance details

Defined in ProjectM36.Error

Associated Types

type Rep RelationalError :: Type -> Type Source #

Show RelationalError Source # 
Instance details

Defined in ProjectM36.Error

NFData RelationalError Source # 
Instance details

Defined in ProjectM36.Error

Methods

rnf :: RelationalError -> () Source #

Eq RelationalError Source # 
Instance details

Defined in ProjectM36.Error

Serialise RelationalError Source # 
Instance details

Defined in ProjectM36.Serialise.Error

DatabaseContextM (ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity)) Source # 
Instance details

Defined in ProjectM36.RelationalExpression

AskGraphContext (ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity)) Source # 
Instance details

Defined in ProjectM36.StaticOptimizer

AskGraphContext (ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity)) Source # 
Instance details

Defined in ProjectM36.StaticOptimizer

DatabaseContextM (RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity)) Source # 
Instance details

Defined in ProjectM36.RelationalExpression

type Rep RelationalError Source # 
Instance details

Defined in ProjectM36.Error

type Rep RelationalError = D1 ('MetaData "RelationalError" "ProjectM36.Error" "project-m36-0.9.9-inplace" 'False) ((((((C1 ('MetaCons "NoSuchAttributeNamesError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set AttributeName))) :+: C1 ('MetaCons "TupleAttributeCountMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int))) :+: (C1 ('MetaCons "EmptyAttributesError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "DuplicateAttributeNamesError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set AttributeName))) :+: C1 ('MetaCons "TupleAttributeTypeMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attributes))))) :+: ((C1 ('MetaCons "AttributeCountMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: (C1 ('MetaCons "AttributeNamesMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set AttributeName))) :+: C1 ('MetaCons "AttributeNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName)))) :+: (C1 ('MetaCons "AttributeIsNotRelationValuedError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName)) :+: (C1 ('MetaCons "CouldNotInferAttributes" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RelVarNotDefinedError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName)))))) :+: (((C1 ('MetaCons "RelVarAlreadyDefinedError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelVarName)) :+: C1 ('MetaCons "RelationTypeMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attributes) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attributes))) :+: (C1 ('MetaCons "InclusionDependencyCheckError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IncDepName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe RelationalError))) :+: (C1 ('MetaCons "InclusionDependencyNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IncDepName)) :+: C1 ('MetaCons "InclusionDependencyNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IncDepName))))) :+: ((C1 ('MetaCons "ParseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: (C1 ('MetaCons "PredicateExpressionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "NoCommonTransactionAncestorError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)))) :+: (C1 ('MetaCons "NoSuchTransactionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: (C1 ('MetaCons "RootTransactionTraversalError" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "HeadNameSwitchingHeadProhibitedError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName))))))) :+: ((((C1 ('MetaCons "NoSuchHeadNameError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeadName)) :+: C1 ('MetaCons "UnknownHeadError" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NewTransactionMayNotHaveChildrenError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: (C1 ('MetaCons "ParentCountTraversalError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "NewTransactionMissingParentError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId))))) :+: ((C1 ('MetaCons "TransactionIsNotAHeadError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: (C1 ('MetaCons "TransactionGraphCycleError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: C1 ('MetaCons "SessionIdInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)))) :+: (C1 ('MetaCons "NoSuchSessionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: (C1 ('MetaCons "FailedToFindTransactionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)) :+: C1 ('MetaCons "TransactionIdInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId)))))) :+: (((C1 ('MetaCons "NoSuchFunctionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName)) :+: (C1 ('MetaCons "NoSuchTypeConstructorName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName)) :+: C1 ('MetaCons "TypeConstructorAtomTypeMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType)))) :+: (C1 ('MetaCons "AtomTypeMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType)) :+: (C1 ('MetaCons "TypeConstructorNameMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName)) :+: C1 ('MetaCons "AtomTypeTypeConstructorReconciliationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName))))) :+: ((C1 ('MetaCons "DataConstructorNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataConstructorName)) :+: (C1 ('MetaCons "DataConstructorUsesUndeclaredTypeVariable" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarName)) :+: C1 ('MetaCons "TypeConstructorTypeVarsMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set TypeVarName)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set TypeVarName))))) :+: (C1 ('MetaCons "TypeConstructorTypeVarMissing" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarName)) :+: (C1 ('MetaCons "TypeConstructorTypeVarsTypesMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarMap) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarMap))) :+: C1 ('MetaCons "DataConstructorTypeVarsMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataConstructorName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarMap) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarMap))))))))) :+: (((((C1 ('MetaCons "AtomFunctionTypeVariableResolutionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarName)) :+: C1 ('MetaCons "AtomFunctionTypeVariableMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType)))) :+: (C1 ('MetaCons "AtomTypeNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomTypeName)) :+: (C1 ('MetaCons "IncompletelyDefinedAtomTypeWithConstructorError" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AtomTypeNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomTypeName))))) :+: ((C1 ('MetaCons "AttributeNotSortableError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attribute)) :+: (C1 ('MetaCons "FunctionNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName)) :+: C1 ('MetaCons "FunctionNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName)))) :+: (C1 ('MetaCons "EmptyCommitError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "FunctionArgumentCountMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "ConstructedAtomArgumentCountMismatchError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))))) :+: (((C1 ('MetaCons "NoSuchDataConstructorError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataConstructorName)) :+: C1 ('MetaCons "NoSuchTypeConstructorError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName))) :+: (C1 ('MetaCons "InvalidAtomTypeName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomTypeName)) :+: (C1 ('MetaCons "AtomTypeNotSupported" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName)) :+: C1 ('MetaCons "AtomOperatorNotSupported" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))))) :+: ((C1 ('MetaCons "EmptyTuplesError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "AtomTypeCountError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AtomType]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AtomType])) :+: C1 ('MetaCons "AtomFunctionTypeError" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomType))))) :+: (C1 ('MetaCons "AtomFunctionUserError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AtomFunctionError)) :+: (C1 ('MetaCons "PrecompiledFunctionRemoveError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FunctionName)) :+: C1 ('MetaCons "RelationValuedAttributesNotSupportedError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [AttributeName]))))))) :+: ((((C1 ('MetaCons "NotificationNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotificationName)) :+: C1 ('MetaCons "NotificationNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotificationName))) :+: (C1 ('MetaCons "ImportError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ImportError')) :+: (C1 ('MetaCons "ExportError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "UnhandledExceptionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))))) :+: ((C1 ('MetaCons "MergeTransactionError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MergeError)) :+: (C1 ('MetaCons "ScriptError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ScriptCompilationError)) :+: C1 ('MetaCons "LoadFunctionError" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "SecurityLoadFunctionError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "DatabaseContextFunctionUserError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DatabaseContextFunctionError)) :+: C1 ('MetaCons "DatabaseLoadError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PersistenceError)))))) :+: (((C1 ('MetaCons "SubschemaNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SchemaName)) :+: (C1 ('MetaCons "SubschemaNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SchemaName)) :+: C1 ('MetaCons "SchemaCreationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SchemaError)))) :+: (C1 ('MetaCons "ImproperDatabaseStateError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NonConcreteSchemaPlanError" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NoUncommittedContextInEvalError" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "TupleExprsReferenceMultipleMarkersError" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MerkleHashValidationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TransactionId) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MerkleHash) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MerkleHash))) :+: C1 ('MetaCons "RegisteredQueryValidationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RegisteredQueryName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RelationalError)))) :+: (C1 ('MetaCons "RegisteredQueryNameInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RegisteredQueryName)) :+: (C1 ('MetaCons "RegisteredQueryNameNotInUseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RegisteredQueryName)) :+: C1 ('MetaCons "MultipleErrors" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [RelationalError])))))))))

data AtomType Source #

The AtomType uniquely identifies the type of a atom.

Instances

Instances details
Generic AtomType Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep AtomType :: Type -> Type Source #

Read AtomType Source # 
Instance details

Defined in ProjectM36.Base

Show AtomType Source # 
Instance details

Defined in ProjectM36.Base

NFData AtomType Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: AtomType -> () Source #

Eq AtomType Source # 
Instance details

Defined in ProjectM36.Base

Ord AtomType Source # 
Instance details

Defined in ProjectM36.Base

Hashable AtomType Source # 
Instance details

Defined in ProjectM36.Base

HashBytes AtomType Source # 
Instance details

Defined in ProjectM36.HashSecurely

Methods

hashBytes :: AtomType -> Ctx -> Ctx Source #

Serialise AtomType Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep AtomType Source # 
Instance details

Defined in ProjectM36.Base

type Rep AtomType = D1 ('MetaData "AtomType" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (((C1 ('MetaCons "IntAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "IntegerAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ScientificAtomType" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "DoubleAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TextAtomType" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "DayAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DateTimeAtomType" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "ByteStringAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "BoolAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "UUIDAtomType" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "RelationAtomType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Attributes)) :+: C1 ('MetaCons "ConstructedAtomType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeConstructorName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarMap))) :+: (C1 ('MetaCons "RelationalExprAtomType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TypeVariableType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeVarName))))))

class (Eq a, NFData a, Serialise a, Show a) => Atomable a where Source #

All database values ("atoms") adhere to the Atomable typeclass. This class is derivable allowing new datatypes to be easily marshaling between Haskell values and database values.

Minimal complete definition

Nothing

Methods

toAtom :: a -> Atom Source #

default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom Source #

fromAtom :: Atom -> a Source #

default fromAtom :: (Generic a, AtomableG (Rep a)) => Atom -> a Source #

toAtomType :: proxy a -> AtomType Source #

default toAtomType :: (Generic a, AtomableG (Rep a)) => proxy a -> AtomType Source #

toAddTypeExpr :: proxy a -> DatabaseContextExpr Source #

Creates DatabaseContextExpr necessary to load the type constructor and data constructor into the database.

default toAddTypeExpr :: (Generic a, AtomableG (Rep a)) => proxy a -> DatabaseContextExpr Source #

Instances

Instances details
Atomable ByteString Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Text Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Day Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable UTCTime Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable UUID Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Integer Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Bool Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Double Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable Int Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable a => Atomable (NonEmpty a) Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable a => Atomable (Maybe a) Source # 
Instance details

Defined in ProjectM36.Atomable

Atomable a => Atomable [a] Source # 
Instance details

Defined in ProjectM36.Atomable

Methods

toAtom :: [a] -> Atom Source #

fromAtom :: Atom -> [a] Source #

toAtomType :: proxy [a] -> AtomType Source #

toAddTypeExpr :: proxy [a] -> DatabaseContextExpr Source #

(Atomable a, Atomable b) => Atomable (Either a b) Source # 
Instance details

Defined in ProjectM36.Atomable

newtype TupleExprBase a Source #

Dynamically create a tuple from attribute names and AtomExprs.

Instances

Instances details
Foldable TupleExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => TupleExprBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> TupleExprBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> TupleExprBase a -> m Source #

foldr :: (a -> b -> b) -> b -> TupleExprBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> TupleExprBase a -> b Source #

foldl :: (b -> a -> b) -> b -> TupleExprBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> TupleExprBase a -> b Source #

foldr1 :: (a -> a -> a) -> TupleExprBase a -> a Source #

foldl1 :: (a -> a -> a) -> TupleExprBase a -> a Source #

toList :: TupleExprBase a -> [a] Source #

null :: TupleExprBase a -> Bool Source #

length :: TupleExprBase a -> Int Source #

elem :: Eq a => a -> TupleExprBase a -> Bool Source #

maximum :: Ord a => TupleExprBase a -> a Source #

minimum :: Ord a => TupleExprBase a -> a Source #

sum :: Num a => TupleExprBase a -> a Source #

product :: Num a => TupleExprBase a -> a Source #

Traversable TupleExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

traverse :: Applicative f => (a -> f b) -> TupleExprBase a -> f (TupleExprBase b) Source #

sequenceA :: Applicative f => TupleExprBase (f a) -> f (TupleExprBase a) Source #

mapM :: Monad m => (a -> m b) -> TupleExprBase a -> m (TupleExprBase b) Source #

sequence :: Monad m => TupleExprBase (m a) -> m (TupleExprBase a) Source #

Functor TupleExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fmap :: (a -> b) -> TupleExprBase a -> TupleExprBase b Source #

(<$) :: a -> TupleExprBase b -> TupleExprBase a Source #

IsList TupleExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Associated Types

type Item TupleExpr Source #

Hashable TupleExpr Source # 
Instance details

Defined in ProjectM36.Base

ResolveGraphRefTransactionMarker GraphRefTupleExpr Source # 
Instance details

Defined in ProjectM36.RelationalExpression

Generic (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (TupleExprBase a) :: Type -> Type Source #

Read a => Read (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: TupleExprBase a -> () Source #

Eq a => Eq (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise a => Serialise (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Item TupleExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

type Rep (TupleExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (TupleExprBase a) = D1 ('MetaData "TupleExprBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'True) (C1 ('MetaCons "TupleExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map AttributeName (AtomExprBase a)))))

data TupleExprsBase a Source #

Constructors

TupleExprs a [TupleExprBase a] 

Instances

Instances details
Foldable TupleExprsBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => TupleExprsBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> TupleExprsBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> TupleExprsBase a -> m Source #

foldr :: (a -> b -> b) -> b -> TupleExprsBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> TupleExprsBase a -> b Source #

foldl :: (b -> a -> b) -> b -> TupleExprsBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> TupleExprsBase a -> b Source #

foldr1 :: (a -> a -> a) -> TupleExprsBase a -> a Source #

foldl1 :: (a -> a -> a) -> TupleExprsBase a -> a Source #

toList :: TupleExprsBase a -> [a] Source #

null :: TupleExprsBase a -> Bool Source #

length :: TupleExprsBase a -> Int Source #

elem :: Eq a => a -> TupleExprsBase a -> Bool Source #

maximum :: Ord a => TupleExprsBase a -> a Source #

minimum :: Ord a => TupleExprsBase a -> a Source #

sum :: Num a => TupleExprsBase a -> a Source #

product :: Num a => TupleExprsBase a -> a Source #

Traversable TupleExprsBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

traverse :: Applicative f => (a -> f b) -> TupleExprsBase a -> f (TupleExprsBase b) Source #

sequenceA :: Applicative f => TupleExprsBase (f a) -> f (TupleExprsBase a) Source #

mapM :: Monad m => (a -> m b) -> TupleExprsBase a -> m (TupleExprsBase b) Source #

sequence :: Monad m => TupleExprsBase (m a) -> m (TupleExprsBase a) Source #

Functor TupleExprsBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fmap :: (a -> b) -> TupleExprsBase a -> TupleExprsBase b Source #

(<$) :: a -> TupleExprsBase b -> TupleExprsBase a Source #

Hashable TupleExprs Source # 
Instance details

Defined in ProjectM36.Base

ResolveGraphRefTransactionMarker GraphRefTupleExprs Source # 
Instance details

Defined in ProjectM36.RelationalExpression

IsList (TupleExprsBase ()) Source # 
Instance details

Defined in ProjectM36.Shortcuts

Associated Types

type Item (TupleExprsBase ()) Source #

Generic (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (TupleExprsBase a) :: Type -> Type Source #

Read a => Read (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: TupleExprsBase a -> () Source #

Eq a => Eq (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise a => Serialise (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Item TupleExprs Source # 
Instance details

Defined in ProjectM36.Shortcuts

type Rep (TupleExprsBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (TupleExprsBase a) = D1 ('MetaData "TupleExprsBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) (C1 ('MetaCons "TupleExprs" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TupleExprBase a])))

data AtomExprBase a Source #

An atom expression represents an action to take when extending a relation or when statically defining a relation or a new tuple.

Instances

Instances details
Foldable AtomExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fold :: Monoid m => AtomExprBase m -> m Source #

foldMap :: Monoid m => (a -> m) -> AtomExprBase a -> m Source #

foldMap' :: Monoid m => (a -> m) -> AtomExprBase a -> m Source #

foldr :: (a -> b -> b) -> b -> AtomExprBase a -> b Source #

foldr' :: (a -> b -> b) -> b -> AtomExprBase a -> b Source #

foldl :: (b -> a -> b) -> b -> AtomExprBase a -> b Source #

foldl' :: (b -> a -> b) -> b -> AtomExprBase a -> b Source #

foldr1 :: (a -> a -> a) -> AtomExprBase a -> a Source #

foldl1 :: (a -> a -> a) -> AtomExprBase a -> a Source #

toList :: AtomExprBase a -> [a] Source #

null :: AtomExprBase a -> Bool Source #

length :: AtomExprBase a -> Int Source #

elem :: Eq a => a -> AtomExprBase a -> Bool Source #

maximum :: Ord a => AtomExprBase a -> a Source #

minimum :: Ord a => AtomExprBase a -> a Source #

sum :: Num a => AtomExprBase a -> a Source #

product :: Num a => AtomExprBase a -> a Source #

Traversable AtomExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

traverse :: Applicative f => (a -> f b) -> AtomExprBase a -> f (AtomExprBase b) Source #

sequenceA :: Applicative f => AtomExprBase (f a) -> f (AtomExprBase a) Source #

mapM :: Monad m => (a -> m b) -> AtomExprBase a -> m (AtomExprBase b) Source #

sequence :: Monad m => AtomExprBase (m a) -> m (AtomExprBase a) Source #

Functor AtomExprBase Source # 
Instance details

Defined in ProjectM36.Base

Methods

fmap :: (a -> b) -> AtomExprBase a -> AtomExprBase b Source #

(<$) :: a -> AtomExprBase b -> AtomExprBase a Source #

Hashable AtomExpr Source # 
Instance details

Defined in ProjectM36.Base

ResolveGraphRefTransactionMarker GraphRefAtomExpr Source # 
Instance details

Defined in ProjectM36.RelationalExpression

KnownSymbol x => IsLabel x AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible AtomExpr AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible AtomExpr RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelVarName AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelationalExpr AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Atomable a => Convertible a AtomExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

(KnownSymbol x, Convertible a AtomExpr) => IsLabel x ([a] -> AtomExpr) Source # 
Instance details

Defined in ProjectM36.Shortcuts

Methods

fromLabel :: [a] -> AtomExpr Source #

(Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> (AttributeName, AtomExpr)) Source # 
Instance details

Defined in ProjectM36.Shortcuts

Generic (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (AtomExprBase a) :: Type -> Type Source #

Read a => Read (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Methods

rnf :: AtomExprBase a -> () Source #

Eq a => Eq (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Methods

hashBytes :: AtomExprBase a -> Ctx -> Ctx Source #

Serialise a => Serialise (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (AtomExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

data RestrictionPredicateExprBase a Source #

Restriction predicates are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.

Instances

Instances details
Foldable RestrictionPredicateExprBase Source # 
Instance details

Defined in ProjectM36.Base

Traversable RestrictionPredicateExprBase Source # 
Instance details

Defined in ProjectM36.Base

Functor RestrictionPredicateExprBase Source # 
Instance details

Defined in ProjectM36.Base

Hashable RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Base

ResolveGraphRefTransactionMarker GraphRefRestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.RelationalExpression

Convertible AtomExpr RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RelationalExpr RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Convertible RestrictionPredicateExpr RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Atomable a => Convertible a RestrictionPredicateExpr Source # 
Instance details

Defined in ProjectM36.Shortcuts

Generic (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Associated Types

type Rep (RestrictionPredicateExprBase a) :: Type -> Type Source #

Read a => Read (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Show a => Show (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

NFData a => NFData (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

Eq a => Eq (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

HashBytes a => HashBytes (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.HashSecurely

Serialise a => Serialise (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Serialise.Base

type Rep (RestrictionPredicateExprBase a) Source # 
Instance details

Defined in ProjectM36.Base

type Rep (RestrictionPredicateExprBase a) = D1 ('MetaData "RestrictionPredicateExprBase" "ProjectM36.Base" "project-m36-0.9.9-inplace" 'False) ((C1 ('MetaCons "TruePredicate" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "AndPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))) :+: C1 ('MetaCons "OrPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))))) :+: ((C1 ('MetaCons "NotPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))) :+: C1 ('MetaCons "RelationalExprPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RelationalExprBase a)))) :+: (C1 ('MetaCons "AtomExprPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AtomExprBase a))) :+: C1 ('MetaCons "AttributeEqualityPredicate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AttributeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AtomExprBase a))))))

withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a) Source #

Runs an IO monad, commits the result when the monad returns no errors, otherwise, rolls back the changes and the error.