project-m36-0.3: Relational Algebra Engine

Safe HaskellNone
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 distributed-process.

data Connection Source #

Constructors

InProcessConnection InProcessConnectionConf 
RemoteProcessConnection RemoteProcessConnectionConf 

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 DatabaseContextExpr) 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.

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.

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

Binary RelationalExpr Source # 
Eq a => Eq (RelationalExprBase a) Source # 
Show a => Show (RelationalExprBase a) Source # 
Generic (RelationalExprBase a) Source # 

Associated Types

type Rep (RelationalExprBase a) :: * -> * #

NFData a => NFData (RelationalExprBase a) Source # 

Methods

rnf :: RelationalExprBase a -> () #

type Rep (RelationalExprBase a) Source # 
type Rep (RelationalExprBase a) = D1 (MetaData "RelationalExprBase" "ProjectM36.Base" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "MakeRelationFromExprs" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe [AttributeExprBase a]))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [TupleExprBase a])))) ((:+:) (C1 (MetaCons "MakeStaticRelation" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Attributes)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationTupleSet)))) (C1 (MetaCons "ExistingRelation" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Relation))))) ((:+:) ((:+:) (C1 (MetaCons "RelationVariable" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))) (C1 (MetaCons "Project" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeNames)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))) ((:+:) (C1 (MetaCons "Union" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))))) (C1 (MetaCons "Join" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "Rename" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeName)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))) (C1 (MetaCons "Difference" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))) ((:+:) (C1 (MetaCons "Group" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeNames)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))) (C1 (MetaCons "Ungroup" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))))))) ((:+:) ((:+:) (C1 (MetaCons "Restrict" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))))) (C1 (MetaCons "Equals" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))) ((:+:) (C1 (MetaCons "NotEquals" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))))) (C1 (MetaCons "Extend" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (ExtendTupleExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a)))))))))

data DatabaseContextExpr Source #

Database context expressions modify the database context.

Instances

Eq DatabaseContextExpr Source # 
Show DatabaseContextExpr Source # 
Generic DatabaseContextExpr Source # 
Binary DatabaseContextExpr Source # 
type Rep DatabaseContextExpr Source # 
type Rep DatabaseContextExpr = D1 (MetaData "DatabaseContextExpr" "ProjectM36.Base" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" False) ((:+:) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "NoOperation" PrefixI False) U1) (C1 (MetaCons "Define" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [AttributeExpr]))))) ((:+:) (C1 (MetaCons "Undefine" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName))) (C1 (MetaCons "Assign" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationalExpr)))))) ((:+:) ((:+:) (C1 (MetaCons "Insert" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationalExpr)))) (C1 (MetaCons "Delete" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RestrictionPredicateExpr))))) ((:+:) (C1 (MetaCons "Update" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelVarName)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeNameAtomExprMap)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RestrictionPredicateExpr))))) (C1 (MetaCons "AddInclusionDependency" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 IncDepName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 InclusionDependency))))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "RemoveInclusionDependency" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 IncDepName))) (C1 (MetaCons "AddNotification" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 NotificationName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationalExpr))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationalExpr)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 RelationalExpr)))))) ((:+:) (C1 (MetaCons "RemoveNotification" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 NotificationName))) (C1 (MetaCons "AddTypeConstructor" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 TypeConstructorDef)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [DataConstructorDef])))))) ((:+:) ((:+:) (C1 (MetaCons "RemoveTypeConstructor" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 TypeConstructorName))) (C1 (MetaCons "RemoveAtomFunction" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AtomFunctionName)))) ((:+:) (C1 (MetaCons "RemoveDatabaseContextFunction" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 DatabaseContextFunctionName))) ((:+:) (C1 (MetaCons "ExecuteDatabaseContextFunction" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 DatabaseContextFunctionName)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [AtomExpr])))) (C1 (MetaCons "MultipleExpr" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [DatabaseContextExpr]))))))))

data DatabaseContextIOExpr 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

Eq DatabaseContextIOExpr Source # 
Show DatabaseContextIOExpr Source # 
Generic DatabaseContextIOExpr Source # 
Binary DatabaseContextIOExpr Source # 
type Rep DatabaseContextIOExpr Source # 

data Attribute Source #

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

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.

createNodeId :: Hostname -> Port -> NodeId Source #

Create a NodeId for use in connecting to a remote server using distributed-process.

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.

addClientNode :: Connection -> ProcessId -> IO () Source #

Used internally for server connections to keep track of remote nodes for the purpose of sending notifications later.

data RelationCardinality Source #

Used to represent the number of tuples in a relation.

Constructors

Countable 
Finite Int 

data TransactionGraphOperator Source #

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

Instances

Eq TransactionGraphOperator Source # 
Show TransactionGraphOperator Source # 
Generic TransactionGraphOperator Source # 
Binary TransactionGraphOperator Source # 
type Rep TransactionGraphOperator Source # 

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).

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.

data TransactionIdHeadBacktrack Source #

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

Constructors

TransactionIdHeadParentBacktrack Int

git equivalent of ~: 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

Eq TransactionIdHeadBacktrack Source # 
Show TransactionIdHeadBacktrack Source # 
Generic TransactionIdHeadBacktrack Source # 
Binary TransactionIdHeadBacktrack Source # 
type Rep TransactionIdHeadBacktrack Source # 
type Rep TransactionIdHeadBacktrack = D1 (MetaData "TransactionIdHeadBacktrack" "ProjectM36.TransactionGraph" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" False) ((:+:) (C1 (MetaCons "TransactionIdHeadParentBacktrack" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))) ((:+:) (C1 (MetaCons "TransactionIdHeadBranchBacktrack" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))) (C1 (MetaCons "TransactionStampHeadBacktrack" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UTCTime)))))

newtype NodeId :: * #

Node identifier

Constructors

NodeId 

Instances

Eq NodeId 

Methods

(==) :: NodeId -> NodeId -> Bool #

(/=) :: NodeId -> NodeId -> Bool #

Data NodeId 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NodeId -> c NodeId #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c NodeId #

toConstr :: NodeId -> Constr #

dataTypeOf :: NodeId -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c NodeId) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId) #

gmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r #

gmapQ :: (forall d. Data d => d -> u) -> NodeId -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> NodeId -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

Ord NodeId 
Show NodeId 
Generic NodeId 

Associated Types

type Rep NodeId :: * -> * #

Methods

from :: NodeId -> Rep NodeId x #

to :: Rep NodeId x -> NodeId #

Hashable NodeId 

Methods

hashWithSalt :: Int -> NodeId -> Int #

hash :: NodeId -> Int #

Binary NodeId 

Methods

put :: NodeId -> Put #

get :: Get NodeId #

putList :: [NodeId] -> Put #

NFData NodeId 

Methods

rnf :: NodeId -> () #

Resolvable (NodeId, String) 
Routable (NodeId, String) 
type Rep NodeId 
type Rep NodeId = D1 (MetaData "NodeId" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-CTUSn8srUOF1BPYTHMh7Ta" True) (C1 (MetaCons "NodeId" PrefixI True) (S1 (MetaSel (Just Symbol "nodeAddress") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 EndPointAddress)))

data Atom Source #

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

Instances

Eq Atom Source # 

Methods

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

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

Show Atom Source # 

Methods

showsPrec :: Int -> Atom -> ShowS #

show :: Atom -> String #

showList :: [Atom] -> ShowS #

Generic Atom Source # 

Associated Types

type Rep Atom :: * -> * #

Methods

from :: Atom -> Rep Atom x #

to :: Rep Atom x -> Atom #

Hashable Atom Source # 

Methods

hashWithSalt :: Int -> Atom -> Int #

hash :: Atom -> Int #

Binary Atom Source # 

Methods

put :: Atom -> Put #

get :: Get Atom #

putList :: [Atom] -> Put #

NFData Atom Source # 

Methods

rnf :: Atom -> () #

type Rep Atom Source # 
type Rep Atom = D1 (MetaData "Atom" "ProjectM36.Base" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "IntegerAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))) (C1 (MetaCons "IntAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)))) ((:+:) (C1 (MetaCons "DoubleAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Double))) ((:+:) (C1 (MetaCons "TextAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text))) (C1 (MetaCons "DayAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Day)))))) ((:+:) ((:+:) (C1 (MetaCons "DateTimeAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UTCTime))) ((:+:) (C1 (MetaCons "ByteStringAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ByteString))) (C1 (MetaCons "BoolAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))) ((:+:) (C1 (MetaCons "IntervalAtom" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Atom)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Atom))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 OpenInterval)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 OpenInterval))))) ((:+:) (C1 (MetaCons "RelationAtom" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Relation))) (C1 (MetaCons "ConstructedAtom" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 DataConstructorName)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AtomType)) (S1 (MetaSel (Nothing 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.

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 :: AtomFunctionName -> [TypeConstructor] -> TypeConstructor -> AtomFunctionBodyScript -> 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

Eq a => Eq (AttributeExprBase a) Source # 
Show a => Show (AttributeExprBase a) Source # 
Generic (AttributeExprBase a) Source # 

Associated Types

type Rep (AttributeExprBase a) :: * -> * #

Binary a => Binary (AttributeExprBase a) Source # 
NFData a => NFData (AttributeExprBase a) Source # 

Methods

rnf :: AttributeExprBase a -> () #

type Rep (AttributeExprBase a) Source # 

data TypeConstructor Source #

Found in data constructors and type declarations: Left (Either Int Text) | Right Int

Instances

Eq TypeConstructor Source # 
Show TypeConstructor Source # 
Generic TypeConstructor Source # 
Binary TypeConstructor Source # 
NFData TypeConstructor Source # 

Methods

rnf :: TypeConstructor -> () #

type Rep TypeConstructor Source # 

data TypeConstructorDef Source #

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

Instances

data AttributeNames Source #

The AttributeNames 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

Eq AttributeNames Source # 
Show AttributeNames Source # 
Generic AttributeNames Source # 

Associated Types

type Rep AttributeNames :: * -> * #

Binary AttributeNames Source # 
NFData AttributeNames Source # 

Methods

rnf :: AttributeNames -> () #

type Rep AttributeNames Source # 

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.

type AttributeName = StringType Source #

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

data RelationalError Source #

Constructors

NoSuchAttributeNamesError (Set AttributeName) 
TupleAttributeCountMismatchError Int 
TupleAttributeTypeMismatchError Attributes 
AttributeCountMismatchError Int 
AttributeNamesMismatchError (Set AttributeName) 
AttributeNameInUseError AttributeName 
AttributeIsNotRelationValuedError AttributeName 
CouldNotInferAttributes 
RelVarNotDefinedError RelVarName 
RelVarAlreadyDefinedError RelVarName 
RelVarAssignmentTypeMismatchError Attributes Attributes 
InclusionDependencyCheckError IncDepName 
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 AtomFunctionName 
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 AtomFunctionName TypeVarName 
AtomFunctionTypeVariableMismatch TypeVarName AtomType AtomType 
AtomTypeNameInUseError AtomTypeName 
IncompletelyDefinedAtomTypeWithConstructorError 
AtomTypeNameNotInUseError AtomTypeName 
FunctionNameInUseError AtomFunctionName 
FunctionNameNotInUseError AtomFunctionName 
EmptyCommitError 
FunctionArgumentCountMismatchError Int Int 
ConstructedAtomArgumentCountMismatchError Int Int 
NoSuchDataConstructorError DataConstructorName 
NoSuchTypeConstructorError TypeConstructorName 
InvalidAtomTypeName AtomTypeName 
AtomTypeNotSupported AttributeName 
AtomOperatorNotSupported Text 
EmptyTuplesError 
AtomTypeCountError [AtomType] [AtomType] 
AtomFunctionTypeError AtomFunctionName Int AtomType AtomType 
AtomFunctionUserError AtomFunctionError 
PrecompiledFunctionRemoveError AtomFunctionName 
RelationValuedAttributesNotSupportedError [AttributeName] 
NotificationNameInUseError NotificationName 
NotificationNameNotInUseError NotificationName 
ImportError Text 
ExportError Text 
UnhandledExceptionError String 
MergeTransactionError MergeError 
ScriptError ScriptCompilationError 
DatabaseContextFunctionUserError DatabaseContextFunctionError 
DatabaseLoadError PersistenceError 
SubschemaNameInUseError SchemaName 
SubschemaNameNotInUseError SchemaName 
SchemaCreationError SchemaError 
ImproperDatabaseStateError 
MultipleErrors [RelationalError] 

Instances

Eq RelationalError Source # 
Show RelationalError Source # 
Generic RelationalError Source # 
Binary RelationalError Source # 
NFData RelationalError Source # 

Methods

rnf :: RelationalError -> () #

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

data AtomType Source #

The AtomType uniquely identifies the type of a atom.

Instances

Eq AtomType Source # 
Show AtomType Source # 
Generic AtomType Source # 

Associated Types

type Rep AtomType :: * -> * #

Methods

from :: AtomType -> Rep AtomType x #

to :: Rep AtomType x -> AtomType #

Hashable TypeVarMap Source # 
Binary AtomType Source # 

Methods

put :: AtomType -> Put #

get :: Get AtomType #

putList :: [AtomType] -> Put #

NFData AtomType Source # 

Methods

rnf :: AtomType -> () #

type Rep AtomType Source # 

class (Eq a, NFData a, Binary 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.

Methods

toAtom :: a -> Atom Source #

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

fromAtom :: Atom -> a Source #

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

toAtomType :: proxy a -> AtomType Source #

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.

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

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

Instances

Atomable Bool Source # 
Atomable Double Source # 
Atomable Int Source # 
Atomable Integer Source # 
Atomable ByteString Source # 
Atomable Text Source # 
Atomable UTCTime Source # 
Atomable Day Source # 
Atomable a => Atomable [a] Source # 
Atomable a => Atomable (Maybe a) Source # 
(Atomable a, Atomable b) => Atomable (Either a b) Source # 

newtype TupleExprBase a Source #

Dynamically create a tuple from attribute names and AtomExprs.

Instances

Binary TupleExpr Source # 
Eq a => Eq (TupleExprBase a) Source # 
Show a => Show (TupleExprBase a) Source # 
Generic (TupleExprBase a) Source # 

Associated Types

type Rep (TupleExprBase a) :: * -> * #

NFData a => NFData (TupleExprBase a) Source # 

Methods

rnf :: TupleExprBase a -> () #

type Rep (TupleExprBase a) Source # 
type Rep (TupleExprBase a) = D1 (MetaData "TupleExprBase" "ProjectM36.Base" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" True) (C1 (MetaCons "TupleExpr" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map AttributeName (AtomExprBase 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

Binary AtomExpr Source # 

Methods

put :: AtomExpr -> Put #

get :: Get AtomExpr #

putList :: [AtomExpr] -> Put #

Eq a => Eq (AtomExprBase a) Source # 
Show a => Show (AtomExprBase a) Source # 
Generic (AtomExprBase a) Source # 

Associated Types

type Rep (AtomExprBase a) :: * -> * #

Methods

from :: AtomExprBase a -> Rep (AtomExprBase a) x #

to :: Rep (AtomExprBase a) x -> AtomExprBase a #

NFData a => NFData (AtomExprBase a) Source # 

Methods

rnf :: AtomExprBase a -> () #

type Rep (AtomExprBase a) Source # 

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

Binary RestrictionPredicateExpr Source # 
Eq a => Eq (RestrictionPredicateExprBase a) Source # 
Show a => Show (RestrictionPredicateExprBase a) Source # 
Generic (RestrictionPredicateExprBase a) Source # 
NFData a => NFData (RestrictionPredicateExprBase a) Source # 
type Rep (RestrictionPredicateExprBase a) Source # 
type Rep (RestrictionPredicateExprBase a) = D1 (MetaData "RestrictionPredicateExprBase" "ProjectM36.Base" "project-m36-0.3-6ISpcBZwnv1Gd5svoztbSh" False) ((:+:) ((:+:) (C1 (MetaCons "TruePredicate" PrefixI False) U1) ((:+:) (C1 (MetaCons "AndPredicate" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))))) (C1 (MetaCons "OrPredicate" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a))))))) ((:+:) ((:+:) (C1 (MetaCons "NotPredicate" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RestrictionPredicateExprBase a)))) (C1 (MetaCons "RelationalExprPredicate" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (RelationalExprBase a))))) ((:+:) (C1 (MetaCons "AtomExprPredicate" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (AtomExprBase a)))) (C1 (MetaCons "AttributeEqualityPredicate" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AttributeName)) (S1 (MetaSel (Nothing 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.