-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Relational Algebra Engine -- -- A relational algebra engine which can be used to persist and query -- Haskell data types. @package project-m36 @version 1.1.1 module ProjectM36.AtomFunctionError data AtomFunctionError AtomFunctionUserError :: String -> AtomFunctionError AtomFunctionTypeMismatchError :: AtomFunctionError AtomFunctionParseError :: String -> AtomFunctionError InvalidIntervalOrderingError :: AtomFunctionError InvalidIntervalBoundariesError :: AtomFunctionError AtomFunctionAttributeNameNotFoundError :: Text -> AtomFunctionError InvalidIntBoundError :: AtomFunctionError InvalidUUIDString :: Text -> AtomFunctionError RelationAtomExpectedError :: Text -> AtomFunctionError AtomFunctionEmptyRelationError :: AtomFunctionError AtomTypeDoesNotSupportOrderingError :: Text -> AtomFunctionError AtomTypeDoesNotSupportIntervalError :: Text -> AtomFunctionError AtomFunctionBytesDecodingError :: String -> AtomFunctionError instance Control.DeepSeq.NFData ProjectM36.AtomFunctionError.AtomFunctionError instance GHC.Show.Show ProjectM36.AtomFunctionError.AtomFunctionError instance GHC.Classes.Eq ProjectM36.AtomFunctionError.AtomFunctionError instance GHC.Generics.Generic ProjectM36.AtomFunctionError.AtomFunctionError module ProjectM36.DatabaseContextFunctionError data DatabaseContextFunctionError DatabaseContextFunctionUserError :: String -> DatabaseContextFunctionError instance Control.DeepSeq.NFData ProjectM36.DatabaseContextFunctionError.DatabaseContextFunctionError instance GHC.Show.Show ProjectM36.DatabaseContextFunctionError.DatabaseContextFunctionError instance GHC.Classes.Eq ProjectM36.DatabaseContextFunctionError.DatabaseContextFunctionError instance GHC.Generics.Generic ProjectM36.DatabaseContextFunctionError.DatabaseContextFunctionError module ProjectM36.FSType type CStatFS = () c_statfs :: CString -> Ptr CStatFS -> IO CInt type CFSType = Word64 sizeofStructStatFS :: Int fsTypeSupportsJournaling :: FilePath -> IO Bool module ProjectM36.FileLock lockStruct :: LockRequest -> FileLock newtype LockFile LockFile :: Fd -> LockFile openLockFile :: FilePath -> IO LockFile closeLockFile :: LockFile -> IO () lockFile :: LockFile -> LockType -> IO () unlockFile :: LockFile -> IO () data LockType ReadLock :: LockType WriteLock :: LockType instance GHC.Show.Show ProjectM36.FileLock.LockType module ProjectM36.MerkleHash newtype MerkleHash MerkleHash :: ByteString -> MerkleHash [_unMerkleHash] :: MerkleHash -> ByteString instance Control.DeepSeq.NFData ProjectM36.MerkleHash.MerkleHash instance GHC.Base.Semigroup ProjectM36.MerkleHash.MerkleHash instance GHC.Base.Monoid ProjectM36.MerkleHash.MerkleHash instance GHC.Generics.Generic ProjectM36.MerkleHash.MerkleHash instance GHC.Classes.Eq ProjectM36.MerkleHash.MerkleHash instance GHC.Show.Show ProjectM36.MerkleHash.MerkleHash module ProjectM36.Base type StringType = Text type DatabaseName = String -- | Database atoms are the smallest, undecomposable units of a tuple. -- Common examples are integers, text, or unique identity keys. data Atom IntegerAtom :: !Integer -> Atom IntAtom :: !Int -> Atom ScientificAtom :: !Scientific -> Atom DoubleAtom :: !Double -> Atom TextAtom :: !Text -> Atom DayAtom :: !Day -> Atom DateTimeAtom :: !UTCTime -> Atom ByteStringAtom :: !ByteString -> Atom BoolAtom :: !Bool -> Atom UUIDAtom :: !UUID -> Atom RelationAtom :: !Relation -> Atom RelationalExprAtom :: !RelationalExpr -> Atom SubrelationFoldAtom :: !Relation -> !AttributeName -> Atom ConstructedAtom :: !DataConstructorName -> !AtomType -> [Atom] -> Atom -- | The AtomType uniquely identifies the type of a atom. data AtomType IntAtomType :: AtomType IntegerAtomType :: AtomType ScientificAtomType :: AtomType DoubleAtomType :: AtomType TextAtomType :: AtomType DayAtomType :: AtomType DateTimeAtomType :: AtomType ByteStringAtomType :: AtomType BoolAtomType :: AtomType UUIDAtomType :: AtomType RelationAtomType :: Attributes -> AtomType SubrelationFoldAtomType :: AtomType -> AtomType ConstructedAtomType :: TypeConstructorName -> TypeVarMap -> AtomType RelationalExprAtomType :: AtomType TypeVariableType :: TypeVarName -> AtomType type TypeVarMap = Map TypeVarName AtomType -- | Return True iff the atom type argument is relation-valued. If True, -- this indicates that the Atom contains a relation. isRelationAtomType :: AtomType -> Bool attributesContainRelationAtomType :: Attributes -> Bool -- | The AttributeName is the name of an attribute in a relation. type AttributeName = StringType -- | A relation's type is composed of attribute names and types. data Attribute Attribute :: AttributeName -> AtomType -> Attribute type AttributesHash = Int -- | Attributes represent the head of a relation. newtype Attributes Attributes :: Vector Attribute -> Attributes [attributesVec] :: Attributes -> Vector Attribute attributesSet :: Attributes -> HashSet Attribute sortedAttributesIndices :: Attributes -> [(Int, Attribute)] -- | The relation's tuple set is the body of the relation. newtype RelationTupleSet RelationTupleSet :: [RelationTuple] -> RelationTupleSet [asList] :: RelationTupleSet -> [RelationTuple] -- | A tuple is a set of attributes mapped to their Atom values. data RelationTuple RelationTuple :: Attributes -> Vector Atom -> RelationTuple data Relation Relation :: Attributes -> RelationTupleSet -> Relation -- | Used to represent the number of tuples in a relation. data RelationCardinality Countable :: RelationCardinality Finite :: Int -> RelationCardinality -- | Relation variables are identified by their names. type RelVarName = StringType type RelationalExpr = RelationalExprBase () -- | A relational expression represents query (read) operations on a -- database. data RelationalExprBase a MakeRelationFromExprs :: Maybe [AttributeExprBase a] -> TupleExprsBase a -> RelationalExprBase a MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExprBase a ExistingRelation :: Relation -> RelationalExprBase a RelationVariable :: RelVarName -> a -> RelationalExprBase a -- | Extract a relation from an Atom that is a nested relation (a -- relation within a relation). RelationValuedAttribute :: AttributeName -> RelationalExprBase a Project :: AttributeNamesBase a -> RelationalExprBase a -> RelationalExprBase a Union :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Join :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Rename :: Set (AttributeName, AttributeName) -> RelationalExprBase a -> RelationalExprBase a Difference :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Group :: AttributeNamesBase a -> AttributeName -> RelationalExprBase a -> RelationalExprBase a Ungroup :: AttributeName -> RelationalExprBase a -> RelationalExprBase a Restrict :: RestrictionPredicateExprBase a -> RelationalExprBase a -> RelationalExprBase a Equals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a NotEquals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Extend :: ExtendTupleExprBase a -> RelationalExprBase a -> RelationalExprBase a With :: WithNamesAssocsBase a -> RelationalExprBase a -> RelationalExprBase a type WithNamesAssocs = WithNamesAssocsBase () type WithNamesAssocsBase a = [(WithNameExprBase a, RelationalExprBase a)] type GraphRefWithNameAssocs = [(GraphRefWithNameExpr, GraphRefRelationalExpr)] data WithNameExprBase a WithNameExpr :: RelVarName -> a -> WithNameExprBase a type WithNameExpr = WithNameExprBase () type GraphRefWithNameExpr = WithNameExprBase GraphRefTransactionMarker type NotificationName = StringType type Notifications = Map NotificationName Notification -- | When the changeExpr returns a different result in the database -- context, then the reportExpr is triggered and sent asynchronously to -- all clients. data Notification Notification :: RelationalExpr -> RelationalExpr -> RelationalExpr -> Notification [changeExpr] :: Notification -> RelationalExpr [reportOldExpr] :: Notification -> RelationalExpr [reportNewExpr] :: Notification -> RelationalExpr data NotificationExpression NotificationChangeExpression :: NotificationExpression NotificationReportOldExpression :: NotificationExpression NotificationReportNewExpression :: NotificationExpression type TypeVarName = StringType -- | Metadata definition for type constructors such as data Either a -- b. data TypeConstructorDef ADTypeConstructorDef :: TypeConstructorName -> [TypeVarName] -> TypeConstructorDef PrimitiveTypeConstructorDef :: TypeConstructorName -> AtomType -> TypeConstructorDef -- | Found in data constructors and type declarations: Left (Either Int -- Text) | Right Int type TypeConstructor = TypeConstructorBase () data TypeConstructorBase a ADTypeConstructor :: TypeConstructorName -> [TypeConstructor] -> TypeConstructorBase a PrimitiveTypeConstructor :: TypeConstructorName -> AtomType -> TypeConstructorBase a RelationAtomTypeConstructor :: [AttributeExprBase a] -> TypeConstructorBase a TypeVariable :: TypeVarName -> TypeConstructorBase a type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)] type TypeConstructorName = StringType type TypeConstructorArgName = StringType type DataConstructorName = StringType type AtomTypeName = StringType -- | Used to define a data constructor in a type constructor context such -- as Left a | Right b data DataConstructorDef DataConstructorDef :: DataConstructorName -> [DataConstructorDefArg] -> DataConstructorDef type DataConstructorDefs = [DataConstructorDef] data DataConstructorDefArg DataConstructorDefTypeConstructorArg :: TypeConstructor -> DataConstructorDefArg DataConstructorDefTypeVarNameArg :: TypeVarName -> DataConstructorDefArg type InclusionDependencies = Map IncDepName InclusionDependency type RelationVariables = Map RelVarName GraphRefRelationalExpr data GraphRefTransactionMarker TransactionMarker :: TransactionId -> GraphRefTransactionMarker UncommittedContextMarker :: GraphRefTransactionMarker type GraphRefRelationalExpr = RelationalExprBase GraphRefTransactionMarker type SchemaName = StringType type Subschemas = Map SchemaName Schema -- | Every transaction has one concrete database context and any number of -- isomorphic subschemas. data Schemas Schemas :: DatabaseContext -> Subschemas -> Schemas -- | The DatabaseContext is a snapshot of a database's evolving state and -- contains everything a database client can change over time. I spent -- some time thinking about whether the VirtualDatabaseContext/Schema and -- DatabaseContext data constructors should be the same constructor, but -- that would allow relation variables to be created in a "virtual" -- context which would appear to defeat the isomorphisms of the contexts. -- It should be possible to switch to an alternative schema to view the -- same equivalent information without information loss. However, -- allowing all contexts to reference another context while maintaining -- its own relation variables, new types, etc. could be interesting from -- a security perspective. For example, if a user creates a new relvar in -- a virtual context, then does it necessarily appear in all linked -- contexts? After deliberation, I think the relvar should appear in -- *all* linked contexts to retain the isomorphic properties, even when -- the isomorphism is for a subset of the context. This hints that the -- IsoMorphs should allow for "fall-through"; that is, when a relvar is -- not defined in the virtual context (for morphing), then the lookup -- should fall through to the underlying context. newtype Schema Schema :: SchemaIsomorphs -> Schema data SchemaIsomorph IsoRestrict :: RelVarName -> RestrictionPredicateExpr -> (RelVarName, RelVarName) -> SchemaIsomorph IsoRename :: RelVarName -> RelVarName -> SchemaIsomorph IsoUnion :: (RelVarName, RelVarName) -> RestrictionPredicateExpr -> RelVarName -> SchemaIsomorph type SchemaIsomorphs = [SchemaIsomorph] type RegisteredQueryName = StringType type RegisteredQueries = Map RegisteredQueryName RelationalExpr data DatabaseContext DatabaseContext :: InclusionDependencies -> RelationVariables -> AtomFunctions -> DatabaseContextFunctions -> Notifications -> TypeConstructorMapping -> RegisteredQueries -> DatabaseContext [inclusionDependencies] :: DatabaseContext -> InclusionDependencies [relationVariables] :: DatabaseContext -> RelationVariables [atomFunctions] :: DatabaseContext -> AtomFunctions [dbcFunctions] :: DatabaseContext -> DatabaseContextFunctions [notifications] :: DatabaseContext -> Notifications [typeConstructorMapping] :: DatabaseContext -> TypeConstructorMapping [registeredQueries] :: DatabaseContext -> RegisteredQueries type IncDepName = StringType -- | Inclusion dependencies represent every possible database constraint. -- Constraints enforce specific, arbitrarily-complex rules to which the -- database context's relation variables must adhere unconditionally. data InclusionDependency InclusionDependency :: RelationalExpr -> RelationalExpr -> InclusionDependency type AttributeNameAtomExprMap = Map AttributeName AtomExpr type DatabaseContextExprName = StringType type DatabaseContextExpr = DatabaseContextExprBase () type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker -- | Database context expressions modify the database context. data DatabaseContextExprBase a NoOperation :: DatabaseContextExprBase a Define :: RelVarName -> [AttributeExprBase a] -> DatabaseContextExprBase a Undefine :: RelVarName -> DatabaseContextExprBase a Assign :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Insert :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Delete :: RelVarName -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a Update :: RelVarName -> AttributeNameAtomExprMap -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a AddInclusionDependency :: IncDepName -> InclusionDependency -> DatabaseContextExprBase a RemoveInclusionDependency :: IncDepName -> DatabaseContextExprBase a AddNotification :: NotificationName -> RelationalExpr -> RelationalExpr -> RelationalExpr -> DatabaseContextExprBase a RemoveNotification :: NotificationName -> DatabaseContextExprBase a AddTypeConstructor :: TypeConstructorDef -> [DataConstructorDef] -> DatabaseContextExprBase a RemoveTypeConstructor :: TypeConstructorName -> DatabaseContextExprBase a RemoveAtomFunction :: FunctionName -> DatabaseContextExprBase a RemoveDatabaseContextFunction :: FunctionName -> DatabaseContextExprBase a ExecuteDatabaseContextFunction :: FunctionName -> [AtomExprBase a] -> DatabaseContextExprBase a AddRegisteredQuery :: RegisteredQueryName -> RelationalExpr -> DatabaseContextExprBase a RemoveRegisteredQuery :: RegisteredQueryName -> DatabaseContextExprBase a MultipleExpr :: [DatabaseContextExprBase a] -> DatabaseContextExprBase a type ObjModuleName = StringType type ObjFunctionName = StringType type Range = (Int, Int) -- | Adding an atom function should be nominally a DatabaseExpr except for -- the fact that it cannot be performed purely. Thus, we create the -- DatabaseContextIOExpr. data DatabaseContextIOExprBase a AddAtomFunction :: FunctionName -> [TypeConstructor] -> FunctionBodyScript -> DatabaseContextIOExprBase a LoadAtomFunctions :: ObjModuleName -> ObjFunctionName -> FilePath -> DatabaseContextIOExprBase a AddDatabaseContextFunction :: FunctionName -> [TypeConstructor] -> FunctionBodyScript -> DatabaseContextIOExprBase a LoadDatabaseContextFunctions :: ObjModuleName -> ObjFunctionName -> FilePath -> DatabaseContextIOExprBase a CreateArbitraryRelation :: RelVarName -> [AttributeExprBase a] -> Range -> DatabaseContextIOExprBase a type GraphRefDatabaseContextIOExpr = DatabaseContextIOExprBase GraphRefTransactionMarker type DatabaseContextIOExpr = DatabaseContextIOExprBase () type RestrictionPredicateExpr = RestrictionPredicateExprBase () type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker -- | Restriction predicates are boolean algebra components which, when -- composed, indicate whether or not a tuple should be retained during a -- restriction (filtering) operation. data RestrictionPredicateExprBase a TruePredicate :: RestrictionPredicateExprBase a AndPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a OrPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a NotPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a RelationalExprPredicate :: RelationalExprBase a -> RestrictionPredicateExprBase a AtomExprPredicate :: AtomExprBase a -> RestrictionPredicateExprBase a AttributeEqualityPredicate :: AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a -- | 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. type HeadName = StringType type TransactionHeads = Map HeadName Transaction -- | The transaction graph is the global database's state which references -- every committed transaction. data TransactionGraph TransactionGraph :: TransactionHeads -> Set Transaction -> TransactionGraph transactionHeadsForGraph :: TransactionGraph -> TransactionHeads transactionsForGraph :: TransactionGraph -> Set Transaction transactionIdsForGraph :: TransactionGraph -> Set TransactionId -- | Every transaction has context-specific information attached to it. The -- TransactionDiffs represent child/edge relationships to -- previous transactions (branches or continuations of the same branch). data TransactionInfo TransactionInfo :: TransactionParents -> UTCTime -> MerkleHash -> TransactionInfo [parents] :: TransactionInfo -> TransactionParents [stamp] :: TransactionInfo -> UTCTime [merkleHash] :: TransactionInfo -> MerkleHash type TransactionParents = NonEmpty TransactionId -- | Every set of modifications made to the database are atomically -- committed to the transaction graph as a transaction. type TransactionId = UUID data Transaction Transaction :: TransactionId -> TransactionInfo -> Schemas -> Transaction -- | The disconnected transaction represents an in-progress workspace used -- by sessions before changes are committed. This is similar to git's -- "index". After a transaction is committed, it is "connected" in the -- transaction graph and can no longer be modified. data DisconnectedTransaction DisconnectedTransaction :: TransactionId -> Schemas -> DirtyFlag -> DisconnectedTransaction type DirtyFlag = Bool type TransactionDiffExpr = DatabaseContextExpr transactionId :: Transaction -> TransactionId transactionInfo :: Transaction -> TransactionInfo type AtomExpr = AtomExprBase () type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker type AggAtomFuncExprInfo = (AttributeName, AttributeName) -- | An atom expression represents an action to take when extending a -- relation or when statically defining a relation or a new tuple. data AtomExprBase a AttributeAtomExpr :: AttributeName -> AtomExprBase a SubrelationAttributeAtomExpr :: AttributeName -> AttributeName -> AtomExprBase a NakedAtomExpr :: !Atom -> AtomExprBase a FunctionAtomExpr :: !FunctionName -> [AtomExprBase a] -> a -> AtomExprBase a RelationAtomExpr :: RelationalExprBase a -> AtomExprBase a IfThenAtomExpr :: AtomExprBase a -> AtomExprBase a -> AtomExprBase a -> AtomExprBase a ConstructedAtomExpr :: DataConstructorName -> [AtomExprBase a] -> a -> AtomExprBase a -- | Used in tuple creation when creating a relation. data ExtendTupleExprBase a AttributeExtendTupleExpr :: AttributeName -> AtomExprBase a -> ExtendTupleExprBase a type ExtendTupleExpr = ExtendTupleExprBase () type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker type AtomFunctions = HashSet AtomFunction type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom type ObjectFileEntryFunctionName = String type ObjectFilePath = FilePath type ObjectModuleName = String -- | 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"). data AttributeNamesBase a AttributeNames :: Set AttributeName -> AttributeNamesBase a InvertedAttributeNames :: Set AttributeName -> AttributeNamesBase a UnionAttributeNames :: AttributeNamesBase a -> AttributeNamesBase a -> AttributeNamesBase a IntersectAttributeNames :: AttributeNamesBase a -> AttributeNamesBase a -> AttributeNamesBase a RelationalExprAttributeNames :: RelationalExprBase a -> AttributeNamesBase a type AttributeNames = AttributeNamesBase () type GraphRefAttributeNames = AttributeNamesBase GraphRefTransactionMarker -- | The persistence strategy is a global database option which represents -- how to persist the database in the filesystem, if at all. data PersistenceStrategy -- | no filesystem persistence/memory-only database NoPersistence :: PersistenceStrategy -- | fsync off, not crash-safe MinimalPersistence :: FilePath -> PersistenceStrategy -- | full fsync to disk (flushes kernel and physical drive buffers to -- ensure that the transaction is on non-volatile storage) CrashSafePersistence :: FilePath -> PersistenceStrategy persistenceDirectory :: PersistenceStrategy -> Maybe FilePath type AttributeExpr = AttributeExprBase () type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker -- | Create attributes dynamically. data AttributeExprBase a AttributeAndTypeNameExpr :: AttributeName -> TypeConstructor -> a -> AttributeExprBase a NakedAttributeExpr :: Attribute -> AttributeExprBase a -- | Dynamically create a tuple from attribute names and AtomExprs. newtype TupleExprBase a TupleExpr :: Map AttributeName (AtomExprBase a) -> TupleExprBase a type TupleExpr = TupleExprBase () type GraphRefTupleExpr = TupleExprBase GraphRefTransactionMarker data TupleExprsBase a TupleExprs :: a -> [TupleExprBase a] -> TupleExprsBase a type GraphRefTupleExprs = TupleExprsBase GraphRefTransactionMarker type TupleExprs = TupleExprsBase () data MergeStrategy -- | 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) UnionMergeStrategy :: MergeStrategy -- | Similar to a union merge, but, on conflict, prefer the unmerged -- section (relvar, function, etc.) from the branch named as the -- argument. UnionPreferMergeStrategy :: HeadName -> MergeStrategy -- | 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. SelectedBranchMergeStrategy :: HeadName -> MergeStrategy type DatabaseContextFunctionBodyType = [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext type DatabaseContextFunctions = HashSet DatabaseContextFunction type FunctionName = StringType type FunctionBodyScript = StringType -- | Represents stored, user-created or built-in functions which can -- operates of types such as Atoms or DatabaseContexts. data Function a Function :: FunctionName -> [AtomType] -> FunctionBody a -> Function a [funcName] :: Function a -> FunctionName [funcType] :: Function a -> [AtomType] [funcBody] :: Function a -> FunctionBody a data FunctionBody a FunctionScriptBody :: FunctionBodyScript -> a -> FunctionBody a FunctionBuiltInBody :: a -> FunctionBody a FunctionObjectLoadedBody :: FilePath -> ObjectModuleName -> ObjectFileEntryFunctionName -> a -> FunctionBody a type AtomFunction = Function AtomFunctionBodyType type AtomFunctionBody = FunctionBody AtomFunctionBodyType type DatabaseContextFunction = Function DatabaseContextFunctionBodyType type DatabaseContextFunctionBody = FunctionBody DatabaseContextFunctionBodyType attrTypeVars :: Attribute -> Set TypeVarName typeVars :: TypeConstructor -> Set TypeVarName attrExprTypeVars :: AttributeExprBase a -> Set TypeVarName atomTypeVars :: AtomType -> Set TypeVarName unimplemented :: HasCallStack => a data RelationalExprBaseF (a_atFz :: Type) r_aFZb MakeRelationFromExprsF :: Maybe [AttributeExprBase a_atFz] -> TupleExprsBase a_atFz -> RelationalExprBaseF (a_atFz :: Type) r_aFZb MakeStaticRelationF :: Attributes -> RelationTupleSet -> RelationalExprBaseF (a_atFz :: Type) r_aFZb ExistingRelationF :: Relation -> RelationalExprBaseF (a_atFz :: Type) r_aFZb RelationVariableF :: Text -> a_atFz -> RelationalExprBaseF (a_atFz :: Type) r_aFZb RelationValuedAttributeF :: Text -> RelationalExprBaseF (a_atFz :: Type) r_aFZb ProjectF :: AttributeNamesBase a_atFz -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb UnionF :: r_aFZb -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb JoinF :: r_aFZb -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb RenameF :: Set (Text, Text) -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb DifferenceF :: r_aFZb -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb GroupF :: AttributeNamesBase a_atFz -> Text -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb UngroupF :: Text -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb RestrictF :: RestrictionPredicateExprBase a_atFz -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb EqualsF :: r_aFZb -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb NotEqualsF :: r_aFZb -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb ExtendF :: ExtendTupleExprBase a_atFz -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb WithF :: [(WithNameExprBase a_atFz, r_aFZb)] -> r_aFZb -> RelationalExprBaseF (a_atFz :: Type) r_aFZb instance Data.Traversable.Traversable (ProjectM36.Base.RelationalExprBaseF a) instance Data.Foldable.Foldable (ProjectM36.Base.RelationalExprBaseF a) instance GHC.Base.Functor (ProjectM36.Base.RelationalExprBaseF a) instance Data.Functor.Foldable.Recursive (ProjectM36.Base.RelationalExprBase a) instance Data.Functor.Foldable.Corecursive (ProjectM36.Base.RelationalExprBase a) instance GHC.Classes.Ord ProjectM36.Base.RelationCardinality instance GHC.Generics.Generic ProjectM36.Base.RelationCardinality instance GHC.Show.Show ProjectM36.Base.RelationCardinality instance GHC.Classes.Eq ProjectM36.Base.RelationCardinality instance Data.Hashable.Class.Hashable a => Data.Hashable.Class.Hashable (ProjectM36.Base.WithNameExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.WithNameExprBase instance GHC.Base.Functor ProjectM36.Base.WithNameExprBase instance Data.Foldable.Foldable ProjectM36.Base.WithNameExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.WithNameExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.WithNameExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.WithNameExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.WithNameExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.WithNameExprBase a) instance Control.DeepSeq.NFData ProjectM36.Base.NotificationExpression instance GHC.Generics.Generic ProjectM36.Base.NotificationExpression instance GHC.Classes.Eq ProjectM36.Base.NotificationExpression instance GHC.Show.Show ProjectM36.Base.NotificationExpression instance Control.DeepSeq.NFData ProjectM36.Base.Attribute instance GHC.Generics.Generic ProjectM36.Base.Attribute instance GHC.Read.Read ProjectM36.Base.Attribute instance GHC.Show.Show ProjectM36.Base.Attribute instance GHC.Classes.Eq ProjectM36.Base.Attribute instance GHC.Generics.Generic ProjectM36.Base.Attributes instance Data.Hashable.Class.Hashable ProjectM36.Base.Attributes instance GHC.Read.Read ProjectM36.Base.Attributes instance Control.DeepSeq.NFData ProjectM36.Base.Attributes instance Data.Hashable.Class.Hashable ProjectM36.Base.AtomType instance GHC.Read.Read ProjectM36.Base.AtomType instance GHC.Show.Show ProjectM36.Base.AtomType instance GHC.Generics.Generic ProjectM36.Base.AtomType instance Control.DeepSeq.NFData ProjectM36.Base.AtomType instance GHC.Classes.Eq ProjectM36.Base.AtomType instance GHC.Read.Read ProjectM36.Base.TypeConstructorDef instance Data.Hashable.Class.Hashable ProjectM36.Base.TypeConstructorDef instance Control.DeepSeq.NFData ProjectM36.Base.TypeConstructorDef instance GHC.Classes.Eq ProjectM36.Base.TypeConstructorDef instance GHC.Generics.Generic ProjectM36.Base.TypeConstructorDef instance GHC.Show.Show ProjectM36.Base.TypeConstructorDef instance GHC.Generics.Generic ProjectM36.Base.TransactionInfo instance GHC.Show.Show ProjectM36.Base.TransactionInfo instance GHC.Classes.Ord ProjectM36.Base.GraphRefTransactionMarker instance Control.DeepSeq.NFData ProjectM36.Base.GraphRefTransactionMarker instance GHC.Generics.Generic ProjectM36.Base.GraphRefTransactionMarker instance GHC.Show.Show ProjectM36.Base.GraphRefTransactionMarker instance GHC.Classes.Eq ProjectM36.Base.GraphRefTransactionMarker instance GHC.Read.Read ProjectM36.Base.PersistenceStrategy instance GHC.Show.Show ProjectM36.Base.PersistenceStrategy instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.TypeConstructorBase a) instance Data.Hashable.Class.Hashable a => Data.Hashable.Class.Hashable (ProjectM36.Base.TypeConstructorBase a) instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.TypeConstructorBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.TypeConstructorBase a) instance GHC.Generics.Generic (ProjectM36.Base.TypeConstructorBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.TypeConstructorBase a) instance Data.Hashable.Class.Hashable a => Data.Hashable.Class.Hashable (ProjectM36.Base.AttributeExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.AttributeExprBase instance GHC.Base.Functor ProjectM36.Base.AttributeExprBase instance Data.Foldable.Foldable ProjectM36.Base.AttributeExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.AttributeExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.AttributeExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.AttributeExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.AttributeExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.AttributeExprBase a) instance GHC.Read.Read ProjectM36.Base.DataConstructorDefArg instance Data.Hashable.Class.Hashable ProjectM36.Base.DataConstructorDefArg instance Control.DeepSeq.NFData ProjectM36.Base.DataConstructorDefArg instance GHC.Classes.Eq ProjectM36.Base.DataConstructorDefArg instance GHC.Generics.Generic ProjectM36.Base.DataConstructorDefArg instance GHC.Show.Show ProjectM36.Base.DataConstructorDefArg instance GHC.Read.Read ProjectM36.Base.DataConstructorDef instance Data.Hashable.Class.Hashable ProjectM36.Base.DataConstructorDef instance Control.DeepSeq.NFData ProjectM36.Base.DataConstructorDef instance GHC.Generics.Generic ProjectM36.Base.DataConstructorDef instance GHC.Show.Show ProjectM36.Base.DataConstructorDef instance GHC.Classes.Eq ProjectM36.Base.DataConstructorDef instance Control.DeepSeq.NFData ProjectM36.Base.MergeStrategy instance GHC.Generics.Generic ProjectM36.Base.MergeStrategy instance GHC.Show.Show ProjectM36.Base.MergeStrategy instance GHC.Classes.Eq ProjectM36.Base.MergeStrategy instance GHC.Read.Read ProjectM36.Base.Atom instance GHC.Generics.Generic ProjectM36.Base.Atom instance Control.DeepSeq.NFData ProjectM36.Base.Atom instance GHC.Show.Show ProjectM36.Base.Atom instance GHC.Classes.Eq ProjectM36.Base.Atom instance GHC.Generics.Generic ProjectM36.Base.RelationTuple instance GHC.Read.Read ProjectM36.Base.RelationTuple instance GHC.Show.Show ProjectM36.Base.RelationTuple instance GHC.Read.Read ProjectM36.Base.RelationTupleSet instance GHC.Generics.Generic ProjectM36.Base.RelationTupleSet instance GHC.Show.Show ProjectM36.Base.RelationTupleSet instance GHC.Generics.Generic ProjectM36.Base.Relation instance GHC.Show.Show ProjectM36.Base.Relation instance Data.Traversable.Traversable ProjectM36.Base.RestrictionPredicateExprBase instance GHC.Base.Functor ProjectM36.Base.RestrictionPredicateExprBase instance Data.Foldable.Foldable ProjectM36.Base.RestrictionPredicateExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.RestrictionPredicateExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.RestrictionPredicateExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.RestrictionPredicateExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.RestrictionPredicateExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.RestrictionPredicateExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.ExtendTupleExprBase instance GHC.Base.Functor ProjectM36.Base.ExtendTupleExprBase instance Data.Foldable.Foldable ProjectM36.Base.ExtendTupleExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.ExtendTupleExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.ExtendTupleExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.ExtendTupleExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.ExtendTupleExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.ExtendTupleExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.AttributeNamesBase instance GHC.Base.Functor ProjectM36.Base.AttributeNamesBase instance Data.Foldable.Foldable ProjectM36.Base.AttributeNamesBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.AttributeNamesBase a) instance GHC.Generics.Generic (ProjectM36.Base.AttributeNamesBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.AttributeNamesBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.AttributeNamesBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.AttributeNamesBase a) instance Data.Traversable.Traversable ProjectM36.Base.TupleExprBase instance GHC.Base.Functor ProjectM36.Base.TupleExprBase instance Data.Foldable.Foldable ProjectM36.Base.TupleExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.TupleExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.TupleExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.TupleExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.TupleExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.TupleExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.TupleExprsBase instance GHC.Base.Functor ProjectM36.Base.TupleExprsBase instance Data.Foldable.Foldable ProjectM36.Base.TupleExprsBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.TupleExprsBase a) instance GHC.Generics.Generic (ProjectM36.Base.TupleExprsBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.TupleExprsBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.TupleExprsBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.TupleExprsBase a) instance Data.Traversable.Traversable ProjectM36.Base.RelationalExprBase instance GHC.Base.Functor ProjectM36.Base.RelationalExprBase instance Data.Foldable.Foldable ProjectM36.Base.RelationalExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.RelationalExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.RelationalExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.RelationalExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.RelationalExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.RelationalExprBase a) instance Data.Traversable.Traversable ProjectM36.Base.AtomExprBase instance GHC.Base.Functor ProjectM36.Base.AtomExprBase instance Data.Foldable.Foldable ProjectM36.Base.AtomExprBase instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.AtomExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.AtomExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.AtomExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.AtomExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.AtomExprBase a) instance GHC.Show.Show ProjectM36.Base.SchemaIsomorph instance GHC.Generics.Generic ProjectM36.Base.SchemaIsomorph instance GHC.Generics.Generic ProjectM36.Base.Schema instance GHC.Read.Read ProjectM36.Base.InclusionDependency instance Data.Hashable.Class.Hashable ProjectM36.Base.InclusionDependency instance Control.DeepSeq.NFData ProjectM36.Base.InclusionDependency instance GHC.Generics.Generic ProjectM36.Base.InclusionDependency instance GHC.Classes.Eq ProjectM36.Base.InclusionDependency instance GHC.Show.Show ProjectM36.Base.InclusionDependency instance Control.DeepSeq.NFData ProjectM36.Base.Notification instance GHC.Generics.Generic ProjectM36.Base.Notification instance GHC.Classes.Eq ProjectM36.Base.Notification instance GHC.Show.Show ProjectM36.Base.Notification instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.DatabaseContextExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.DatabaseContextExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.DatabaseContextExprBase a) instance GHC.Read.Read a => GHC.Read.Read (ProjectM36.Base.DatabaseContextExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.DatabaseContextExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.DatabaseContextIOExprBase a) instance GHC.Classes.Eq a => GHC.Classes.Eq (ProjectM36.Base.DatabaseContextIOExprBase a) instance GHC.Show.Show a => GHC.Show.Show (ProjectM36.Base.DatabaseContextIOExprBase a) instance GHC.Generics.Generic (ProjectM36.Base.FunctionBody a) instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.Function a) instance GHC.Generics.Generic (ProjectM36.Base.Function a) instance GHC.Generics.Generic ProjectM36.Base.DatabaseContext instance Control.DeepSeq.NFData ProjectM36.Base.DatabaseContext instance GHC.Generics.Generic ProjectM36.Base.Schemas instance GHC.Generics.Generic ProjectM36.Base.Transaction instance GHC.Generics.Generic ProjectM36.Base.TransactionGraph instance GHC.Classes.Eq ProjectM36.Base.Transaction instance GHC.Classes.Ord ProjectM36.Base.Transaction instance GHC.Classes.Eq (ProjectM36.Base.Function a) instance Data.Hashable.Class.Hashable (ProjectM36.Base.Function a) instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (ProjectM36.Base.FunctionBody a) instance Data.Hashable.Class.Hashable ProjectM36.Base.DatabaseContextExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.AttributeNames instance Data.Hashable.Class.Hashable ProjectM36.Base.RestrictionPredicateExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.AtomExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.ExtendTupleExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.TupleExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.TupleExprs instance Data.Hashable.Class.Hashable ProjectM36.Base.Atom instance Data.Hashable.Class.Hashable ProjectM36.Base.RelationTupleSet instance GHC.Read.Read ProjectM36.Base.Relation instance GHC.Classes.Eq ProjectM36.Base.RelationTupleSet instance Control.DeepSeq.NFData ProjectM36.Base.RelationTupleSet instance Data.Hashable.Class.Hashable ProjectM36.Base.RelationTuple instance GHC.Classes.Eq ProjectM36.Base.RelationTuple instance Control.DeepSeq.NFData ProjectM36.Base.RelationTuple instance GHC.Classes.Eq ProjectM36.Base.Relation instance Control.DeepSeq.NFData ProjectM36.Base.Relation instance Data.Hashable.Class.Hashable ProjectM36.Base.Relation instance Data.Hashable.Class.Hashable ProjectM36.Base.RelationalExpr instance Data.Hashable.Class.Hashable ProjectM36.Base.Attribute instance GHC.Show.Show ProjectM36.Base.Attributes instance GHC.Classes.Eq ProjectM36.Base.Attributes instance Data.Hashable.Class.Hashable Data.Time.Calendar.Days.Day instance Data.Hashable.Class.Hashable Data.Time.Clock.Internal.UTCTime.UTCTime instance Data.Hashable.Class.Hashable Data.Time.Clock.Internal.DiffTime.DiffTime module ProjectM36.GraphRefRelationalExpr data SingularTransactionRef SingularTransactionRef :: GraphRefTransactionMarker -> SingularTransactionRef MultipleTransactionsRef :: SingularTransactionRef NoTransactionsRef :: SingularTransactionRef -- | return `Just transid` if this GraphRefRelationalExpr refers to just -- one transaction in the graph. This is useful for determining if -- certain optimizations can apply. singularTransaction :: Foldable t => t GraphRefTransactionMarker -> SingularTransactionRef -- | Return True if two GraphRefRelationalExprs both refer -- exclusively to the same transaction (or none at all). inSameTransaction :: GraphRefRelationalExpr -> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker singularTransactions :: (Foldable f, Foldable t) => f (t GraphRefTransactionMarker) -> SingularTransactionRef instance GHC.Show.Show ProjectM36.GraphRefRelationalExpr.SingularTransactionRef instance GHC.Classes.Eq ProjectM36.GraphRefRelationalExpr.SingularTransactionRef instance GHC.Base.Semigroup ProjectM36.GraphRefRelationalExpr.SingularTransactionRef instance GHC.Base.Monoid ProjectM36.GraphRefRelationalExpr.SingularTransactionRef module ProjectM36.FunctionalDependency data FunctionalDependency FunctionalDependency :: AttributeNames -> AttributeNames -> RelationalExpr -> FunctionalDependency inclusionDependenciesForFunctionalDependency :: FunctionalDependency -> (InclusionDependency, InclusionDependency) module ProjectM36.DisconnectedTransaction concreteDatabaseContext :: DisconnectedTransaction -> DatabaseContext schemas :: DisconnectedTransaction -> Schemas loadGraphRefRelVarsOnly :: TransactionId -> Schemas -> Schemas parentId :: DisconnectedTransaction -> TransactionId isDirty :: DisconnectedTransaction -> Bool freshTransaction :: TransactionId -> Schemas -> DisconnectedTransaction module ProjectM36.DataTypes.Sorting compareAtoms :: Atom -> Atom -> Ordering isSortableAtomType :: AtomType -> Bool module ProjectM36.DataTypes.Primitive primitiveTypeConstructorMapping :: TypeConstructorMapping intTypeConstructor :: TypeConstructor doubleTypeConstructor :: TypeConstructor textTypeConstructor :: TypeConstructor dayTypeConstructor :: TypeConstructor dateTimeTypeConstructor :: TypeConstructor uUIDTypeConstructor :: TypeConstructor -- | Return the type of an Atom. atomTypeForAtom :: Atom -> AtomType module ProjectM36.DataTypes.Maybe maybeAtomType :: AtomType -> AtomType maybeTypeConstructorMapping :: TypeConstructorMapping maybeAtomFunctions :: AtomFunctions module ProjectM36.DataTypes.List listAtomType :: AtomType -> AtomType listTypeConstructorMapping :: TypeConstructorMapping listLength :: Atom -> Either AtomFunctionError Int listMaybeHead :: Atom -> Either AtomFunctionError Atom listAtomFunctions :: AtomFunctions listCons :: AtomType -> [Atom] -> Atom module ProjectM36.DataTypes.NonEmptyList nonEmptyListAtomType :: AtomType -> AtomType nonEmptyListTypeConstructorMapping :: TypeConstructorMapping nonEmptyListLength :: Atom -> Either AtomFunctionError Int nonEmptyListHead :: Atom -> Either AtomFunctionError Atom nonEmptyListAtomFunctions :: AtomFunctions module ProjectM36.DataConstructorDef emptyDataConstructor :: DataConstructorName -> DataConstructorDef name :: DataConstructorDef -> DataConstructorName fields :: DataConstructorDef -> [DataConstructorDefArg] typeVars :: DataConstructorDef -> Set TypeVarName typeVarsInDefArg :: DataConstructorDefArg -> Set TypeVarName module ProjectM36.AttributeNames empty :: AttributeNamesBase a all :: AttributeNamesBase a -- | Coalesce a bunch of AttributeNames into a single AttributeNames. some :: Eq a => [AttributeNamesBase a] -> AttributeNamesBase a module ProjectM36.AtomFunctionBody compiledAtomFunctionBody :: AtomFunctionBodyType -> AtomFunctionBody module ProjectM36.DataTypes.Day dayAtomFunctions :: AtomFunctions module ProjectM36.DataTypes.DateTime dateTimeAtomFunctions :: AtomFunctions module ProjectM36.DataTypes.ByteString bytestringAtomFunctions :: AtomFunctions module ProjectM36.MiscUtils dupes :: Eq a => [a] -> [a] indexed :: [a] -> [(Int, a)] -- | Functions to convert all types of expresions into their GraphRef- -- equivalents. module ProjectM36.NormalizeExpr type ProcessExprM a = Reader GraphRefTransactionMarker a type CurrentTransactionId = TransactionId runProcessExprM :: GraphRefTransactionMarker -> ProcessExprM a -> a askMarker :: ProcessExprM GraphRefTransactionMarker processRelationalExpr :: RelationalExpr -> ProcessExprM GraphRefRelationalExpr processWithNameExpr :: WithNameExpr -> ProcessExprM GraphRefWithNameExpr processAttributeNames :: AttributeNames -> ProcessExprM GraphRefAttributeNames processDatabaseContextExpr :: DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr processDatabaseContextIOExpr :: DatabaseContextIOExpr -> ProcessExprM GraphRefDatabaseContextIOExpr processRestrictionPredicateExpr :: RestrictionPredicateExpr -> ProcessExprM GraphRefRestrictionPredicateExpr processExtendTupleExpr :: ExtendTupleExpr -> ProcessExprM GraphRefExtendTupleExpr processAtomExpr :: AtomExpr -> ProcessExprM GraphRefAtomExpr processTupleExprs :: TupleExprs -> ProcessExprM GraphRefTupleExprs processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr processAttributeExpr :: AttributeExpr -> ProcessExprM GraphRefAttributeExpr module ProjectM36.Persist writeFileSync :: DiskSync -> FilePath -> Text -> IO () writeSerialiseSync :: Serialise a => DiskSync -> FilePath -> a -> IO () renameSync :: DiskSync -> FilePath -> FilePath -> IO () printFdCount :: IO () data DiskSync NoDiskSync :: DiskSync FsyncDiskSync :: DiskSync module ProjectM36.SQL.Select data Query QuerySelect :: Select -> Query QueryValues :: [[ScalarExpr]] -> Query QueryTable :: TableName -> Query QueryOp :: QueryOperator -> Query -> Query -> Query data QueryOperator UnionQueryOperator :: QueryOperator IntersectQueryOperator :: QueryOperator ExceptQueryOperator :: QueryOperator data Select Select :: Maybe Distinctness -> [SelectItem] -> Maybe TableExpr -> Maybe WithClause -> Select [distinctness] :: Select -> Maybe Distinctness [projectionClause] :: Select -> [SelectItem] [tableExpr] :: Select -> Maybe TableExpr [withClause] :: Select -> Maybe WithClause emptySelect :: Select type SelectItem = (ProjectionScalarExpr, Maybe ColumnAlias) data WithClause WithClause :: Bool -> NonEmpty WithExpr -> WithClause [isRecursive] :: WithClause -> Bool [withExprs] :: WithClause -> NonEmpty WithExpr data WithExpr WithExpr :: WithExprAlias -> Select -> WithExpr newtype WithExprAlias WithExprAlias :: Text -> WithExprAlias data InFlag In :: InFlag NotIn :: InFlag data ComparisonOperator OpLT :: ComparisonOperator OpGT :: ComparisonOperator OpGTE :: ComparisonOperator OpEQ :: ComparisonOperator OpNE :: ComparisonOperator OpLTE :: ComparisonOperator data QuantifiedComparisonPredicate QCAny :: QuantifiedComparisonPredicate QCSome :: QuantifiedComparisonPredicate QCAll :: QuantifiedComparisonPredicate data TableRef SimpleTableRef :: TableName -> TableRef InnerJoinTableRef :: TableRef -> JoinCondition -> TableRef RightOuterJoinTableRef :: TableRef -> JoinCondition -> TableRef LeftOuterJoinTableRef :: TableRef -> JoinCondition -> TableRef FullOuterJoinTableRef :: TableRef -> JoinCondition -> TableRef CrossJoinTableRef :: TableRef -> TableRef NaturalJoinTableRef :: TableRef -> TableRef AliasedTableRef :: TableRef -> TableAlias -> TableRef QueryTableRef :: Select -> TableRef type ProjectionScalarExpr = ScalarExprBase ColumnProjectionName type ScalarExpr = ScalarExprBase ColumnName data ScalarExprBase n IntegerLiteral :: Integer -> ScalarExprBase n DoubleLiteral :: Double -> ScalarExprBase n StringLiteral :: Text -> ScalarExprBase n BooleanLiteral :: Bool -> ScalarExprBase n NullLiteral :: ScalarExprBase n -- | Interval Identifier :: n -> ScalarExprBase n BinaryOperator :: ScalarExprBase n -> OperatorName -> ScalarExprBase n -> ScalarExprBase n PrefixOperator :: OperatorName -> ScalarExprBase n -> ScalarExprBase n PostfixOperator :: ScalarExprBase n -> OperatorName -> ScalarExprBase n BetweenOperator :: ScalarExprBase n -> ScalarExprBase n -> ScalarExprBase n -> ScalarExprBase n FunctionApplication :: FuncName -> [ScalarExprBase n] -> ScalarExprBase n CaseExpr :: [(ScalarExprBase n, ScalarExprBase n)] -> Maybe (ScalarExprBase n) -> ScalarExprBase n [caseWhens] :: ScalarExprBase n -> [(ScalarExprBase n, ScalarExprBase n)] [caseElse] :: ScalarExprBase n -> Maybe (ScalarExprBase n) QuantifiedComparison :: ScalarExprBase n -> ComparisonOperator -> QuantifiedComparisonPredicate -> Select -> ScalarExprBase n [qcExpr] :: ScalarExprBase n -> ScalarExprBase n [qcOperator] :: ScalarExprBase n -> ComparisonOperator [qcPredicate] :: ScalarExprBase n -> QuantifiedComparisonPredicate [qcQuery] :: ScalarExprBase n -> Select InExpr :: InFlag -> ScalarExprBase n -> InPredicateValue -> ScalarExprBase n -- | ExistsSubQuery Select | UniqueSubQuery Select | ScalarSubQuery Select BooleanOperatorExpr :: ScalarExprBase n -> BoolOp -> ScalarExprBase n -> ScalarExprBase n ExistsExpr :: Select -> ScalarExprBase n data BoolOp AndOp :: BoolOp OrOp :: BoolOp data InPredicateValue InList :: [ScalarExpr] -> InPredicateValue InQueryExpr :: Select -> InPredicateValue InScalarExpr :: ScalarExpr -> InPredicateValue newtype GroupByExpr GroupByExpr :: ProjectionScalarExpr -> GroupByExpr newtype HavingExpr HavingExpr :: ProjectionScalarExpr -> HavingExpr data SortExpr SortExpr :: ScalarExpr -> Maybe Direction -> Maybe NullsOrder -> SortExpr data Direction Ascending :: Direction Descending :: Direction data NullsOrder NullsFirst :: NullsOrder NullsLast :: NullsOrder data JoinType InnerJoin :: JoinType RightOuterJoin :: JoinType LeftOuterJoin :: JoinType FullOuterJoin :: JoinType CrossJoin :: JoinType NaturalJoin :: JoinType data JoinCondition JoinOn :: JoinOnCondition -> JoinCondition JoinUsing :: [UnqualifiedColumnName] -> JoinCondition newtype JoinOnCondition JoinOnCondition :: ScalarExpr -> JoinOnCondition newtype ColumnProjectionName ColumnProjectionName :: [ProjectionName] -> ColumnProjectionName data ProjectionName ProjectionName :: Text -> ProjectionName Asterisk :: ProjectionName newtype ColumnName ColumnName :: [Text] -> ColumnName newtype UnqualifiedColumnName UnqualifiedColumnName :: Text -> UnqualifiedColumnName newtype TableName TableName :: [Text] -> TableName newtype OperatorName OperatorName :: [Text] -> OperatorName newtype ColumnAlias ColumnAlias :: Text -> ColumnAlias [unColumnAlias] :: ColumnAlias -> Text newtype TableAlias TableAlias :: Text -> TableAlias [unTableAlias] :: TableAlias -> Text newtype FuncName FuncName :: [Text] -> FuncName data Distinctness Distinct :: Distinctness All :: Distinctness newtype RestrictionExpr RestrictionExpr :: ScalarExpr -> RestrictionExpr data TableExpr TableExpr :: [TableRef] -> Maybe RestrictionExpr -> [GroupByExpr] -> Maybe HavingExpr -> [SortExpr] -> Maybe Integer -> Maybe Integer -> TableExpr [fromClause] :: TableExpr -> [TableRef] [whereClause] :: TableExpr -> Maybe RestrictionExpr [groupByClause] :: TableExpr -> [GroupByExpr] [havingClause] :: TableExpr -> Maybe HavingExpr [orderByClause] :: TableExpr -> [SortExpr] [limitClause] :: TableExpr -> Maybe Integer [offsetClause] :: TableExpr -> Maybe Integer emptyTableExpr :: TableExpr data ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 IntegerLiteralF :: Integer -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 DoubleLiteralF :: Double -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 StringLiteralF :: Text -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 BooleanLiteralF :: Bool -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 NullLiteralF :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 IdentifierF :: n_a1Aj1 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 BinaryOperatorF :: r_a1Kg4 -> OperatorName -> r_a1Kg4 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 PrefixOperatorF :: OperatorName -> r_a1Kg4 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 PostfixOperatorF :: r_a1Kg4 -> OperatorName -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 BetweenOperatorF :: r_a1Kg4 -> r_a1Kg4 -> r_a1Kg4 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 FunctionApplicationF :: FuncName -> [r_a1Kg4] -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 CaseExprF :: [(r_a1Kg4, r_a1Kg4)] -> Maybe r_a1Kg4 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 [caseWhensF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> [(r_a1Kg4, r_a1Kg4)] [caseElseF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> Maybe r_a1Kg4 QuantifiedComparisonF :: r_a1Kg4 -> ComparisonOperator -> QuantifiedComparisonPredicate -> Select -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 [qcExprF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> r_a1Kg4 [qcOperatorF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> ComparisonOperator [qcPredicateF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> QuantifiedComparisonPredicate [qcQueryF] :: ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 -> Select InExprF :: InFlag -> r_a1Kg4 -> InPredicateValue -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 BooleanOperatorExprF :: r_a1Kg4 -> BoolOp -> r_a1Kg4 -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 ExistsExprF :: Select -> ScalarExprBaseF (n_a1Aj1 :: Type) r_a1Kg4 instance Data.Traversable.Traversable (ProjectM36.SQL.Select.ScalarExprBaseF n) instance Data.Foldable.Foldable (ProjectM36.SQL.Select.ScalarExprBaseF n) instance GHC.Base.Functor (ProjectM36.SQL.Select.ScalarExprBaseF n) instance Data.Functor.Foldable.Recursive (ProjectM36.SQL.Select.ScalarExprBase n) instance Data.Functor.Foldable.Corecursive (ProjectM36.SQL.Select.ScalarExprBase n) instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.QueryOperator instance Control.DeepSeq.NFData ProjectM36.SQL.Select.QueryOperator instance GHC.Generics.Generic ProjectM36.SQL.Select.QueryOperator instance GHC.Classes.Eq ProjectM36.SQL.Select.QueryOperator instance GHC.Show.Show ProjectM36.SQL.Select.QueryOperator instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.WithExprAlias instance Control.DeepSeq.NFData ProjectM36.SQL.Select.WithExprAlias instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.WithExprAlias instance GHC.Generics.Generic ProjectM36.SQL.Select.WithExprAlias instance GHC.Classes.Eq ProjectM36.SQL.Select.WithExprAlias instance GHC.Show.Show ProjectM36.SQL.Select.WithExprAlias instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.InFlag instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.InFlag instance Control.DeepSeq.NFData ProjectM36.SQL.Select.InFlag instance GHC.Generics.Generic ProjectM36.SQL.Select.InFlag instance GHC.Classes.Eq ProjectM36.SQL.Select.InFlag instance GHC.Show.Show ProjectM36.SQL.Select.InFlag instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ComparisonOperator instance Control.DeepSeq.NFData ProjectM36.SQL.Select.ComparisonOperator instance GHC.Generics.Generic ProjectM36.SQL.Select.ComparisonOperator instance GHC.Classes.Eq ProjectM36.SQL.Select.ComparisonOperator instance GHC.Show.Show ProjectM36.SQL.Select.ComparisonOperator instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance Control.DeepSeq.NFData ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance GHC.Generics.Generic ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance GHC.Classes.Eq ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance GHC.Show.Show ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.BoolOp instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.BoolOp instance Control.DeepSeq.NFData ProjectM36.SQL.Select.BoolOp instance GHC.Generics.Generic ProjectM36.SQL.Select.BoolOp instance GHC.Show.Show ProjectM36.SQL.Select.BoolOp instance GHC.Classes.Eq ProjectM36.SQL.Select.BoolOp instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.Direction instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.Direction instance Control.DeepSeq.NFData ProjectM36.SQL.Select.Direction instance GHC.Generics.Generic ProjectM36.SQL.Select.Direction instance GHC.Classes.Eq ProjectM36.SQL.Select.Direction instance GHC.Show.Show ProjectM36.SQL.Select.Direction instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.NullsOrder instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.NullsOrder instance Control.DeepSeq.NFData ProjectM36.SQL.Select.NullsOrder instance GHC.Generics.Generic ProjectM36.SQL.Select.NullsOrder instance GHC.Classes.Eq ProjectM36.SQL.Select.NullsOrder instance GHC.Show.Show ProjectM36.SQL.Select.NullsOrder instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.JoinType instance Control.DeepSeq.NFData ProjectM36.SQL.Select.JoinType instance GHC.Generics.Generic ProjectM36.SQL.Select.JoinType instance GHC.Classes.Eq ProjectM36.SQL.Select.JoinType instance GHC.Show.Show ProjectM36.SQL.Select.JoinType instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.ProjectionName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ProjectionName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.ProjectionName instance GHC.Generics.Generic ProjectM36.SQL.Select.ProjectionName instance GHC.Classes.Ord ProjectM36.SQL.Select.ProjectionName instance GHC.Classes.Eq ProjectM36.SQL.Select.ProjectionName instance GHC.Show.Show ProjectM36.SQL.Select.ProjectionName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.ColumnProjectionName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.ColumnProjectionName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ColumnProjectionName instance GHC.Generics.Generic ProjectM36.SQL.Select.ColumnProjectionName instance GHC.Classes.Ord ProjectM36.SQL.Select.ColumnProjectionName instance GHC.Classes.Eq ProjectM36.SQL.Select.ColumnProjectionName instance GHC.Show.Show ProjectM36.SQL.Select.ColumnProjectionName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.ColumnName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.ColumnName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ColumnName instance GHC.Generics.Generic ProjectM36.SQL.Select.ColumnName instance GHC.Classes.Ord ProjectM36.SQL.Select.ColumnName instance GHC.Classes.Eq ProjectM36.SQL.Select.ColumnName instance GHC.Show.Show ProjectM36.SQL.Select.ColumnName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.UnqualifiedColumnName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.UnqualifiedColumnName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.UnqualifiedColumnName instance GHC.Generics.Generic ProjectM36.SQL.Select.UnqualifiedColumnName instance GHC.Classes.Ord ProjectM36.SQL.Select.UnqualifiedColumnName instance GHC.Classes.Eq ProjectM36.SQL.Select.UnqualifiedColumnName instance GHC.Show.Show ProjectM36.SQL.Select.UnqualifiedColumnName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.TableName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.TableName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.TableName instance GHC.Generics.Generic ProjectM36.SQL.Select.TableName instance GHC.Classes.Ord ProjectM36.SQL.Select.TableName instance GHC.Classes.Eq ProjectM36.SQL.Select.TableName instance GHC.Show.Show ProjectM36.SQL.Select.TableName instance Control.DeepSeq.NFData ProjectM36.SQL.Select.OperatorName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.OperatorName instance GHC.Generics.Generic ProjectM36.SQL.Select.OperatorName instance GHC.Classes.Ord ProjectM36.SQL.Select.OperatorName instance GHC.Classes.Eq ProjectM36.SQL.Select.OperatorName instance GHC.Show.Show ProjectM36.SQL.Select.OperatorName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.ColumnAlias instance Control.DeepSeq.NFData ProjectM36.SQL.Select.ColumnAlias instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ColumnAlias instance GHC.Generics.Generic ProjectM36.SQL.Select.ColumnAlias instance GHC.Classes.Ord ProjectM36.SQL.Select.ColumnAlias instance GHC.Classes.Eq ProjectM36.SQL.Select.ColumnAlias instance GHC.Show.Show ProjectM36.SQL.Select.ColumnAlias instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.TableAlias instance Control.DeepSeq.NFData ProjectM36.SQL.Select.TableAlias instance GHC.Base.Semigroup ProjectM36.SQL.Select.TableAlias instance GHC.Base.Monoid ProjectM36.SQL.Select.TableAlias instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.TableAlias instance GHC.Generics.Generic ProjectM36.SQL.Select.TableAlias instance GHC.Classes.Ord ProjectM36.SQL.Select.TableAlias instance GHC.Classes.Eq ProjectM36.SQL.Select.TableAlias instance GHC.Show.Show ProjectM36.SQL.Select.TableAlias instance Control.DeepSeq.NFData ProjectM36.SQL.Select.FuncName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.FuncName instance GHC.Classes.Ord ProjectM36.SQL.Select.FuncName instance GHC.Generics.Generic ProjectM36.SQL.Select.FuncName instance GHC.Classes.Eq ProjectM36.SQL.Select.FuncName instance GHC.Show.Show ProjectM36.SQL.Select.FuncName instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.Distinctness instance Control.DeepSeq.NFData ProjectM36.SQL.Select.Distinctness instance GHC.Generics.Generic ProjectM36.SQL.Select.Distinctness instance GHC.Classes.Eq ProjectM36.SQL.Select.Distinctness instance GHC.Show.Show ProjectM36.SQL.Select.Distinctness instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.JoinOnCondition instance Control.DeepSeq.NFData ProjectM36.SQL.Select.JoinOnCondition instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.JoinOnCondition instance GHC.Generics.Generic ProjectM36.SQL.Select.JoinOnCondition instance GHC.Classes.Eq ProjectM36.SQL.Select.JoinOnCondition instance GHC.Show.Show ProjectM36.SQL.Select.JoinOnCondition instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.JoinCondition instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.JoinCondition instance Control.DeepSeq.NFData ProjectM36.SQL.Select.JoinCondition instance GHC.Generics.Generic ProjectM36.SQL.Select.JoinCondition instance GHC.Classes.Eq ProjectM36.SQL.Select.JoinCondition instance GHC.Show.Show ProjectM36.SQL.Select.JoinCondition instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.TableRef instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.TableRef instance Control.DeepSeq.NFData ProjectM36.SQL.Select.TableRef instance GHC.Generics.Generic ProjectM36.SQL.Select.TableRef instance GHC.Classes.Eq ProjectM36.SQL.Select.TableRef instance GHC.Show.Show ProjectM36.SQL.Select.TableRef instance Control.DeepSeq.NFData ProjectM36.SQL.Select.GroupByExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.GroupByExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.GroupByExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.GroupByExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.GroupByExpr instance GHC.Show.Show ProjectM36.SQL.Select.GroupByExpr instance Control.DeepSeq.NFData ProjectM36.SQL.Select.HavingExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.HavingExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.HavingExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.HavingExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.HavingExpr instance GHC.Show.Show ProjectM36.SQL.Select.HavingExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.SortExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.SortExpr instance Control.DeepSeq.NFData ProjectM36.SQL.Select.SortExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.SortExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.SortExpr instance GHC.Show.Show ProjectM36.SQL.Select.SortExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.WithExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.WithExpr instance Control.DeepSeq.NFData ProjectM36.SQL.Select.WithExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.WithExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.WithExpr instance GHC.Show.Show ProjectM36.SQL.Select.WithExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.WithClause instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.WithClause instance Control.DeepSeq.NFData ProjectM36.SQL.Select.WithClause instance GHC.Generics.Generic ProjectM36.SQL.Select.WithClause instance GHC.Classes.Eq ProjectM36.SQL.Select.WithClause instance GHC.Show.Show ProjectM36.SQL.Select.WithClause instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.Select instance Control.DeepSeq.NFData ProjectM36.SQL.Select.Select instance GHC.Generics.Generic ProjectM36.SQL.Select.Select instance GHC.Classes.Eq ProjectM36.SQL.Select.Select instance GHC.Show.Show ProjectM36.SQL.Select.Select instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.InPredicateValue instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.InPredicateValue instance Control.DeepSeq.NFData ProjectM36.SQL.Select.InPredicateValue instance GHC.Generics.Generic ProjectM36.SQL.Select.InPredicateValue instance GHC.Show.Show ProjectM36.SQL.Select.InPredicateValue instance GHC.Classes.Eq ProjectM36.SQL.Select.InPredicateValue instance Control.DeepSeq.NFData n => Control.DeepSeq.NFData (ProjectM36.SQL.Select.ScalarExprBase n) instance GHC.Generics.Generic (ProjectM36.SQL.Select.ScalarExprBase n) instance GHC.Classes.Eq n => GHC.Classes.Eq (ProjectM36.SQL.Select.ScalarExprBase n) instance GHC.Show.Show n => GHC.Show.Show (ProjectM36.SQL.Select.ScalarExprBase n) instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.RestrictionExpr instance Control.DeepSeq.NFData ProjectM36.SQL.Select.RestrictionExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.RestrictionExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.RestrictionExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.RestrictionExpr instance GHC.Show.Show ProjectM36.SQL.Select.RestrictionExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.TableExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.TableExpr instance Control.DeepSeq.NFData ProjectM36.SQL.Select.TableExpr instance GHC.Generics.Generic ProjectM36.SQL.Select.TableExpr instance GHC.Classes.Eq ProjectM36.SQL.Select.TableExpr instance GHC.Show.Show ProjectM36.SQL.Select.TableExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.Query instance Control.DeepSeq.NFData ProjectM36.SQL.Select.Query instance GHC.Generics.Generic ProjectM36.SQL.Select.Query instance GHC.Classes.Eq ProjectM36.SQL.Select.Query instance GHC.Show.Show ProjectM36.SQL.Select.Query instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ProjectionScalarExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Select.ScalarExpr instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.Select instance (Data.Hashable.Class.Hashable n, GHC.Classes.Eq n) => Data.Hashable.Class.Hashable (ProjectM36.SQL.Select.ScalarExprBase n) instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.Distinctness instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.FuncName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.OperatorName instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.QuantifiedComparisonPredicate instance Data.Hashable.Class.Hashable ProjectM36.SQL.Select.ComparisonOperator module ProjectM36.SQL.DropTable newtype DropTable DropTable :: TableName -> DropTable [target] :: DropTable -> TableName instance Codec.Winery.Class.Serialise ProjectM36.SQL.DropTable.DropTable instance Control.DeepSeq.NFData ProjectM36.SQL.DropTable.DropTable instance GHC.Generics.Generic ProjectM36.SQL.DropTable.DropTable instance GHC.Classes.Eq ProjectM36.SQL.DropTable.DropTable instance GHC.Show.Show ProjectM36.SQL.DropTable.DropTable module ProjectM36.SQL.Delete data Delete Delete :: TableName -> RestrictionExpr -> Delete [target] :: Delete -> TableName [restriction] :: Delete -> RestrictionExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Delete.Delete instance Control.DeepSeq.NFData ProjectM36.SQL.Delete.Delete instance GHC.Generics.Generic ProjectM36.SQL.Delete.Delete instance GHC.Classes.Eq ProjectM36.SQL.Delete.Delete instance GHC.Show.Show ProjectM36.SQL.Delete.Delete module ProjectM36.SQL.CreateTable data CreateTable CreateTable :: TableName -> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)] -> CreateTable [target] :: CreateTable -> TableName [targetColumns] :: CreateTable -> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)] data ColumnType IntegerColumnType :: ColumnType TextColumnType :: ColumnType BoolColumnType :: ColumnType DoubleColumnType :: ColumnType DateTimeColumnType :: ColumnType DateColumnType :: ColumnType ByteaColumnType :: ColumnType -- | Used to represent constraints which are defined next to a column name -- and type. data PerColumnConstraints PerColumnConstraints :: Bool -> Bool -> Maybe (TableName, UnqualifiedColumnName) -> PerColumnConstraints [notNullConstraint] :: PerColumnConstraints -> Bool [uniquenessConstraint] :: PerColumnConstraints -> Bool [references] :: PerColumnConstraints -> Maybe (TableName, UnqualifiedColumnName) instance Codec.Winery.Class.Serialise ProjectM36.SQL.CreateTable.ColumnType instance Control.DeepSeq.NFData ProjectM36.SQL.CreateTable.ColumnType instance GHC.Generics.Generic ProjectM36.SQL.CreateTable.ColumnType instance GHC.Classes.Eq ProjectM36.SQL.CreateTable.ColumnType instance GHC.Show.Show ProjectM36.SQL.CreateTable.ColumnType instance Codec.Winery.Class.Serialise ProjectM36.SQL.CreateTable.PerColumnConstraints instance Control.DeepSeq.NFData ProjectM36.SQL.CreateTable.PerColumnConstraints instance GHC.Generics.Generic ProjectM36.SQL.CreateTable.PerColumnConstraints instance GHC.Classes.Eq ProjectM36.SQL.CreateTable.PerColumnConstraints instance GHC.Show.Show ProjectM36.SQL.CreateTable.PerColumnConstraints instance Codec.Winery.Class.Serialise ProjectM36.SQL.CreateTable.CreateTable instance Control.DeepSeq.NFData ProjectM36.SQL.CreateTable.CreateTable instance GHC.Generics.Generic ProjectM36.SQL.CreateTable.CreateTable instance GHC.Classes.Eq ProjectM36.SQL.CreateTable.CreateTable instance GHC.Show.Show ProjectM36.SQL.CreateTable.CreateTable module ProjectM36.Error data RelationalError NoSuchAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeCountMismatchError :: Int -> RelationalError EmptyAttributesError :: RelationalError DuplicateAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeTypeMismatchError :: Attributes -> RelationalError AttributeCountMismatchError :: Int -> RelationalError AttributeNamesMismatchError :: Set AttributeName -> RelationalError AttributeTypesMismatchError :: Attributes -> RelationalError AttributeNameInUseError :: AttributeName -> RelationalError AttributeIsNotRelationValuedError :: AttributeName -> RelationalError CouldNotInferAttributes :: RelationalError RelVarNotDefinedError :: RelVarName -> RelationalError RelVarAlreadyDefinedError :: RelVarName -> RelationalError RelationTypeMismatchError :: Attributes -> Attributes -> RelationalError InclusionDependencyCheckError :: IncDepName -> Maybe RelationalError -> RelationalError InclusionDependencyNameInUseError :: IncDepName -> RelationalError InclusionDependencyNameNotInUseError :: IncDepName -> RelationalError ParseError :: Text -> RelationalError PredicateExpressionError :: Text -> RelationalError NoCommonTransactionAncestorError :: TransactionId -> TransactionId -> RelationalError NoSuchTransactionError :: TransactionId -> RelationalError RootTransactionTraversalError :: RelationalError HeadNameSwitchingHeadProhibitedError :: HeadName -> RelationalError NoSuchHeadNameError :: HeadName -> RelationalError UnknownHeadError :: RelationalError NewTransactionMayNotHaveChildrenError :: TransactionId -> RelationalError ParentCountTraversalError :: Int -> Int -> RelationalError NewTransactionMissingParentError :: TransactionId -> RelationalError TransactionIsNotAHeadError :: TransactionId -> RelationalError TransactionGraphCycleError :: TransactionId -> RelationalError SessionIdInUseError :: TransactionId -> RelationalError NoSuchSessionError :: TransactionId -> RelationalError FailedToFindTransactionError :: TransactionId -> RelationalError TransactionIdInUseError :: TransactionId -> RelationalError NoSuchFunctionError :: FunctionName -> RelationalError NoSuchTypeConstructorName :: TypeConstructorName -> RelationalError TypeConstructorAtomTypeMismatch :: TypeConstructorName -> AtomType -> RelationalError AtomTypeMismatchError :: AtomType -> AtomType -> RelationalError TypeConstructorNameMismatch :: TypeConstructorName -> TypeConstructorName -> RelationalError AtomTypeTypeConstructorReconciliationError :: AtomType -> TypeConstructorName -> RelationalError DataConstructorNameInUseError :: DataConstructorName -> RelationalError DataConstructorUsesUndeclaredTypeVariable :: TypeVarName -> RelationalError TypeConstructorTypeVarsMismatch :: Set TypeVarName -> Set TypeVarName -> RelationalError TypeConstructorTypeVarMissing :: TypeVarName -> RelationalError TypeConstructorTypeVarsTypesMismatch :: TypeConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError DataConstructorTypeVarsMismatch :: DataConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError AtomFunctionTypeVariableResolutionError :: FunctionName -> TypeVarName -> RelationalError AtomFunctionTypeVariableMismatch :: TypeVarName -> AtomType -> AtomType -> RelationalError IfThenExprExpectedBooleanError :: AtomType -> RelationalError AtomTypeNameInUseError :: AtomTypeName -> RelationalError IncompletelyDefinedAtomTypeWithConstructorError :: RelationalError AtomTypeNameNotInUseError :: AtomTypeName -> RelationalError AttributeNotSortableError :: Attribute -> RelationalError FunctionNameInUseError :: FunctionName -> RelationalError FunctionNameNotInUseError :: FunctionName -> RelationalError EmptyCommitError :: RelationalError FunctionArgumentCountMismatchError :: Int -> Int -> RelationalError ConstructedAtomArgumentCountMismatchError :: Int -> Int -> RelationalError NoSuchDataConstructorError :: DataConstructorName -> RelationalError NoSuchTypeConstructorError :: TypeConstructorName -> RelationalError InvalidAtomTypeName :: AtomTypeName -> RelationalError AtomTypeNotSupported :: AttributeName -> RelationalError AtomOperatorNotSupported :: Text -> RelationalError EmptyTuplesError :: RelationalError AtomTypeCountError :: [AtomType] -> [AtomType] -> RelationalError AtomFunctionTypeError :: FunctionName -> Int -> AtomType -> AtomType -> RelationalError AtomFunctionUserError :: AtomFunctionError -> RelationalError PrecompiledFunctionRemoveError :: FunctionName -> RelationalError RelationValuedAttributesNotSupportedError :: [AttributeName] -> RelationalError NotificationNameInUseError :: NotificationName -> RelationalError NotificationNameNotInUseError :: NotificationName -> RelationalError NotificationValidationError :: NotificationName -> NotificationExpression -> RelationalError -> RelationalError ImportError :: ImportError' -> RelationalError ExportError :: Text -> RelationalError UnhandledExceptionError :: String -> RelationalError MergeTransactionError :: MergeError -> RelationalError ScriptError :: ScriptCompilationError -> RelationalError LoadFunctionError :: RelationalError SecurityLoadFunctionError :: RelationalError DatabaseContextFunctionUserError :: DatabaseContextFunctionError -> RelationalError DatabaseLoadError :: PersistenceError -> RelationalError SubschemaNameInUseError :: SchemaName -> RelationalError SubschemaNameNotInUseError :: SchemaName -> RelationalError SchemaCreationError :: SchemaError -> RelationalError ImproperDatabaseStateError :: RelationalError NonConcreteSchemaPlanError :: RelationalError NoUncommittedContextInEvalError :: RelationalError TupleExprsReferenceMultipleMarkersError :: RelationalError MerkleHashValidationError :: TransactionId -> MerkleHash -> MerkleHash -> RelationalError RegisteredQueryValidationError :: RegisteredQueryName -> RelationalError -> RelationalError RegisteredQueryNameInUseError :: RegisteredQueryName -> RelationalError RegisteredQueryNameNotInUseError :: RegisteredQueryName -> RelationalError SQLConversionError :: SQLError -> RelationalError MultipleErrors :: [RelationalError] -> RelationalError data PersistenceError InvalidDirectoryError :: FilePath -> PersistenceError MissingTransactionError :: TransactionId -> PersistenceError WrongDatabaseFormatVersionError :: String -> String -> PersistenceError someErrors :: [RelationalError] -> RelationalError data MergeError SelectedHeadMismatchMergeError :: MergeError PreferredHeadMissingMergeError :: HeadName -> MergeError StrategyViolatesConstraintMergeError :: MergeError InvalidMergeStrategyError :: MergeStrategy -> MergeError DisconnectedTransactionNotAMergeHeadError :: TransactionId -> MergeError StrategyViolatesComponentMergeError :: MergeError StrategyViolatesRelationVariableMergeError :: RelationalError -> MergeError StrategyWithoutPreferredBranchResolutionMergeError :: MergeError StrategyViolatesTypeConstructorMergeError :: MergeError StrategyViolatesRegisteredQueryMergeError :: [RegisteredQueryName] -> MergeError data ScriptCompilationError TypeCheckCompilationError :: String -> String -> ScriptCompilationError SyntaxErrorCompilationError :: String -> ScriptCompilationError ScriptCompilationDisabledError :: ScriptCompilationError OtherScriptCompilationError :: String -> ScriptCompilationError data SchemaError RelVarReferencesMissing :: Set RelVarName -> SchemaError RelVarInReferencedMoreThanOnce :: RelVarName -> SchemaError RelVarOutReferencedMoreThanOnce :: RelVarName -> SchemaError data ImportError' InvalidSHA256Error :: Text -> ImportError' SHA256MismatchError :: Text -> Text -> ImportError' InvalidFileURIError :: Text -> ImportError' ImportFileDecodeError :: Text -> ImportError' ImportFileError :: Text -> ImportError' ImportDownloadError :: Text -> ImportError' data SQLError NotSupportedError :: Text -> SQLError TypeMismatchError :: AtomType -> AtomType -> SQLError NoSuchSQLFunctionError :: FuncName -> SQLError NoSuchSQLOperatorError :: OperatorName -> SQLError DuplicateTableReferenceError :: TableAlias -> SQLError MissingTableReferenceError :: TableAlias -> SQLError TableAliasMismatchError :: TableAlias -> SQLError UnexpectedTableNameError :: TableName -> SQLError UnexpectedColumnNameError :: ColumnName -> SQLError ColumnNamesMismatch :: Set UnqualifiedColumnName -> Set UnqualifiedColumnName -> SQLError ColumnResolutionError :: ColumnName -> SQLError ColumnAliasResolutionError :: ColumnAlias -> SQLError UnexpectedRelationalExprError :: RelationalExpr -> SQLError UnexpectedAsteriskError :: ColumnProjectionName -> SQLError UnexpectedColumnProjectionName :: ColumnProjectionName -> SQLError AmbiguousColumnResolutionError :: ColumnName -> SQLError DuplicateColumnAliasError :: ColumnAlias -> SQLError AggregateGroupByMismatchError :: ProjectionScalarExpr -> SQLError GroupByColumnNotReferencedInGroupByError :: [ProjectionScalarExpr] -> SQLError UnsupportedGroupByProjectionError :: ProjectionScalarExpr -> SQLError QueryOperatorTypeMismatchError :: QueryOperator -> Attributes -> Attributes -> SQLError SQLRelationalError :: RelationalError -> SQLError instance Control.DeepSeq.NFData ProjectM36.Error.PersistenceError instance GHC.Generics.Generic ProjectM36.Error.PersistenceError instance GHC.Classes.Eq ProjectM36.Error.PersistenceError instance GHC.Show.Show ProjectM36.Error.PersistenceError instance Control.DeepSeq.NFData ProjectM36.Error.ScriptCompilationError instance GHC.Generics.Generic ProjectM36.Error.ScriptCompilationError instance GHC.Classes.Eq ProjectM36.Error.ScriptCompilationError instance GHC.Show.Show ProjectM36.Error.ScriptCompilationError instance Control.DeepSeq.NFData ProjectM36.Error.SchemaError instance GHC.Generics.Generic ProjectM36.Error.SchemaError instance GHC.Classes.Eq ProjectM36.Error.SchemaError instance GHC.Show.Show ProjectM36.Error.SchemaError instance Control.DeepSeq.NFData ProjectM36.Error.ImportError' instance GHC.Generics.Generic ProjectM36.Error.ImportError' instance GHC.Classes.Eq ProjectM36.Error.ImportError' instance GHC.Show.Show ProjectM36.Error.ImportError' instance GHC.Generics.Generic ProjectM36.Error.MergeError instance GHC.Classes.Eq ProjectM36.Error.MergeError instance GHC.Show.Show ProjectM36.Error.MergeError instance Control.DeepSeq.NFData ProjectM36.Error.RelationalError instance GHC.Generics.Generic ProjectM36.Error.RelationalError instance GHC.Classes.Eq ProjectM36.Error.RelationalError instance GHC.Show.Show ProjectM36.Error.RelationalError instance Control.DeepSeq.NFData ProjectM36.Error.SQLError instance GHC.Generics.Generic ProjectM36.Error.SQLError instance GHC.Classes.Eq ProjectM36.Error.SQLError instance GHC.Show.Show ProjectM36.Error.SQLError instance Control.DeepSeq.NFData ProjectM36.Error.MergeError instance GHC.Exception.Type.Exception ProjectM36.Error.ScriptCompilationError module ProjectM36.Attribute arity :: Attributes -> Int emptyAttributes :: Attributes null :: Attributes -> Bool singleton :: Attribute -> Attributes toList :: Attributes -> [Attribute] attributesFromList :: [Attribute] -> Attributes attributeName :: Attribute -> AttributeName atomType :: Attribute -> AtomType atomTypes :: Attributes -> Vector AtomType atomTypesList :: Attributes -> [AtomType] addAttribute :: Attribute -> Attributes -> Attributes joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes addAttributes :: Attributes -> Attributes -> Attributes member :: Attribute -> Attributes -> Bool deleteAttributeName :: AttributeName -> Attributes -> Attributes deleteAttributeNames :: Set AttributeName -> Attributes -> Attributes renameAttribute :: AttributeName -> Attribute -> Attribute renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes renameAttributes' :: Set (AttributeName, AttributeName) -> Attributes -> Attributes atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute isAttributeNameContained :: AttributeName -> Attributes -> Bool projectionAttributesForNames :: Set AttributeName -> Attributes -> Either RelationalError Attributes attributesForNames :: Set AttributeName -> Attributes -> Attributes attributeNameSet :: Attributes -> Set AttributeName attributeNames :: Attributes -> Vector AttributeName attributeNamesList :: Attributes -> [AttributeName] attributesContained :: Attributes -> Attributes -> Bool attributeNamesContained :: Set AttributeName -> Set AttributeName -> Bool nonMatchingAttributeNameSet :: Set AttributeName -> Set AttributeName -> Set AttributeName matchingAttributeNameSet :: Set AttributeName -> Set AttributeName -> Set AttributeName attributeNamesNotContained :: Set AttributeName -> Set AttributeName -> Set AttributeName orderedAttributes :: Attributes -> [Attribute] orderedAttributeNames :: Attributes -> [AttributeName] attributesDifference :: Attributes -> Attributes -> Attributes vectorUniqueify :: (Hashable a, Eq a) => Vector a -> Vector a verifyAttributes :: Attributes -> Either RelationalError Attributes drop :: Int -> Attributes -> Attributes attributesAndOrderEqual :: Attributes -> Attributes -> Bool attributesEqual :: Attributes -> Attributes -> Bool attributesAsMap :: Attributes -> Map AttributeName Attribute -- | Left-biased union of attributes. union :: Attributes -> Attributes -> Attributes intersection :: Attributes -> Attributes -> Attributes instance GHC.Base.Semigroup ProjectM36.Base.Attributes instance GHC.Base.Monoid ProjectM36.Base.Attributes module ProjectM36.AttributeExpr attributeName :: AttributeExprBase a -> AttributeName module ProjectM36.ScriptSession data ScriptSession ScriptSession :: HscEnv -> Type -> Type -> ScriptSession [hscEnv] :: ScriptSession -> HscEnv [atomFunctionBodyType] :: ScriptSession -> Type [dbcFunctionBodyType] :: ScriptSession -> Type data ScriptSessionError ScriptSessionLoadError :: GhcException -> ScriptSessionError ScriptingDisabled :: ScriptSessionError data LoadSymbolError LoadSymbolError :: LoadSymbolError SecurityLoadSymbolError :: LoadSymbolError type ModName = String type FuncName = String -- | Configure a GHC environment/session which we will use for all script -- compilation. initScriptSession :: [String] -> IO (Either ScriptSessionError ScriptSession) addImport :: String -> Ghc () showType :: DynFlags -> Type -> String mkTypeForName :: String -> Ghc Type compileScript :: Type -> Text -> Ghc (Either ScriptCompilationError a) typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError) mangleSymbol :: Maybe String -> String -> String -> String data ObjectLoadMode -- | load .o files only LoadObjectFile :: ObjectLoadMode -- | load .so .dynlib .dll files only LoadDLLFile :: ObjectLoadMode -- | determine which object mode to use based on the file name's extension LoadAutoObjectFile :: ObjectLoadMode -- | Load either a .o or dynamic library based on the file name's -- extension. -- -- Load a function from an relocatable object file (.o or .so) If a -- modulesDir is specified, only load a path relative to the modulesDir -- (no ..) type ModuleDirectory = FilePath loadFunctionFromDirectory :: ObjectLoadMode -> ModName -> FuncName -> FilePath -> FilePath -> IO (Either LoadSymbolError a) loadFunction :: ObjectLoadMode -> ModName -> FuncName -> FilePath -> IO (Either LoadSymbolError a) prefixUnderscore :: String instance GHC.Show.Show ProjectM36.ScriptSession.ScriptSessionError module ProjectM36.Serialise.AtomFunctionError instance Codec.Winery.Class.Serialise ProjectM36.AtomFunctionError.AtomFunctionError module ProjectM36.Serialise.DatabaseContextFunctionError instance Codec.Winery.Class.Serialise ProjectM36.DatabaseContextFunctionError.DatabaseContextFunctionError module ProjectM36.Session type SessionId = UUID -- | 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. data Session Session :: DisconnectedTransaction -> SchemaName -> Session defaultSchemaName :: SchemaName disconnectedTransaction :: Session -> DisconnectedTransaction isDirty :: Session -> DirtyFlag concreteDatabaseContext :: Session -> DatabaseContext parentId :: Session -> TransactionId subschemas :: Session -> Subschemas schemas :: Session -> Schemas schemaName :: Session -> SchemaName setSchemaName :: SchemaName -> Session -> Either RelationalError Session module ProjectM36.Trace -- | Utility function for tracing with ghc-events-analyze using START and -- STOP markers traceBlock :: String -> IO () -> IO () module ProjectM36.Transaction parentIds :: Transaction -> Set TransactionId rootParent :: TransactionParents singleParent :: TransactionId -> TransactionParents -- | Return the same transaction but referencing only the specific child -- transactions. This is useful when traversing a graph and returning a -- subgraph. This doesn't filter parent transactions because it assumes a -- head-to-root traversal. filterTransactionInfoTransactions :: Set TransactionId -> TransactionInfo -> TransactionInfo filterParent :: TransactionId -> Set TransactionId -> TransactionId -- | Remove any child or parent transaction references not in the valud -- UUID set. filterTransaction :: Set TransactionId -> Transaction -> Transaction -- | Return the singular context which is not virtual. concreteDatabaseContext :: Transaction -> DatabaseContext -- | Returns all schemas including the concrete schema. schemas :: Transaction -> Schemas -- | Returns all subschemas which are isomorphic or sub-isomorphic to the -- concrete schema. subschemas :: Transaction -> Subschemas fresh :: TransactionId -> UTCTime -> Schemas -> Transaction timestamp :: Transaction -> UTCTime module ProjectM36.TransactionInfo -- | Create a TransactionInfo with just one parent transaction ID. singleParent :: TransactionId -> UTCTime -> TransactionInfo module ProjectM36.TypeConstructor name :: TypeConstructor -> TypeConstructorName arguments :: TypeConstructor -> [TypeConstructor] module ProjectM36.TypeConstructorDef name :: TypeConstructorDef -> TypeConstructorName typeVars :: TypeConstructorDef -> [TypeVarName] module ProjectM36.AtomType findDataConstructor :: DataConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, DataConstructorDef) atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType -- | Used to determine if the atom arguments can be used with the data -- constructor. | This is the entry point for type-checking from -- RelationalExpression.hs atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType -- | Walks the data and type constructors to extract the type variable map. resolveDataConstructorTypeVars :: DataConstructorDef -> [AtomType] -> TypeConstructorMapping -> Either RelationalError TypeVarMap -- | Attempt to match the data constructor argument to a type constructor -- type variable. resolveDataConstructorArgTypeVars :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError TypeVarMap resolveTypeConstructorTypeVars :: TypeConstructor -> AtomType -> TypeConstructorMapping -> Either RelationalError TypeVarMap resolveAttributeExprTypeVars :: AttributeExprBase a -> AtomType -> TypeConstructorMapping -> Either RelationalError TypeVarMap validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError () validateDataConstructorDef :: DataConstructorDef -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError () validateDataConstructorDefArg :: DataConstructorDefArg -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError () atomTypeForTypeConstructor :: TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType -- | Create an atom type iff all type variables are provided. Either Int -- Text -> ConstructedAtomType Either {Int , Text} atomTypeForTypeConstructorValidate :: Bool -> TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType atomTypeForAttributeExpr :: AttributeExprBase a -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType isValidAtomTypeForTypeConstructor :: AtomType -> TypeConstructor -> TypeConstructorMapping -> Either RelationalError () findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef]) resolveAttributes :: Attribute -> Attribute -> Either RelationalError Attribute resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap -- | See notes at resolveTypesInTuple. The typeFromRelation must not -- include any wildcards. resolveTypeInAtom :: AtomType -> Atom -> TypeConstructorMapping -> Either RelationalError Atom -- | When creating a tuple, the data constructor may not complete the type -- constructor arguments, so the wildcard "TypeVar x" fills in the type -- constructor's argument. The tuple type must be resolved before it can -- be part of a relation, however. Example: Nothing does not -- specify the the argument in "Maybe a", so allow delayed resolution in -- the tuple before it is added to the relation. Note that this -- resolution could cause a type error. Hardly a Hindley-Milner system. resolveTypesInTuple :: Attributes -> TypeConstructorMapping -> RelationTuple -> Either RelationalError RelationTuple -- | Validate that the type is provided with complete type variables for -- type constructors. validateAtomType :: AtomType -> TypeConstructorMapping -> Either RelationalError () validateAttributes :: TypeConstructorMapping -> Attributes -> Either RelationalError () validateTypeVarMap :: TypeVarMap -> TypeConstructorMapping -> Either RelationalError () validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError () validateAtom :: Atom -> TypeConstructorMapping -> Either RelationalError () -- | Determine if two types are equal or compatible (including special -- handling for TypeVar x). atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType -- | Determine if two typeVars are logically compatible. typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool prettyAtomType :: AtomType -> Text prettyAttribute :: Attribute -> Text resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap resolveTypeVariable :: AtomType -> AtomType -> TypeVarMap resolveFunctionReturnValue :: FunctionName -> TypeVarMap -> AtomType -> Either RelationalError AtomType resolvedAtomTypesForDataConstructorDefArgs :: TypeConstructorMapping -> TypeVarMap -> DataConstructorDef -> Either RelationalError [AtomType] resolvedAtomTypeForDataConstructorDefArg :: TypeConstructorMapping -> TypeVarMap -> DataConstructorDefArg -> Either RelationalError AtomType isResolvedType :: AtomType -> Bool isResolvedAttributes :: Attributes -> Bool isResolvedAttribute :: Attribute -> Bool anyRelationAtomType :: AtomType module ProjectM36.DataTypes.Interval type OpenInterval = Bool intervalSubType :: AtomType -> AtomType supportsInterval :: AtomType -> Bool supportsOrdering :: AtomType -> Bool atomCompare :: Atom -> Atom -> Either AtomFunctionError Ordering createInterval :: Atom -> Atom -> OpenInterval -> OpenInterval -> Either AtomFunctionError Atom intervalAtomType :: AtomType -> AtomType intervalAtomFunctions :: AtomFunctions isIntervalAtomType :: AtomType -> Bool intervalOverlaps :: Atom -> Atom -> Either AtomFunctionError Bool intervalTypeConstructorMapping :: TypeConstructorMapping module ProjectM36.Atom relationForAtom :: Atom -> Either RelationalError Relation atomToText :: Atom -> Text module ProjectM36.Tuple emptyTuple :: RelationTuple tupleSize :: RelationTuple -> Int tupleAttributeNameSet :: RelationTuple -> Set AttributeName tupleAttributes :: RelationTuple -> Attributes tupleAssocs :: RelationTuple -> [(AttributeName, Atom)] orderedTupleAssocs :: RelationTuple -> [(AttributeName, Atom)] tupleAtoms :: RelationTuple -> Vector Atom atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom atomsForAttributeNames :: Vector AttributeName -> RelationTuple -> Either RelationalError (Vector Atom) vectorIndicesForAttributeNames :: Vector AttributeName -> Attributes -> Either RelationalError (Vector Int) relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple mkRelationTuple :: Attributes -> Vector Atom -> RelationTuple mkRelationTuples :: Attributes -> [Vector Atom] -> [RelationTuple] mkRelationTupleFromMap :: Map AttributeName Atom -> RelationTuple singleTupleSetJoin :: Attributes -> RelationTuple -> RelationTupleSet -> Either RelationalError [RelationTuple] singleTupleJoin :: Attributes -> RelationTuple -> RelationTuple -> Either RelationalError (Maybe RelationTuple) vectorUnion :: Eq a => Vector a -> Vector a -> Vector a tupleExtend :: RelationTuple -> RelationTuple -> RelationTuple tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple tupleProject :: Attributes -> RelationTuple -> Either RelationalError RelationTuple tupleIntersection :: RelationTuple -> RelationTuple -> RelationTuple -- | An optimized form of tuple update which updates vectors efficiently. updateTupleWithAtoms :: Map AttributeName Atom -> RelationTuple -> RelationTuple tupleToMap :: RelationTuple -> Map AttributeName Atom -- | Validate that the tuple has the correct attributes in the correct -- order verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple reorderTuple :: Attributes -> RelationTuple -> RelationTuple trimTuple :: Int -> RelationTuple -> RelationTuple module ProjectM36.TupleSet emptyTupleSet :: RelationTupleSet singletonTupleSet :: RelationTupleSet verifyTupleSet :: Attributes -> RelationTupleSet -> Either RelationalError RelationTupleSet mkTupleSet :: Attributes -> [RelationTuple] -> Either RelationalError RelationTupleSet mkTupleSetFromList :: Attributes -> [[Atom]] -> Either RelationalError RelationTupleSet -- | Union two tuplesets while reordering their attribute/atom mapping -- properly. tupleSetUnion :: Attributes -> RelationTupleSet -> RelationTupleSet -> RelationTupleSet module ProjectM36.Relation attributes :: Relation -> Attributes attributeNames :: Relation -> Set AttributeName attributeForName :: AttributeName -> Relation -> Either RelationalError Attribute attributesForNames :: Set AttributeName -> Relation -> Attributes atomTypeForName :: AttributeName -> Relation -> Either RelationalError AtomType mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation emptyRelationWithAttrs :: Attributes -> Relation mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation mkRelationDeferVerify :: Attributes -> RelationTupleSet -> Either RelationalError Relation relationWithEmptyTupleSet :: Relation -> Relation mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation relationTrue :: Relation relationFalse :: Relation singletonTuple :: Relation -> Maybe RelationTuple union :: Relation -> Relation -> Either RelationalError Relation project :: Set AttributeName -> Relation -> Either RelationalError Relation renameMany :: Set (AttributeName, AttributeName) -> Relation -> Either RelationalError Relation rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation arity :: Relation -> Int degree :: Relation -> Int cardinality :: Relation -> RelationCardinality group :: Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation ungroup :: AttributeName -> Relation -> Either RelationalError Relation tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes type RestrictionFilter = RelationTuple -> Either RelationalError Bool restrict :: RestrictionFilter -> Relation -> Either RelationalError Relation join :: Relation -> Relation -> Either RelationalError Relation -- | Difference takes two relations of the same type and returns a new -- relation which contains only tuples which appear in the first relation -- but not the second. difference :: Relation -> Relation -> Either RelationalError Relation relMap :: (RelationTuple -> Either RelationalError RelationTuple) -> Relation -> Either RelationalError Relation relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a -- | Generate a randomly-ordered list of tuples from the relation. toList :: Relation -> IO [RelationTuple] imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation -- | Return a Relation describing the types in the mapping. typesAsRelation :: TypeConstructorMapping -> Either RelationalError Relation -- | Randomly resort the tuples. This is useful for emphasizing that two -- relations are equal even when they are printed to the console in -- different orders. randomizeTupleOrder :: MonadRandom m => Relation -> m Relation oneTuple :: Relation -> Maybe RelationTuple tuplesList :: Relation -> [RelationTuple] module ProjectM36.Sessions type Sessions = Map SessionId Session stmMapToList :: Map k v -> STM [(k, v)] stmSetToList :: Set v -> STM [v] uuidAtom :: UUID -> Atom sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation) module ProjectM36.Serialise.Base fromWordsTup :: (Word32, Word32, Word32, Word32) -> TransactionId fromGregorianTup :: (Integer, Int, Int) -> Day type SlimTupleSet = Either () (Attributes, [Vector Atom]) slimTupleSet :: RelationTupleSet -> SlimTupleSet -- | restore slimmed tuple set to include single shared attributes list fattenTupleSet :: SlimTupleSet -> RelationTupleSet instance Codec.Winery.Class.Serialise ProjectM36.Base.Atom instance Codec.Winery.Class.Serialise ProjectM36.Base.AtomType instance Codec.Winery.Class.Serialise ProjectM36.Base.Attribute instance Codec.Winery.Class.Serialise ProjectM36.Base.RelationTuple instance Codec.Winery.Class.Serialise ProjectM36.Base.RelationCardinality instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.RelationalExprBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.WithNameExprBase a) instance Codec.Winery.Class.Serialise ProjectM36.Base.Notification instance Codec.Winery.Class.Serialise ProjectM36.Base.TypeConstructorDef instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.TypeConstructorBase a) instance Codec.Winery.Class.Serialise ProjectM36.Base.DataConstructorDef instance Codec.Winery.Class.Serialise ProjectM36.Base.DataConstructorDefArg instance Codec.Winery.Class.Serialise ProjectM36.Base.GraphRefTransactionMarker instance Codec.Winery.Class.Serialise ProjectM36.Base.SchemaIsomorph instance Codec.Winery.Class.Serialise ProjectM36.Base.InclusionDependency instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.DatabaseContextExprBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.DatabaseContextIOExprBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.RestrictionPredicateExprBase a) instance Codec.Winery.Class.Serialise ProjectM36.Base.TransactionInfo instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.AtomExprBase a) instance Codec.Winery.Class.Serialise ProjectM36.MerkleHash.MerkleHash instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.AttributeExprBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.TupleExprsBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.TupleExprBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.AttributeNamesBase a) instance Codec.Winery.Class.Serialise a => Codec.Winery.Class.Serialise (ProjectM36.Base.ExtendTupleExprBase a) instance Codec.Winery.Class.Serialise ProjectM36.Base.Schema instance Codec.Winery.Class.Serialise ProjectM36.Base.MergeStrategy instance Codec.Winery.Class.Serialise ProjectM36.Base.NotificationExpression instance Codec.Winery.Class.Serialise ProjectM36.Base.RelationTupleSet instance Codec.Winery.Class.Serialise ProjectM36.Base.TransactionId instance Codec.Winery.Class.Serialise Data.Time.Calendar.Days.Day instance Codec.Winery.Class.Serialise ProjectM36.Base.Attributes instance Codec.Winery.Class.Serialise ProjectM36.Base.Relation module ProjectM36.Serialise.Error instance Codec.Winery.Class.Serialise ProjectM36.Error.RelationalError instance Codec.Winery.Class.Serialise ProjectM36.Error.MergeError instance Codec.Winery.Class.Serialise ProjectM36.Error.ScriptCompilationError instance Codec.Winery.Class.Serialise ProjectM36.Error.PersistenceError instance Codec.Winery.Class.Serialise ProjectM36.Error.SchemaError instance Codec.Winery.Class.Serialise ProjectM36.Error.ImportError' instance Codec.Winery.Class.Serialise ProjectM36.Error.SQLError module ProjectM36.SQL.Update data Update Update :: TableName -> [(UnqualifiedColumnName, ScalarExpr)] -> Maybe RestrictionExpr -> Update [target] :: Update -> TableName [setColumns] :: Update -> [(UnqualifiedColumnName, ScalarExpr)] [mRestriction] :: Update -> Maybe RestrictionExpr instance Codec.Winery.Class.Serialise ProjectM36.SQL.Update.Update instance Control.DeepSeq.NFData ProjectM36.SQL.Update.Update instance GHC.Generics.Generic ProjectM36.SQL.Update.Update instance GHC.Classes.Eq ProjectM36.SQL.Update.Update instance GHC.Show.Show ProjectM36.SQL.Update.Update module ProjectM36.SQL.Insert data Insert Insert :: TableName -> [UnqualifiedColumnName] -> Query -> Insert [target] :: Insert -> TableName [targetColumns] :: Insert -> [UnqualifiedColumnName] [source] :: Insert -> Query instance Codec.Winery.Class.Serialise ProjectM36.SQL.Insert.Insert instance Control.DeepSeq.NFData ProjectM36.SQL.Insert.Insert instance GHC.Generics.Generic ProjectM36.SQL.Insert.Insert instance GHC.Classes.Eq ProjectM36.SQL.Insert.Insert instance GHC.Show.Show ProjectM36.SQL.Insert.Insert module ProjectM36.SQL.DBUpdate -- | represents any SQL expression which can change the current transaction -- state such as data DBUpdate UpdateUpdate :: Update -> DBUpdate UpdateInsert :: Insert -> DBUpdate UpdateDelete :: Delete -> DBUpdate UpdateCreateTable :: CreateTable -> DBUpdate UpdateDropTable :: DropTable -> DBUpdate instance Codec.Winery.Class.Serialise ProjectM36.SQL.DBUpdate.DBUpdate instance Control.DeepSeq.NFData ProjectM36.SQL.DBUpdate.DBUpdate instance GHC.Generics.Generic ProjectM36.SQL.DBUpdate.DBUpdate instance GHC.Classes.Eq ProjectM36.SQL.DBUpdate.DBUpdate instance GHC.Show.Show ProjectM36.SQL.DBUpdate.DBUpdate -- | Module for functionality common between the various Function types -- (AtomFunction, DatabaseContextFunction). module ProjectM36.Function -- | Return the underlying function to run the Function. function :: FunctionBody a -> a -- | Return the text-based Haskell script, if applicable. functionScript :: Function a -> Maybe FunctionBodyScript -- | Change atom function definition to reference proper object file -- source. Useful when moving the object file into the database -- directory. processObjectLoadedFunctionBody :: ObjectModuleName -> ObjectFileEntryFunctionName -> FilePath -> FunctionBody a -> FunctionBody a processObjectLoadedFunctions :: Functor f => ObjectModuleName -> ObjectFileEntryFunctionName -> FilePath -> f (Function a) -> f (Function a) loadFunctions :: ModName -> FuncName -> Maybe FilePath -> FilePath -> IO (Either LoadSymbolError [Function a]) functionForName :: FunctionName -> HashSet (Function a) -> Either RelationalError (Function a) module ProjectM36.Relation.Parse.CSV data CsvImportError CsvParseError :: String -> CsvImportError AttributeMappingError :: RelationalError -> CsvImportError HeaderAttributeMismatchError :: Set AttributeName -> CsvImportError csvDecodeOptions :: DecodeOptions csvAsRelation :: Attributes -> TypeConstructorMapping -> ByteString -> Either CsvImportError Relation parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> Parser Text -> Parser (Either RelationalError Atom) capitalizedIdentifier :: Parser Text takeToEndOfColumnData :: Parser Text takeToEndOfIntervalBlock :: Parser Text parens :: Parser a -> Parser a quotedString :: Parser Text instance GHC.Show.Show ProjectM36.Relation.Parse.CSV.CsvImportError module ProjectM36.Key -- | Create a uniqueness constraint for the attribute names and relational -- expression. Note that constraint can span multiple relation variables. inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency -- | Create a DatabaseContextExpr which can be used to add a -- uniqueness constraint to attributes on one relation variable. databaseContextExprForUniqueKey :: RelVarName -> [AttributeName] -> DatabaseContextExpr -- | Create a foreign key constraint from the first relation variable and -- attributes to the second. databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr inclusionDependencyForForeignKey :: (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> InclusionDependency isForeignKeyFor :: InclusionDependency -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> Bool module ProjectM36.InclusionDependency inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation inclusionDependencyForAtomExpr :: RelVarName -> AtomExpr -> InclusionDependency module ProjectM36.DatabaseContextFunction externalDatabaseContextFunction :: DatabaseContextFunctionBodyType -> DatabaseContextFunctionBody emptyDatabaseContextFunction :: FunctionName -> DatabaseContextFunction databaseContextFunctionForName :: FunctionName -> DatabaseContextFunctions -> Either RelationalError DatabaseContextFunction evalDatabaseContextFunction :: DatabaseContextFunction -> [Atom] -> DatabaseContext -> Either RelationalError DatabaseContext basicDatabaseContextFunctions :: DatabaseContextFunctions precompiledDatabaseContextFunctions :: DatabaseContextFunctions isScriptedDatabaseContextFunction :: DatabaseContextFunction -> Bool databaseContextFunctionReturnType :: TypeConstructor -> TypeConstructor createScriptedDatabaseContextFunction :: FunctionName -> [TypeConstructor] -> TypeConstructor -> FunctionBodyScript -> DatabaseContextIOExpr databaseContextFunctionsAsRelation :: DatabaseContextFunctions -> Either RelationalError Relation module ProjectM36.Relation.Show.HTML attributesAsHTML :: Attributes -> Text relationAsHTML :: Relation -> Text writeHTML :: Text -> IO () writeRel :: Relation -> IO () tupleAsHTML :: RelationTuple -> Text tupleSetAsHTML :: RelationTupleSet -> Text module ProjectM36.Relation.Show.CSV relationAsCSV :: Relation -> Either RelationalError ByteString newtype RecordRelationTuple RecordRelationTuple :: RelationTuple -> RecordRelationTuple [unTuple] :: RecordRelationTuple -> RelationTuple newtype RecordAtom RecordAtom :: Atom -> RecordAtom [unAtom] :: RecordAtom -> Atom instance Data.Csv.Conversion.ToNamedRecord ProjectM36.Relation.Show.CSV.RecordRelationTuple instance Data.Csv.Conversion.ToField ProjectM36.Relation.Show.CSV.RecordAtom instance Data.Csv.Conversion.DefaultOrdered ProjectM36.Relation.Show.CSV.RecordRelationTuple module ProjectM36.AtomFunction foldAtomFuncType :: AtomType -> AtomType -> [AtomType] atomFunctionForName :: FunctionName -> AtomFunctions -> Either RelationalError AtomFunction -- | Create a junk named atom function for use with searching for an -- already existing function in the AtomFunctions HashSet. emptyAtomFunction :: FunctionName -> AtomFunction -- | AtomFunction constructor for compiled-in functions. compiledAtomFunction :: FunctionName -> [AtomType] -> AtomFunctionBodyType -> AtomFunction evalAtomFunction :: AtomFunction -> [Atom] -> Either AtomFunctionError Atom extractAtomFunctionType :: [TypeConstructor] -> Either RelationalError [TypeConstructor] isScriptedAtomFunction :: AtomFunction -> Bool -- | Create a DatabaseContextIOExpr which can be used to load a new -- atom function written in Haskell and loaded at runtime. createScriptedAtomFunction :: FunctionName -> [TypeConstructor] -> TypeConstructor -> FunctionBodyScript -> DatabaseContextIOExpr atomFunctionsAsRelation :: AtomFunctions -> Either RelationalError Relation -- | Used to mark functions which are loaded externally from the server. externalAtomFunction :: AtomFunctionBodyType -> AtomFunctionBody module ProjectM36.DataTypes.SQL.Null nullAtomType :: AtomType -> AtomType nullTypeConstructorMapping :: TypeConstructorMapping nullAtomFunctions :: AtomFunctions sqlCompareFunctions :: HashSet AtomFunction maybeFromAtom :: Atom -> Maybe Atom coalesceBool :: [Atom] -> Either AtomFunctionError Atom isSQLBool :: Atom -> Bool sqlBool :: Atom -> Maybe Bool nullAnd :: [Atom] -> Either AtomFunctionError Atom nullOr :: [Atom] -> Either AtomFunctionError Atom nullAtom :: AtomType -> Maybe Atom -> Atom isNullOrType :: AtomType -> Atom -> Bool isNull :: Atom -> Bool isNullAtomType :: AtomType -> Bool atomTypeFromSQLNull :: AtomType -> Maybe AtomType sqlIntegerBinaryFunction :: AtomType -> (Integer -> Integer -> Atom) -> [Atom] -> Either AtomFunctionError Atom sqlIntegerUnaryFunction :: AtomType -> (Integer -> Atom) -> [Atom] -> Either AtomFunctionError Atom sqlCount :: [Atom] -> Either AtomFunctionError Atom sqlAbs :: [Atom] -> Either AtomFunctionError Atom sqlMax :: [Atom] -> Either AtomFunctionError Atom sqlMin :: [Atom] -> Either AtomFunctionError Atom sqlSum :: [Atom] -> Either AtomFunctionError Atom sqlIntegerAgg :: (Integer -> Integer -> Integer) -> [Atom] -> Either AtomFunctionError Atom sqlNullableIntegerToMaybe :: Atom -> Maybe Integer sqlEqualsTypes :: Atom -> Atom -> Bool sqlEquals :: AtomFunctionBodyType sqlIsNull :: AtomFunctionBodyType isSQLNullableType :: AtomType -> Bool isSQLNullableSpecificType :: AtomType -> AtomType -> Bool isSQLNullUnknownType :: AtomType -> Bool module ProjectM36.DataTypes.Either eitherAtomType :: AtomType -> AtomType -> AtomType eitherTypeConstructorMapping :: TypeConstructorMapping eitherAtomFunctions :: AtomFunctions module ProjectM36.DataTypes.Basic basicTypeConstructorMapping :: TypeConstructorMapping module ProjectM36.Atomable -- | 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. class (Eq a, NFData a, Serialise a, Show a) => Atomable a toAtom :: Atomable a => a -> Atom toAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => a -> Atom fromAtom :: Atomable a => Atom -> a fromAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => Atom -> a toAtomType :: Atomable a => proxy a -> AtomType toAtomType :: (Atomable a, Generic a, AtomableG (Rep a)) => proxy a -> AtomType -- | Creates DatabaseContextExpr necessary to load the type constructor and -- data constructor into the database. toAddTypeExpr :: Atomable a => proxy a -> DatabaseContextExpr -- | Creates DatabaseContextExpr necessary to load the type constructor and -- data constructor into the database. toAddTypeExpr :: (Atomable a, Generic a, AtomableG (Rep a)) => proxy a -> DatabaseContextExpr class AtomableG g toAtomG :: AtomableG g => g a -> AtomType -> Atom fromAtomG :: AtomableG g => Atom -> [Atom] -> Maybe (g a) toAtomTypeG :: AtomableG g => g a -> AtomType toAtomsG :: AtomableG g => g a -> [Atom] toAddTypeExprG :: AtomableG g => g a -> AtomType -> DatabaseContextExpr getConstructorsG :: AtomableG g => g a -> [DataConstructorDef] getConstructorArgsG :: AtomableG g => g a -> [DataConstructorDefArg] typeToTypeConstructor :: AtomType -> TypeConstructor instance ProjectM36.Atomable.Atomable GHC.Num.Integer.Integer instance ProjectM36.Atomable.Atomable GHC.Types.Int instance ProjectM36.Atomable.Atomable GHC.Types.Double instance ProjectM36.Atomable.Atomable Data.Text.Internal.Text instance ProjectM36.Atomable.Atomable Data.Time.Calendar.Days.Day instance ProjectM36.Atomable.Atomable Data.Time.Clock.Internal.UTCTime.UTCTime instance ProjectM36.Atomable.Atomable Data.ByteString.Internal.Type.ByteString instance ProjectM36.Atomable.Atomable GHC.Types.Bool instance ProjectM36.Atomable.Atomable Data.UUID.Types.Internal.UUID instance ProjectM36.Atomable.Atomable a => ProjectM36.Atomable.Atomable (GHC.Maybe.Maybe a) instance (ProjectM36.Atomable.Atomable a, ProjectM36.Atomable.Atomable b) => ProjectM36.Atomable.Atomable (Data.Either.Either a b) instance ProjectM36.Atomable.Atomable a => ProjectM36.Atomable.Atomable [a] instance ProjectM36.Atomable.Atomable a => ProjectM36.Atomable.Atomable (GHC.Base.NonEmpty a) instance ProjectM36.Atomable.Atomable a => ProjectM36.Atomable.AtomableG (GHC.Generics.K1 c a) instance forall k (c :: GHC.Generics.Meta) (a :: k -> *). (GHC.Generics.Datatype c, ProjectM36.Atomable.AtomableG a) => ProjectM36.Atomable.AtomableG (GHC.Generics.M1 GHC.Generics.D c a) instance forall k (c :: GHC.Generics.Meta) (a :: k -> *). (GHC.Generics.Constructor c, ProjectM36.Atomable.AtomableG a) => ProjectM36.Atomable.AtomableG (GHC.Generics.M1 GHC.Generics.C c a) instance forall k (c :: GHC.Generics.Meta) (a :: k -> *). (GHC.Generics.Selector c, ProjectM36.Atomable.AtomableG a) => ProjectM36.Atomable.AtomableG (GHC.Generics.M1 GHC.Generics.S c a) instance ProjectM36.Atomable.AtomableG GHC.Generics.U1 instance forall k (a :: k -> *) (b :: k -> *). (ProjectM36.Atomable.AtomableG a, ProjectM36.Atomable.AtomableG b) => ProjectM36.Atomable.AtomableG (a GHC.Generics.:*: b) instance forall k (a :: k -> *) (b :: k -> *). (ProjectM36.Atomable.AtomableG a, ProjectM36.Atomable.AtomableG b) => ProjectM36.Atomable.AtomableG (a GHC.Generics.:+: b) module ProjectM36.Tupleable -- | Convert a Traverseable of Tupleables to an -- Insert DatabaseContextExpr. This is useful for -- converting, for example, a list of data values to a set of Insert -- expressions which can be used to add the values to the database. toInsertExpr :: forall a t. (Tupleable a, Traversable t) => t a -> RelVarName -> Either RelationalError DatabaseContextExpr -- | Convert a Tupleable to a create a Define expression -- which can be used to create an empty relation variable. Use -- toInsertExpr to insert the actual tuple data. This function is -- typically used with Proxy. toDefineExpr :: forall a proxy. Tupleable a => proxy a -> RelVarName -> DatabaseContextExpr tupleAssocsEqualityPredicate :: [(AttributeName, Atom)] -> RestrictionPredicateExpr partitionByAttributes :: Tupleable a => [AttributeName] -> a -> ([(AttributeName, Atom)], [(AttributeName, Atom)]) -- | Convert a list of key attributes and a Tupleable value to an -- Update expression. This expression flushes the non-key -- attributes of the value to a tuple with the matching key attributes. toUpdateExpr :: forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr -- | Convert a list of key attributes and a Tupleable value to a -- Delete expression. This expression deletes tuples matching the -- key attributes from the value. toDeleteExpr :: forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr validateAttributes :: Set AttributeName -> Set AttributeName -> a -> Either RelationalError a -- | Types that can be converted to and from RelationTuple. -- -- deriving without customization: -- --
-- data Example = Example -- { foo :: Integer -- , bar :: Text -- } -- deriving (Generic) -- -- instance Tupleable Example ---- -- deriving with customization using -- ProjectM36.Tupleable.Deriving: -- --
-- data Example = Example -- { exampleFoo :: Integer -- , exampleBar :: Text -- } -- deriving stock (Generic) -- deriving (Tupleable) -- via Codec (Field (DropPrefix "example" >>> CamelCase)) Example --class Tupleable a toTuple :: Tupleable a => a -> RelationTuple fromTuple :: Tupleable a => RelationTuple -> Either RelationalError a toAttributes :: Tupleable a => Proxy a -> Attributes toTuple :: (Tupleable a, Generic a, TupleableG (Rep a)) => a -> RelationTuple fromTuple :: (Tupleable a, Generic a, TupleableG (Rep a)) => RelationTuple -> Either RelationalError a toAttributes :: (Tupleable a, Generic a, TupleableG (Rep a)) => Proxy a -> Attributes genericToTuple :: (Generic a, TupleableG (Rep a)) => TupleableOptions -> a -> RelationTuple genericFromTuple :: (Generic a, TupleableG (Rep a)) => TupleableOptions -> RelationTuple -> Either RelationalError a genericToAttributes :: forall a. (Generic a, TupleableG (Rep a)) => TupleableOptions -> Proxy a -> Attributes class TupleableG g toTupleG :: TupleableG g => TupleableOptions -> g a -> RelationTuple toAttributesG :: TupleableG g => TupleableOptions -> g a -> Attributes fromTupleG :: TupleableG g => TupleableOptions -> RelationTuple -> Either RelationalError (g a) isRecordTypeG :: TupleableG g => g a -> Bool -- | The default options for deriving Tupleable instances. -- -- These options can be customized by using record update syntax. For -- example, -- --
-- defaultTupleableOptions -- { fieldModifier = \fieldName -> -- case Data.Text.stripPrefix "example" fieldName of -- Nothing -> fieldName -- Just attributeName -> attributeName -- } ---- -- will result in record field names being translated into attribute -- names by removing the prefix "example" from the field names. defaultTupleableOptions :: TupleableOptions -- | Options that influence deriving behavior. data TupleableOptions -- | A function that translates record field names into attribute names. fieldModifier :: TupleableOptions -> Text -> Text instance (GHC.Generics.Datatype c, ProjectM36.Tupleable.TupleableG a) => ProjectM36.Tupleable.TupleableG (GHC.Generics.M1 GHC.Generics.D c a) instance (GHC.Generics.Constructor c, ProjectM36.Tupleable.TupleableG a, ProjectM36.Atomable.AtomableG a) => ProjectM36.Tupleable.TupleableG (GHC.Generics.M1 GHC.Generics.C c a) instance (ProjectM36.Tupleable.TupleableG a, ProjectM36.Tupleable.TupleableG b) => ProjectM36.Tupleable.TupleableG (a GHC.Generics.:*: b) instance (GHC.Generics.Selector c, ProjectM36.Atomable.AtomableG a) => ProjectM36.Tupleable.TupleableG (GHC.Generics.M1 GHC.Generics.S c a) instance ProjectM36.Tupleable.TupleableG GHC.Generics.U1 -- | Newtypes for deriving Tupleable instances with customization using -- DerivingVia. -- -- Inspired by Dhall.Deriving which in turn was inspired by Matt -- Parson's blog post Mirror Mirror: Reflection and Encoding Via. -- -- required extensions: -- --
-- data Example = Example -- { exampleFoo :: Int -- , exampleBar :: Int -- } -- deriving stock (Generic) -- deriving (Tupleable) -- via Codec (Field (DropPrefix "example" >>> CamelCase)) Example ---- -- will derive an instance of Tupleable where field names are -- translated into attribute names by dropping the prefix -- "example" and then converting the result to camelCase. So -- "exampleFoo" becomes "foo" and "exampleBar" -- becomes "bar". -- -- Requires the DerivingGeneric and DerivingVia -- extensions to be enabled. newtype Codec tag a Codec :: a -> Codec tag a [unCodec] :: Codec tag a -> a -- | Types that can be used as tags for Codec. class ModifyOptions a modifyOptions :: ModifyOptions a => proxy a -> TupleableOptions -> TupleableOptions -- | Change how record field names are translated into attribute names. For -- example, -- --
-- Field SnakeCase ---- -- will translate the field name fooBar into the attribute name -- foo_bar. data Field a -- | Types that can be used in options that modify Text such as in -- Field. class ModifyText a modifyText :: ModifyText a => proxy a -> Text -> Text -- | Add a prefix. AddPrefix "foo" will transform "bar" -- into "foobar". data AddPrefix (prefix :: Symbol) -- | Drop a prefix. DropPrefix "bar" will transform -- "foobar" into "foo". data DropPrefix (prefix :: Symbol) -- | Add a suffix. AddSuffix "bar" will transform "foo" -- into "foobar". data AddSuffix (suffix :: Symbol) -- | Drop a suffix. DropSuffix "bar" will transform -- "foobar" into "foo". data DropSuffix (suffix :: Symbol) -- | Convert to UPPERCASE. Will transform "foobar" into -- "FOOBAR". data UpperCase -- | Convert to lowercase. Will transform "FOOBAR" into -- "foobar". data LowerCase -- | Convert to Title Case. Will transform "fooBar" into "Foo -- Bar". data TitleCase -- | Convert to camelCase. Will transform "foo_bar" into -- "fooBar". data CamelCase -- | Convert to PascalCase. Will transform "foo_bar" into -- "FooBar". data PascalCase -- | Convert to snake_case. Will transform "fooBar" into -- "foo_bar". data SnakeCase -- | Convert to spinal-case. will transform "fooBar" into -- "foo-bar". data SpinalCase -- | Convert to Train-Case. Will transform "fooBar" into -- "Foo-Bar". data TrainCase -- | Identity option. type AsIs = () -- | Right to left composition. -- -- Requires the TypeOperators extension to be enabled. data a <<< b -- | Left to right composition. -- -- Requires the TypeOperators extension to be enabled. data a >>> b -- | Representable types of kind *. This class is derivable in GHC -- with the DeriveGeneric flag on. -- -- A Generic instance must satisfy the following laws: -- --
-- from . to ≡ id -- to . from ≡ id --class Generic a instance (ProjectM36.Tupleable.Deriving.ModifyOptions a, ProjectM36.Tupleable.Deriving.ModifyOptions b) => ProjectM36.Tupleable.Deriving.ModifyOptions (a ProjectM36.Tupleable.Deriving.>>> b) instance (ProjectM36.Tupleable.Deriving.ModifyText a, ProjectM36.Tupleable.Deriving.ModifyText b) => ProjectM36.Tupleable.Deriving.ModifyText (a ProjectM36.Tupleable.Deriving.>>> b) instance (ProjectM36.Tupleable.Deriving.ModifyOptions a, ProjectM36.Tupleable.Deriving.ModifyOptions b) => ProjectM36.Tupleable.Deriving.ModifyOptions (a ProjectM36.Tupleable.Deriving.<<< b) instance (ProjectM36.Tupleable.Deriving.ModifyText a, ProjectM36.Tupleable.Deriving.ModifyText b) => ProjectM36.Tupleable.Deriving.ModifyText (a ProjectM36.Tupleable.Deriving.<<< b) instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.TrainCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.SpinalCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.SnakeCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.PascalCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.CamelCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.TitleCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.LowerCase instance ProjectM36.Tupleable.Deriving.ModifyText ProjectM36.Tupleable.Deriving.UpperCase instance GHC.TypeLits.KnownSymbol suffix => ProjectM36.Tupleable.Deriving.ModifyText (ProjectM36.Tupleable.Deriving.DropSuffix suffix) instance GHC.TypeLits.KnownSymbol suffix => ProjectM36.Tupleable.Deriving.ModifyText (ProjectM36.Tupleable.Deriving.AddSuffix suffix) instance GHC.TypeLits.KnownSymbol prefix => ProjectM36.Tupleable.Deriving.ModifyText (ProjectM36.Tupleable.Deriving.DropPrefix prefix) instance GHC.TypeLits.KnownSymbol prefix => ProjectM36.Tupleable.Deriving.ModifyText (ProjectM36.Tupleable.Deriving.AddPrefix prefix) instance ProjectM36.Tupleable.Deriving.ModifyText a => ProjectM36.Tupleable.Deriving.ModifyOptions (ProjectM36.Tupleable.Deriving.Field a) instance ProjectM36.Tupleable.Deriving.ModifyText () instance (ProjectM36.Tupleable.Deriving.ModifyOptions tag, GHC.Generics.Generic a, ProjectM36.Tupleable.TupleableG (GHC.Generics.Rep a)) => ProjectM36.Tupleable.Tupleable (ProjectM36.Tupleable.Deriving.Codec tag a) instance ProjectM36.Tupleable.Deriving.ModifyOptions () module ProjectM36.Shortcuts data HaskAtomType a [Int] :: HaskAtomType Int [Integer] :: HaskAtomType Integer [Double] :: HaskAtomType Double [Text] :: HaskAtomType Text [Bool] :: HaskAtomType Bool [Attr] :: Atomable a => HaskAtomType a toAtomType'' :: Atomable a => HaskAtomType a -> AtomType relation :: [TupleExpr] -> RelationalExpr relation' :: [AttributeExprBase ()] -> [TupleExpr] -> RelationalExpr tuple :: [(AttributeName, AtomExpr)] -> TupleExprBase () rename :: RelationalExpr -> [(AttributeName, AttributeName)] -> RelationalExpr (!!) :: RelationalExpr -> AttributeNames -> RelationalExpr infix 9 !! (><) :: RelationalExpr -> RelationalExpr -> RelationalExpr allBut :: AttributeNames -> AttributeNames allFrom :: RelationalExpr -> AttributeNames as :: AttributeNames -> AttributeName -> (AttributeNames, AttributeName) group :: RelationalExpr -> (AttributeNames, AttributeName) -> RelationalExpr ungroup :: RelationalExpr -> AttributeName -> RelationalExpr (#:) :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr infix 8 #: (@@) :: AttributeName -> AtomExpr f :: Convertible a AtomExpr => FunctionName -> [a] -> AtomExpr (#::) :: RelVarName -> [AttributeExpr] -> DatabaseContextExpr infix 5 #:: (#:=) :: RelVarName -> RelationalExpr -> DatabaseContextExpr infix 5 #:= class Boolean a b (&&&) :: Boolean a b => a -> b -> RestrictionPredicateExpr (|||) :: Boolean a b => a -> b -> RestrictionPredicateExpr infixl 6 &&& infixl 5 ||| (@~) :: Convertible a RestrictionPredicateExpr => RelationalExpr -> a -> RelationalExpr infix 4 @~ true :: RelationalExpr false :: RelationalExpr trueP :: RestrictionPredicateExprBase a falseP :: RestrictionPredicateExprBase a (?=) :: Convertible a AtomExpr => AttributeName -> a -> RestrictionPredicateExpr infix 9 ?= not' :: Convertible a RestrictionPredicateExpr => a -> RestrictionPredicateExpr toAtomExpr :: Atom -> AtomExpr instance (Data.Convertible.Base.Convertible a ProjectM36.Base.RestrictionPredicateExpr, Data.Convertible.Base.Convertible b ProjectM36.Base.RestrictionPredicateExpr) => ProjectM36.Shortcuts.Boolean a b instance (GHC.TypeLits.KnownSymbol x, ProjectM36.Atomable.Atomable a) => GHC.OverloadedLabels.IsLabel x (ProjectM36.Shortcuts.HaskAtomType a -> ProjectM36.Base.AttributeExpr) instance GHC.Exts.IsList (ProjectM36.Base.AttributeNamesBase ()) instance GHC.Exts.IsList (ProjectM36.Base.TupleExprsBase ()) instance GHC.Exts.IsList ProjectM36.Base.TupleExpr instance GHC.TypeLits.KnownSymbol x => GHC.OverloadedLabels.IsLabel x Data.Text.Internal.Text instance GHC.TypeLits.KnownSymbol x => GHC.OverloadedLabels.IsLabel x ProjectM36.Base.RelationalExpr instance (Data.Convertible.Base.Convertible a ProjectM36.Base.AtomExpr, GHC.TypeLits.KnownSymbol x) => GHC.OverloadedLabels.IsLabel x (a -> ProjectM36.Base.ExtendTupleExpr) instance (Data.Convertible.Base.Convertible a ProjectM36.Base.AtomExpr, GHC.TypeLits.KnownSymbol x) => GHC.OverloadedLabels.IsLabel x (a -> (ProjectM36.Base.AttributeName, ProjectM36.Base.AtomExpr)) instance (GHC.TypeLits.KnownSymbol x, Data.Convertible.Base.Convertible a ProjectM36.Base.AtomExpr) => GHC.OverloadedLabels.IsLabel x ([a] -> ProjectM36.Base.AtomExpr) instance GHC.TypeLits.KnownSymbol x => GHC.OverloadedLabels.IsLabel x ProjectM36.Base.AtomExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.AtomExpr ProjectM36.Base.AtomExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.RelVarName ProjectM36.Base.AtomExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.RelationalExpr ProjectM36.Base.AtomExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.RelVarName ProjectM36.Base.RelationalExpr instance ProjectM36.Atomable.Atomable a => Data.Convertible.Base.Convertible a ProjectM36.Base.RestrictionPredicateExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.RelationalExpr ProjectM36.Base.RestrictionPredicateExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.AtomExpr ProjectM36.Base.RestrictionPredicateExpr instance Data.Convertible.Base.Convertible ProjectM36.Base.RestrictionPredicateExpr ProjectM36.Base.RestrictionPredicateExpr instance ProjectM36.Atomable.Atomable a => Data.Convertible.Base.Convertible a ProjectM36.Base.AtomExpr module ProjectM36.AtomFunctions.Primitive primitiveAtomFunctions :: AtomFunctions integerAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom boolAtomNot :: Atom -> Either AtomFunctionError Atom relationSum :: Relation -> AttributeName -> Either AtomFunctionError Atom relationCount :: Relation -> Either AtomFunctionError Atom relationMax :: Relation -> AttributeName -> Either AtomFunctionError Atom relationMin :: Relation -> AttributeName -> Either AtomFunctionError Atom relationMean :: Relation -> AttributeName -> Either AtomFunctionError Atom castInt :: Atom -> Int castInteger :: Atom -> Integer scientificAtomFunctions :: AtomFunctions module ProjectM36.Relation.Show.Gnuplot data PlotError InvalidAttributeCountError :: PlotError InvalidAttributeTypeError :: PlotError intFromAtomIndex :: Int -> RelationTuple -> Int graph1DRelation :: Relation -> T Int Int points1DRelation :: Relation -> [Int] graph2DRelation :: Relation -> T Int Int points2DRelation :: Relation -> [(Int, Int)] graph3DRelation :: Relation -> T Int Int Int points3DRelation :: Relation -> [(Int, Int, Int)] plotRelation :: Relation -> IO (Maybe PlotError) instance GHC.Show.Show ProjectM36.Relation.Show.Gnuplot.PlotError module ProjectM36.AtomFunctions.Basic basicAtomFunctions :: AtomFunctions precompiledAtomFunctions :: AtomFunctions module ProjectM36.Transaction.Persist getDirectoryNames :: FilePath -> IO [FilePath] tempTransactionDir :: FilePath -> TransactionId -> FilePath transactionDir :: FilePath -> TransactionId -> FilePath transactionInfoPath :: FilePath -> FilePath notificationsPath :: FilePath -> FilePath relvarsPath :: FilePath -> FilePath incDepsDir :: FilePath -> FilePath atomFuncsPath :: FilePath -> FilePath dbcFuncsPath :: FilePath -> FilePath typeConsPath :: FilePath -> FilePath subschemasPath :: FilePath -> FilePath registeredQueriesPath :: FilePath -> FilePath aggregateFunctionsPath :: FilePath -> FilePath -- | where compiled modules are stored within the database directory objectFilesPath :: FilePath -> FilePath readTransaction :: FilePath -> TransactionId -> Maybe ScriptSession -> IO (Either PersistenceError Transaction) writeTransaction :: DiskSync -> FilePath -> Transaction -> IO () writeRelVars :: DiskSync -> FilePath -> RelationVariables -> IO () readRelVars :: FilePath -> IO RelationVariables writeFuncs :: Traversable t => DiskSync -> FilePath -> t (Function a) -> IO () readFuncs :: FilePath -> FilePath -> HashSet (Function a) -> Maybe ScriptSession -> IO (HashSet (Function a)) newtype ObjectFileInfo ObjectFileInfo :: (FilePath, String, String) -> ObjectFileInfo [_unFileInfo] :: ObjectFileInfo -> (FilePath, String, String) loadFunc :: FilePath -> HashSet (Function a) -> Maybe ScriptSession -> FunctionName -> [AtomType] -> Maybe FunctionBodyScript -> Maybe ObjectFileInfo -> IO (Function a) readAtomFunc :: FilePath -> FunctionName -> Maybe ScriptSession -> AtomFunctions -> IO AtomFunction writeIncDep :: DiskSync -> FilePath -> (IncDepName, InclusionDependency) -> IO () writeIncDeps :: DiskSync -> FilePath -> Map IncDepName InclusionDependency -> IO () readIncDep :: FilePath -> IncDepName -> IO (IncDepName, InclusionDependency) readIncDeps :: FilePath -> IO (Map IncDepName InclusionDependency) readSubschemas :: FilePath -> IO Subschemas writeSubschemas :: DiskSync -> FilePath -> Subschemas -> IO () writeTypeConstructorMapping :: DiskSync -> FilePath -> TypeConstructorMapping -> IO () readTypeConstructorMapping :: FilePath -> IO TypeConstructorMapping readRegisteredQueries :: FilePath -> IO RegisteredQueries writeRegisteredQueries :: DiskSync -> FilePath -> RegisteredQueries -> IO () readNotifications :: FilePath -> IO Notifications writeNotifications :: DiskSync -> FilePath -> Notifications -> IO () instance Codec.Winery.Class.Serialise ProjectM36.Transaction.Persist.ObjectFileInfo instance GHC.Show.Show ProjectM36.Transaction.Persist.ObjectFileInfo module ProjectM36.DatabaseContext empty :: DatabaseContext -- | Remove TransactionId markers on GraphRefRelationalExpr stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr -- | convert an existing database context into its constituent expression. databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr basicDatabaseContext :: DatabaseContext someDatabaseContextExprs :: [DatabaseContextExpr] -> DatabaseContextExpr -- | Enables SQL-equivalent features such as NULL types in the database in -- addition to Project:M36 basic functions. module ProjectM36.SQLDatabaseContext sqlDatabaseContext :: DatabaseContext module ProjectM36.DateExamples dateExamples :: DatabaseContext suppliersRel :: Relation supplierProductsRel :: Relation productsRel :: Relation module ProjectM36.Arbitrary arbitrary' :: AtomType -> WithTCMap Gen (Either RelationalError Atom) maybeToRight :: b -> Maybe a -> Either b a arbitraryRelationTuple :: Attributes -> WithTCMap Gen (Either RelationalError RelationTuple) arbitraryWithRange :: Gen (Either RelationalError RelationTuple) -> Range -> Gen [Either RelationalError RelationTuple] arbitraryRelation :: Attributes -> Range -> WithTCMap Gen (Either RelationalError Relation) type WithTCMap a = ReaderT TypeConstructorMapping a createArbitraryInterval :: AtomType -> WithTCMap Gen (Either RelationalError Atom) module ProjectM36.WCWidth wIDEEASTASIAN :: RangeSet Int zEROWIDTH :: RangeSet Int basicZero :: RangeSet Int ctrlChars :: RangeSet Int wcwidth :: Char -> Int module ProjectM36.Relation.Show.Term boxV :: StringType boxH :: StringType boxTL :: StringType boxTR :: StringType boxBL :: StringType boxBR :: StringType boxLB :: StringType boxRB :: StringType boxTB :: StringType boxBB :: StringType boxC :: StringType type Cell = StringType type Table = ([Cell], [[Cell]]) addRow :: [Cell] -> Table -> Table cellLocations :: Table -> ([Int], [Int]) breakLines :: StringType -> [StringType] cellSizes :: Table -> [([Int], [Int])] relationAsTable :: Relation -> Table showParens :: Bool -> StringType -> StringType showAtom :: Int -> Atom -> StringType renderTable :: Table -> StringType renderHeader :: Table -> [Int] -> StringType renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType leftPaddedString :: Int -> Int -> StringType -> StringType renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType renderBody :: [[Cell]] -> ([Int], [Int]) -> StringType repeatString :: Int -> StringType -> StringType showRelation :: Relation -> StringType stringDisplayLength :: StringType -> Int module ProjectM36.DataFrame data AttributeOrderExpr AttributeOrderExpr :: AttributeName -> Order -> AttributeOrderExpr data AttributeOrder AttributeOrder :: AttributeName -> Order -> AttributeOrder data Order AscendingOrder :: Order DescendingOrder :: Order ascending :: Text descending :: Text arbitrary :: Text data DataFrame DataFrame :: [AttributeOrder] -> Attributes -> [DataFrameTuple] -> DataFrame [orders] :: DataFrame -> [AttributeOrder] [attributes] :: DataFrame -> Attributes [tuples] :: DataFrame -> [DataFrameTuple] data DataFrameTuple DataFrameTuple :: Attributes -> Vector Atom -> DataFrameTuple sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple] compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom take' :: Integer -> DataFrame -> DataFrame drop' :: Integer -> DataFrame -> DataFrame toDataFrame :: Relation -> DataFrame fromDataFrame :: DataFrame -> Either RelationalError Relation showDataFrame :: DataFrame -> Text dataFrameAsTable :: DataFrame -> Table -- | A Relation can be converted to a DataFrame for sorting, limits, and -- offsets. data DataFrameExpr DataFrameExpr :: RelationalExpr -> [AttributeOrderExpr] -> Maybe Integer -> Maybe Integer -> DataFrameExpr [convertExpr] :: DataFrameExpr -> RelationalExpr [orderExprs] :: DataFrameExpr -> [AttributeOrderExpr] [offset] :: DataFrameExpr -> Maybe Integer [limit] :: DataFrameExpr -> Maybe Integer -- | True iff dataframe features are required to execute this expression, -- False if this expression could be evaluated as a relational expression -- (no sorting, limit, or offset). usesDataFrameFeatures :: DataFrameExpr -> Bool -- | Returns a data frame expression without any sorting or limits. nakedDataFrameExpr :: RelationalExpr -> DataFrameExpr dataFrameAsHTML :: DataFrame -> Text tuplesAsHTML :: [DataFrameTuple] -> Text tupleAssocs :: DataFrameTuple -> [(AttributeName, Atom)] tupleAsHTML :: DataFrameTuple -> Text attributesAsHTML :: Attributes -> [AttributeOrder] -> Text instance GHC.Generics.Generic ProjectM36.DataFrame.Order instance GHC.Show.Show ProjectM36.DataFrame.Order instance GHC.Classes.Eq ProjectM36.DataFrame.Order instance GHC.Classes.Eq ProjectM36.DataFrame.AttributeOrder instance GHC.Generics.Generic ProjectM36.DataFrame.AttributeOrder instance GHC.Show.Show ProjectM36.DataFrame.AttributeOrder instance GHC.Classes.Eq ProjectM36.DataFrame.AttributeOrderExpr instance GHC.Generics.Generic ProjectM36.DataFrame.AttributeOrderExpr instance GHC.Show.Show ProjectM36.DataFrame.AttributeOrderExpr instance Data.Hashable.Class.Hashable ProjectM36.DataFrame.DataFrameTuple instance GHC.Generics.Generic ProjectM36.DataFrame.DataFrameTuple instance GHC.Show.Show ProjectM36.DataFrame.DataFrameTuple instance GHC.Classes.Eq ProjectM36.DataFrame.DataFrameTuple instance GHC.Generics.Generic ProjectM36.DataFrame.DataFrame instance GHC.Show.Show ProjectM36.DataFrame.DataFrame instance GHC.Classes.Eq ProjectM36.DataFrame.DataFrameExpr instance GHC.Generics.Generic ProjectM36.DataFrame.DataFrameExpr instance GHC.Show.Show ProjectM36.DataFrame.DataFrameExpr instance GHC.Classes.Eq ProjectM36.DataFrame.DataFrame module ProjectM36.Serialise.DataFrame instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.AttributeOrderExpr instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.AttributeOrder instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.Order instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.DataFrame instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.DataFrameTuple instance Codec.Winery.Class.Serialise ProjectM36.DataFrame.DataFrameExpr module ProjectM36.WithNameExpr lookup :: RelVarName -> WithNamesAssocsBase a -> Maybe (RelationalExprBase a) -- | Drop macros into the relational expression wherever they are -- referenced. substituteWithNameMacros :: GraphRefWithNameAssocs -> GraphRefRelationalExpr -> GraphRefRelationalExpr substituteWithNameMacrosRestrictionPredicate :: GraphRefWithNameAssocs -> GraphRefRestrictionPredicateExpr -> GraphRefRestrictionPredicateExpr substituteWitNameMacrosExtendTupleExpr :: GraphRefWithNameAssocs -> GraphRefExtendTupleExpr -> GraphRefExtendTupleExpr substituteWithNameMacrosAtomExpr :: GraphRefWithNameAssocs -> GraphRefAtomExpr -> GraphRefAtomExpr substituteWithNameMacrosAttributeNames :: GraphRefWithNameAssocs -> GraphRefAttributeNames -> GraphRefAttributeNames module ProjectM36.RelationalExpression data DatabaseContextExprDetails CountUpdatedTuples :: DatabaseContextExprDetails databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc -- | Used to start a fresh database state for a new database context -- expression. mkDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState data RelationalExprEnv RelationalExprEnv :: DatabaseContext -> TransactionGraph -> Maybe (Either RelationTuple Attributes) -> RelationalExprEnv [re_context] :: RelationalExprEnv -> DatabaseContext [re_graph] :: RelationalExprEnv -> TransactionGraph [re_extra] :: RelationalExprEnv -> Maybe (Either RelationTuple Attributes) envTuple :: GraphRefRelationalExprEnv -> RelationTuple envAttributes :: GraphRefRelationalExprEnv -> Attributes type RelationalExprM a = ReaderT RelationalExprEnv (ExceptT RelationalError Identity) a runRelationalExprM :: RelationalExprEnv -> RelationalExprM a -> Either RelationalError a reGraph :: RelationalExprM TransactionGraph reContext :: RelationalExprM DatabaseContext mkRelationalExprEnv :: DatabaseContext -> TransactionGraph -> RelationalExprEnv askEnv :: GraphRefRelationalExprM GraphRefRelationalExprEnv mergeTuplesIntoGraphRefRelationalExprEnv :: RelationTuple -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv mergeAttributesIntoGraphRefRelationalExprEnv :: Attributes -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv type ResultAccumName = StringType type ResultAccumFunc = (RelationTuple -> Relation -> Relation) -> Relation -> Relation data ResultAccum ResultAccum :: ResultAccumFunc -> Relation -> ResultAccum [resultAccumFunc] :: ResultAccum -> ResultAccumFunc [resultAccumResult] :: ResultAccum -> Relation data DatabaseContextEvalState DatabaseContextEvalState :: DatabaseContext -> Map ResultAccumName ResultAccum -> DirtyFlag -> DatabaseContextEvalState [dbc_context] :: DatabaseContextEvalState -> DatabaseContext [dbc_accum] :: DatabaseContextEvalState -> Map ResultAccumName ResultAccum [dbc_dirty] :: DatabaseContextEvalState -> DirtyFlag data DatabaseContextEvalEnv DatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv [dce_transId] :: DatabaseContextEvalEnv -> TransactionId [dce_graph] :: DatabaseContextEvalEnv -> TransactionGraph mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv type DatabaseContextEvalMonad a = RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity) a runDatabaseContextEvalMonad :: DatabaseContext -> DatabaseContextEvalEnv -> DatabaseContextEvalMonad () -> Either RelationalError DatabaseContextEvalState dbcTransId :: DatabaseContextEvalMonad TransactionId dbcGraph :: DatabaseContextEvalMonad TransactionGraph dbcRelationalExprEnv :: DatabaseContextEvalMonad RelationalExprEnv getStateContext :: DatabaseContextEvalMonad DatabaseContext putStateContext :: DatabaseContext -> DatabaseContextEvalMonad () -- | The context is optionally passed down along in cases where the current -- context is uncommitted. data GraphRefRelationalExprEnv GraphRefRelationalExprEnv :: Maybe DatabaseContext -> TransactionGraph -> Maybe (Either RelationTuple Attributes) -> GraphRefRelationalExprEnv [gre_context] :: GraphRefRelationalExprEnv -> Maybe DatabaseContext [gre_graph] :: GraphRefRelationalExprEnv -> TransactionGraph [gre_extra] :: GraphRefRelationalExprEnv -> Maybe (Either RelationTuple Attributes) type GraphRefRelationalExprM a = ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity) a gfTransForId :: TransactionId -> GraphRefRelationalExprM Transaction gfDatabaseContextForMarker :: GraphRefTransactionMarker -> GraphRefRelationalExprM DatabaseContext runGraphRefRelationalExprM :: GraphRefRelationalExprEnv -> GraphRefRelationalExprM a -> Either RelationalError a freshGraphRefRelationalExprEnv :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExprEnv gfGraph :: GraphRefRelationalExprM TransactionGraph envContext :: RelationalExprEnv -> DatabaseContext setEnvContext :: RelationalExprEnv -> DatabaseContext -> RelationalExprEnv setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad () deleteRelVar :: RelVarName -> DatabaseContextEvalMonad () evalGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad () data DatabaseContextIOEvalEnv DatabaseContextIOEvalEnv :: TransactionId -> TransactionGraph -> Maybe ScriptSession -> Maybe FilePath -> DatabaseContextIOEvalEnv [dbcio_transId] :: DatabaseContextIOEvalEnv -> TransactionId [dbcio_graph] :: DatabaseContextIOEvalEnv -> TransactionGraph [dbcio_mScriptSession] :: DatabaseContextIOEvalEnv -> Maybe ScriptSession -- | when running in persistent mode, this must be a Just value to a -- directory containing .o.so.dynlib files which the user has -- placed there for access to compiled functions [dbcio_mModulesDirectory] :: DatabaseContextIOEvalEnv -> Maybe FilePath type DatabaseContextIOEvalMonad a = RWST DatabaseContextIOEvalEnv () DatabaseContextEvalState IO a runDatabaseContextIOEvalMonad :: DatabaseContextIOEvalEnv -> DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ()) -> IO (Either RelationalError DatabaseContextEvalState) requireScriptSession :: DatabaseContextIOEvalMonad (Either RelationalError ScriptSession) putDBCIOContext :: DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ()) getDBCIOContext :: DatabaseContextIOEvalMonad DatabaseContext getDBCIORelationalExprEnv :: DatabaseContextIOEvalMonad RelationalExprEnv evalGraphRefDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ()) checkConstraints :: DatabaseContext -> TransactionId -> TransactionGraph -> Either RelationalError () typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation liftE :: Monad m => m (Either a b) -> ExceptT a m b predicateRestrictionFilter :: Attributes -> GraphRefRestrictionPredicateExpr -> GraphRefRelationalExprM RestrictionFilter tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple) evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType -- | Validate that the type of the AtomExpr matches the expected type. verifyGraphRefAtomExprTypes :: Relation -> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType -- | Look up the type's name and create a new attribute. evalGraphRefAttrExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute evalGraphRefTupleExprs :: Maybe Attributes -> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple] evalGraphRefTupleExpr :: Maybe Attributes -> GraphRefTupleExpr -> GraphRefRelationalExprM RelationTuple evalGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation dbContextForTransId :: TransactionId -> TransactionGraph -> Either RelationalError DatabaseContext transactionForId :: TransactionId -> TransactionGraph -> Either RelationalError Transaction typeForGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation evalGraphRefAttributeNames :: GraphRefAttributeNames -> GraphRefRelationalExpr -> GraphRefRelationalExprM (Set AttributeName) evalGraphRefAttributeExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute mkEmptyRelVars :: RelationVariables -> RelationVariables dbErr :: RelationalError -> DatabaseContextEvalMonad () -- | Return a Relation describing the relation variables. relationVariablesAsRelation :: DatabaseContext -> TransactionGraph -> Either RelationalError Relation -- | An unoptimized variant of evalGraphRefRelationalExpr for testing. evalRelationalExpr :: RelationalExpr -> RelationalExprM Relation class (MonadError RelationalError m, Monad m) => DatabaseContextM m getContext :: DatabaseContextM m => m DatabaseContext relVarByName :: DatabaseContextM m => RelVarName -> m GraphRefRelationalExpr -- | resolve UncommittedTransactionMarker whenever possible- this is -- important in the DatabaseContext in order to mitigate self-referencing -- loops for updates class ResolveGraphRefTransactionMarker a resolve :: ResolveGraphRefTransactionMarker a => a -> DatabaseContextEvalMonad a applyUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr applyRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr firstAtomForAttributeName :: AttributeName -> [RelationTuple] -> GraphRefRelationalExprM Atom -- | Optionally add type hints to resolve type variables. For example, if -- we are inserting into a known relvar, then we have its concrete type. addTargetTypeHints :: Attributes -> GraphRefRelationalExpr -> GraphRefRelationalExpr -- | Ensure that the notification contains valid, type-checkable relational -- expressions. These relational expressions therefore become registered -- queries: queries which must remain valid. validateNotification :: Notification -> DatabaseContext -> TransactionGraph -> Either RelationalError Notification instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefRelationalExpr instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefTupleExprs instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefTupleExpr instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefAttributeNames instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefRestrictionPredicateExpr instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefExtendTupleExpr instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefWithNameExpr instance ProjectM36.RelationalExpression.ResolveGraphRefTransactionMarker ProjectM36.Base.GraphRefAtomExpr instance ProjectM36.RelationalExpression.DatabaseContextM (Control.Monad.Trans.Reader.ReaderT ProjectM36.RelationalExpression.GraphRefRelationalExprEnv (Control.Monad.Trans.Except.ExceptT ProjectM36.Error.RelationalError Data.Functor.Identity.Identity)) instance ProjectM36.RelationalExpression.DatabaseContextM (Control.Monad.Trans.RWS.Strict.RWST ProjectM36.RelationalExpression.DatabaseContextEvalEnv () ProjectM36.RelationalExpression.DatabaseContextEvalState (Control.Monad.Trans.Except.ExceptT ProjectM36.Error.RelationalError Data.Functor.Identity.Identity)) instance GHC.Show.Show ProjectM36.RelationalExpression.RelationalExprEnv module ProjectM36.TransactionGraph.Persist type LockFileHash = ByteString expectedVersion :: Int transactionLogFileName :: FilePath transactionLogPath :: FilePath -> FilePath headsPath :: FilePath -> FilePath lockFilePath :: FilePath -> FilePath checkForOtherVersions :: FilePath -> IO (Either PersistenceError ()) setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (LockFile, LockFileHash)) bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash) objectFilesPath :: FilePath -> FilePath transactionGraphPersist :: DiskSync -> FilePath -> [TransactionId] -> TransactionGraph -> IO LockFileHash -- | The incremental writer writes the transactions ids specified by the -- second argument. transactionsPersist :: DiskSync -> [TransactionId] -> FilePath -> TransactionGraph -> IO () transactionGraphHeadsPersist :: DiskSync -> FilePath -> TransactionGraph -> IO () transactionGraphHeadsLoad :: FilePath -> IO [(HeadName, TransactionId)] data Pos One :: Pos Two :: Pos twowords :: String -> (String, String) transactionGraphLoad :: FilePath -> TransactionGraph -> Maybe ScriptSession -> IO (Either PersistenceError TransactionGraph) readTransactionIfNecessary :: FilePath -> TransactionId -> Maybe ScriptSession -> TransactionGraph -> IO (Either PersistenceError TransactionGraph) writeGraphTransactionIdFile :: DiskSync -> FilePath -> TransactionGraph -> IO LockFileHash readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, UTCTime, [TransactionId])]) readUTF8FileOrError :: FilePath -> IO Text module ProjectM36.TransactionGraph.Merge data MergePreference PreferFirst :: MergePreference PreferSecond :: MergePreference PreferNeither :: MergePreference unionMergeMaps :: (Ord k, Eq a) => MergePreference -> Map k a -> Map k a -> Either MergeError (Map k a) unionMergeRelation :: MergePreference -> GraphRefRelationalExpr -> GraphRefRelationalExpr -> GraphRefRelationalExprM GraphRefRelationalExpr unionMergeRelVars :: MergePreference -> RelationVariables -> RelationVariables -> GraphRefRelationalExprM RelationVariables unionMergeAtomFunctions :: MergePreference -> AtomFunctions -> AtomFunctions -> Either MergeError AtomFunctions unionMergeTypeConstructorMapping :: MergePreference -> TypeConstructorMapping -> TypeConstructorMapping -> Either MergeError TypeConstructorMapping unionMergeDatabaseContextFunctions :: MergePreference -> DatabaseContextFunctions -> DatabaseContextFunctions -> Either MergeError DatabaseContextFunctions unionMergeRegisteredQueries :: MergePreference -> RegisteredQueries -> RegisteredQueries -> Either MergeError RegisteredQueries module ProjectM36.SQL.Convert newtype TableContext TableContext :: Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper) -> TableContext type TypeForRelExprF = RelationalExpr -> Either RelationalError Relation type ConvertM = StateT TableContext (ExceptT SQLError Identity) runConvertM :: TableContext -> ConvertM a -> Either SQLError (a, TableContext) runLocalConvertM :: ConvertM a -> ConvertM a evalConvertM :: TableContext -> ConvertM a -> Either SQLError a data SelectItemsConvertTask SelectItemsConvertTask :: Set ColumnProjectionName -> [(ColumnProjectionName, ColumnAlias)] -> [ExtendTupleExpr] -> [Set ColumnProjectionName] -> SelectItemsConvertTask [taskProjections] :: SelectItemsConvertTask -> Set ColumnProjectionName [taskRenames] :: SelectItemsConvertTask -> [(ColumnProjectionName, ColumnAlias)] [taskExtenders] :: SelectItemsConvertTask -> [ExtendTupleExpr] [taskGroups] :: SelectItemsConvertTask -> [Set ColumnProjectionName] emptyTask :: SelectItemsConvertTask type AttributeAlias = AttributeName type ColumnAliasRemapper = Map AttributeName (AttributeAlias, Set ColumnName) insertIntoColumnAliasRemap' :: AttributeName -> AttributeAlias -> ColumnName -> ColumnAliasRemapper -> Either SQLError ColumnAliasRemapper -- | Used to note if columns are remapped to different attributes in order -- to mitigate attribute naming conflicts. insertColumnAlias :: TableAlias -> AttributeName -> ColumnAlias -> ColumnName -> ConvertM () prettyTableContext :: TableContext -> String prettyColumnAliasRemapper :: ColumnAliasRemapper -> String type ColumnAliasMap = Map ColumnAlias AttributeName tableAliasesAsWithNameAssocs :: ConvertM WithNamesAssocs throwSQLE :: SQLError -> ConvertM a type ColumnAliasRenameMap = Map (TableAlias, AttributeName) ColumnAlias -- | Pass state down to subselect, but discard any state changes from the -- subselect processing. withSubSelect :: ConvertM a -> ConvertM (a, ColumnAliasRenameMap) generateColumnAlias :: TableAlias -> AttributeName -> ConvertM ColumnAlias -- | Insert another table into the TableContext. Returns an alias map of -- any columns which could conflict with column names already present in -- the TableContext so that they can be optionally renamed. insertTable :: TableAlias -> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap -- | When a column is mentioned, it may need to be aliased. The table name -- must already be in the table context so that we can identify that the -- attribute exists. Without a table name, we must look for a uniquely -- named column amongst all tables. Thus, we pre-emptively eliminate -- duplicate column names. noteColumnMention :: Maybe TableAlias -> ColumnName -> Maybe ColumnAlias -> ConvertM ColumnAlias lookupTable :: TableAlias -> ConvertM (RelationalExpr, Attributes, ColumnAliasRemapper) -- | Find a column name or column alias in the underlying table context. -- Returns key into table context. findColumn :: ColumnName -> ConvertM [TableAlias] -- | non ConvertM version of findColumn findColumn' :: ColumnName -> TableContext -> [TableAlias] findNotedColumn' :: ColumnName -> TableContext -> Either SQLError [(TableAlias, AttributeName)] attributeNameForAttributeAlias :: AttributeAlias -> ColumnAliasRemapper -> Either SQLError AttributeName findOneColumn :: ColumnName -> ConvertM TableAlias findOneColumn' :: ColumnName -> TableContext -> Either SQLError TableAlias -- | Search the TableContext for a column alias remapping for the given -- column name. This function can change the state context if column -- names conflict. attributeNameForColumnName :: ColumnName -> ConvertM AttributeName wrapTypeF :: TypeForRelExprF -> RelationalExpr -> ConvertM Relation baseDFExpr :: DataFrameExpr falseDFExpr :: DataFrameExpr convertQuery :: TypeForRelExprF -> Query -> ConvertM DataFrameExpr convertSelect :: TypeForRelExprF -> Select -> ConvertM DataFrameExpr appendWithsToTypeF :: TypeForRelExprF -> WithNamesAssocs -> TypeForRelExprF -- | Slightly different processing for subselects. convertSubSelect :: TypeForRelExprF -> Select -> ConvertM RelationalExpr convertSelectItem :: TypeForRelExprF -> SelectItemsConvertTask -> (Int, SelectItem) -> ConvertM SelectItemsConvertTask convertProjection :: TypeForRelExprF -> [SelectItem] -> [GroupByExpr] -> Maybe HavingExpr -> ConvertM (RelationalExpr -> RelationalExpr) convertUnqualifiedColumnName :: UnqualifiedColumnName -> AttributeName convertColumnName :: ColumnName -> ConvertM AttributeName convertColumnProjectionName :: ColumnProjectionName -> ConvertM AttributeName convertTableExpr :: TypeForRelExprF -> TableExpr -> ConvertM (DataFrameExpr, ColumnAliasMap) func :: FunctionName -> [AtomExpr] -> AtomExpr convertWhereClause :: TypeForRelExprF -> RestrictionExpr -> ConvertM RestrictionPredicateExpr convertScalarExpr :: TypeForRelExprF -> ScalarExpr -> ConvertM AtomExpr convertProjectionScalarExpr :: TypeForRelExprF -> ProjectionScalarExpr -> ConvertM AtomExpr convertOrderByClause :: TypeForRelExprF -> [SortExpr] -> ConvertM [AttributeOrderExpr] convertWithClause :: TypeForRelExprF -> WithClause -> ConvertM WithNamesAssocs type ColumnRemap = Map ColumnName ColumnName convertFromClause :: TypeForRelExprF -> [TableRef] -> ConvertM (RelationalExpr, ColumnAliasMap) -- | Convert TableRefs after the first one (assumes all additional -- TableRefs are for joins). Returns the qualified name key that was -- added to the map, the underlying relexpr (not aliased so that it can -- used for extracting type information), and the new table context map convertTableRef :: TypeForRelExprF -> TableRef -> ConvertM (TableAlias, RelationalExpr) joinTableRef :: TypeForRelExprF -> RelationalExpr -> (Int, TableRef) -> ConvertM RelationalExpr lookupOperator :: Bool -> OperatorName -> ConvertM ([AtomExpr] -> AtomExpr) lookupFunc :: FuncName -> ConvertM ([AtomExpr] -> AtomExpr) -- | Used in join condition detection necessary for renames to enable -- natural joins. commonAttributeNames :: TypeForRelExprF -> RelationalExpr -> RelationalExpr -> ConvertM (Set AttributeName, Set AttributeName, Set AttributeName) -- | Used to remap SQL qualified names to new names to prevent conflicts in -- join conditions. renameIdentifier :: (ColumnName -> ColumnName) -> ScalarExpr -> ScalarExpr columnNamesInScalarExpr :: ScalarExpr -> Set ColumnName columnNamesInRestrictionExpr :: RestrictionExpr -> Set ColumnName -- | If the restriction includes a EXISTS expression, we must rename all -- attributes at the top-level to prevent conflicts. needsToRenameAllAttributes :: RestrictionExpr -> Bool pushDownAttributeRename :: Set (AttributeName, AttributeName) -> RelationalExpr -> RelationalExpr -> RelationalExpr mkTableContextFromDatabaseContext :: DatabaseContext -> TransactionGraph -> Either RelationalError TableContext convertUpdate :: TypeForRelExprF -> Update -> ConvertM DatabaseContextExpr convertTableName :: TableName -> ConvertM RelVarName convertDBUpdates :: TypeForRelExprF -> [DBUpdate] -> ConvertM DatabaseContextExpr convertDBUpdate :: TypeForRelExprF -> DBUpdate -> ConvertM DatabaseContextExpr convertInsert :: TypeForRelExprF -> Insert -> ConvertM DatabaseContextExpr convertDelete :: TypeForRelExprF -> Delete -> ConvertM DatabaseContextExpr convertCreateTable :: TypeForRelExprF -> CreateTable -> ConvertM DatabaseContextExpr convertDropTable :: TypeForRelExprF -> DropTable -> ConvertM DatabaseContextExpr convertColumnNamesAndTypes :: RelVarName -> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)] -> ConvertM ([AttributeExpr], [DatabaseContextExpr]) convertColumnType :: ColumnType -> PerColumnConstraints -> ConvertM TypeConstructor convertPerColumnConstraints :: RelVarName -> UnqualifiedColumnName -> PerColumnConstraints -> ConvertM [DatabaseContextExpr] databaseContextExprForUniqueKeyWithNull :: RelVarName -> AttributeName -> DatabaseContextExpr convertGroupBy :: TypeForRelExprF -> [GroupByExpr] -> Maybe HavingExpr -> [SelectItem] -> ConvertM GroupByInfo data GroupByItem AggGroupByItem :: ProjectionScalarExpr -> GroupByExpr -> GroupByItem NonAggGroupByItem :: ProjectionScalarExpr -> GroupByExpr -> GroupByItem -- | Validated "group by" and "having" data data GroupByInfo GroupByInfo :: [ProjectionScalarExpr] -> [(AttributeName, GroupByExpr)] -> Maybe ProjectionScalarExpr -> GroupByInfo -- | mentioned in group by clause and uses aggregation [aggregates] :: GroupByInfo -> [ProjectionScalarExpr] -- | mentioned in group by clause by not aggregations [nonAggregates] :: GroupByInfo -> [(AttributeName, GroupByExpr)] [havingRestriction] :: GroupByInfo -> Maybe ProjectionScalarExpr emptyGroupByInfo :: GroupByInfo aggregateFunctionsMap :: [(FuncName, FunctionName)] isAggregateFunction :: FuncName -> Bool containsAggregate :: ProjectionScalarExpr -> Bool -- | Returns True iff a projection scalar expr within a larger expression. -- Used for group by aggregation validation. containsProjScalarExpr :: ProjectionScalarExpr -> ProjectionScalarExpr -> Bool replaceProjScalarExpr :: (ProjectionScalarExpr -> ProjectionScalarExpr) -> ProjectionScalarExpr -> ProjectionScalarExpr processSQLAggregateFunctions :: AtomExpr -> AtomExpr instance GHC.Classes.Eq ProjectM36.SQL.Convert.SelectItemsConvertTask instance GHC.Show.Show ProjectM36.SQL.Convert.SelectItemsConvertTask instance GHC.Classes.Eq ProjectM36.SQL.Convert.TableContext instance GHC.Show.Show ProjectM36.SQL.Convert.TableContext instance GHC.Base.Monoid ProjectM36.SQL.Convert.TableContext instance GHC.Base.Semigroup ProjectM36.SQL.Convert.TableContext instance GHC.Classes.Eq ProjectM36.SQL.Convert.GroupByItem instance GHC.Show.Show ProjectM36.SQL.Convert.GroupByItem instance GHC.Classes.Eq ProjectM36.SQL.Convert.GroupByInfo instance GHC.Show.Show ProjectM36.SQL.Convert.GroupByInfo module ProjectM36.ReferencedTransactionIds type TransactionIds = Set TransactionId class ReferencedTransactionIds a referencedTransactionIds :: ReferencedTransactionIds a => a -> TransactionIds -- | Recurse relvars references and transaction parents to extract a subset -- of relevant transactions. probably could do some trimming of -- transactions that are not referenced by relvars, but that is rare, so -- probably of not much benefit should be trim merge parents that don't -- contribute to the relvars? maybe referencedTransactionIdsForTransaction :: Transaction -> TransactionGraph -> Either RelationalError (Set Transaction) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.RelationalExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.AttributeExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.TupleExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.TupleExprsBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds ProjectM36.Base.GraphRefTransactionMarker instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.AttributeNamesBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.RestrictionPredicateExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.ExtendTupleExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.WithNameExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds a => ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds (ProjectM36.Base.AtomExprBase a) instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds ProjectM36.Base.DatabaseContext instance ProjectM36.ReferencedTransactionIds.ReferencedTransactionIds ProjectM36.Base.RelationVariables module ProjectM36.IsomorphicSchema data SchemaExpr AddSubschema :: SchemaName -> SchemaIsomorphs -> SchemaExpr RemoveSubschema :: SchemaName -> SchemaExpr isomorphs :: Schema -> SchemaIsomorphs -- | Return an error if the schema is not isomorphic to the base database -- context. A schema is fully isomorphic iff all relvars in the base -- context are in the "out" relvars, but only once. TODO: add relvar must -- appear exactly once constraint validateSchema :: Schema -> DatabaseContext -> Maybe SchemaError invert :: SchemaIsomorph -> SchemaIsomorph isomorphInRelVarNames :: SchemaIsomorph -> [RelVarName] -- | Relation variables names represented in the virtual schema space. -- Useful for determining if a relvar name is valid in the schema. isomorphsInRelVarNames :: SchemaIsomorphs -> Set RelVarName isomorphOutRelVarNames :: SchemaIsomorph -> [RelVarName] isomorphsOutRelVarNames :: SchemaIsomorphs -> Set RelVarName -- | Check that all mentioned relvars are actually present in the current -- schema. validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError () processRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError RelationalExpr validateDatabaseContextExprInSchema :: Schema -> DatabaseContextExpr -> Either RelationalError () processDatabaseContextExprInSchema :: Schema -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr -- | If the database context expression adds or removes a relvar, we need -- to update the isomorphs to create a passthrough Isomorph. processDatabaseContextExprSchemaUpdate :: Schema -> DatabaseContextExpr -> Schema processDatabaseContextExprSchemasUpdate :: Subschemas -> DatabaseContextExpr -> Subschemas -- | Morph a relational expression in one schema to another isomorphic -- schema. Returns a function which can be used to morph a -- GraphRefRelationalExpr. Here, we naively apply the morphs in -- the current context ignoring past contexts because: * the current -- schema may not exist in past * this function should only be used for -- showing DDL, not for expression evaluation. * if a schema were -- renamed, then the path to past isomorphisms in the transaction graph -- tree would be lost. relExprMorph :: SchemaIsomorph -> RelationalExpr -> Either RelationalError RelationalExpr relExprMogrify :: (RelationalExprBase a -> Either RelationalError (RelationalExprBase a)) -> RelationalExprBase a -> Either RelationalError (RelationalExprBase a) databaseContextExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr) -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr -- | Apply the isomorphism transformations to the relational expression to -- convert the relational expression from operating on one schema to a -- disparate, isomorphic schema. applyRelationalExprSchemaIsomorphs :: SchemaIsomorphs -> RelationalExpr -> Either RelationalError RelationalExpr inclusionDependencyInSchema :: Schema -> InclusionDependency -> Either RelationalError InclusionDependency inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies relationVariablesInSchema :: Schema -> Either RelationalError RelationVariables -- | Show metadata about the relation variables in the isomorphic schema. relationVariablesAsRelationInSchema :: DatabaseContext -> Schema -> TransactionGraph -> Either RelationalError Relation -- | Create inclusion dependencies mainly for IsoRestrict because the -- predicate should hold in the base schema. createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies evalSchemaExpr :: SchemaExpr -> DatabaseContext -> TransactionId -> TransactionGraph -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext) -- | Apply SchemaIsomorphs to database context data. class Morph a morphToSchema :: Morph a => Schema -> TransactionGraph -> a -> Either RelationalError a notificationsAsRelationInSchema :: Notifications -> Schema -> Either RelationalError Relation notificationsAsData :: Notifications -> [(Text, RelationalExpr, RelationalExpr, RelationalExpr)] instance GHC.Show.Show ProjectM36.IsomorphicSchema.SchemaExpr instance GHC.Generics.Generic ProjectM36.IsomorphicSchema.SchemaExpr instance ProjectM36.IsomorphicSchema.Morph ProjectM36.Base.RelationalExpr instance ProjectM36.IsomorphicSchema.Morph ProjectM36.Base.InclusionDependency instance ProjectM36.IsomorphicSchema.Morph ProjectM36.Base.InclusionDependencies module ProjectM36.Serialise.IsomorphicSchema instance Codec.Winery.Class.Serialise ProjectM36.IsomorphicSchema.SchemaExpr module ProjectM36.RegisteredQuery registeredQueriesAsRelationInSchema :: Schema -> RegisteredQueries -> Either RelationalError Relation -- | A unified class for walking the database structure to produce a hash -- used for Merkle trees and validation. module ProjectM36.HashSecurely newtype SecureHash SecureHash :: ByteString -> SecureHash [_unSecureHash] :: SecureHash -> ByteString class HashBytes a hashBytes :: HashBytes a => a -> Ctx -> Ctx data SHash SHash :: !a -> SHash hashBytesL :: Foldable f => Ctx -> ByteString -> f SHash -> Ctx -- | Hash a transaction within its graph context to create a Merkle hash -- for it. hashTransaction :: Transaction -> Set Transaction -> MerkleHash -- | Return a hash of just DDL-specific (schema) attributes. This is useful -- for determining if a client has the appropriate updates needed to work -- with the current schema. mkDDLHash :: DatabaseContext -> Map RelVarName Relation -> SecureHash instance GHC.Classes.Eq ProjectM36.HashSecurely.SecureHash instance GHC.Show.Show ProjectM36.HashSecurely.SecureHash instance Codec.Winery.Class.Serialise ProjectM36.HashSecurely.SecureHash instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Atom instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Relation instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.RelationalExprBase a) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.AttributeNamesBase a) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.ExtendTupleExprBase a) instance ProjectM36.HashSecurely.HashBytes (Data.Set.Internal.Set (ProjectM36.Base.AttributeName, ProjectM36.Base.AttributeName)) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.WithNameExprBase a) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.TupleExprBase a) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.AtomExprBase a) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.AtomType instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Attributes instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.RelationTupleSet instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (GHC.Maybe.Maybe [ProjectM36.Base.AttributeExprBase a]) instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.TupleExprsBase a) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Attribute instance (ProjectM36.HashSecurely.HashBytes a, ProjectM36.HashSecurely.HashBytes b) => ProjectM36.HashSecurely.HashBytes (a, b) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.RelationTuple instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.AttributeExprBase a) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.TypeConstructor instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Schema instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.SchemaIsomorph instance ProjectM36.HashSecurely.HashBytes a => ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.RestrictionPredicateExprBase a) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.DatabaseContext instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.InclusionDependencies instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.RelationVariables instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Notifications instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.TypeConstructorMapping instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.AtomFunctions instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.AtomFunction instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.DatabaseContextFunction instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.DatabaseContextFunctions instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.InclusionDependency instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.Notification instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.DataConstructorDef instance ProjectM36.HashSecurely.HashBytes [ProjectM36.Base.DataConstructorDef] instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.TypeConstructorDef instance ProjectM36.HashSecurely.HashBytes (ProjectM36.Base.FunctionBody a) instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.DataConstructorDefArg instance ProjectM36.HashSecurely.HashBytes (Data.Map.Internal.Map ProjectM36.Base.RelVarName ProjectM36.Base.Relation) instance ProjectM36.HashSecurely.HashBytes Data.Text.Internal.Text instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.GraphRefTransactionMarker instance ProjectM36.HashSecurely.HashBytes () instance ProjectM36.HashSecurely.HashBytes ProjectM36.Base.TransactionId instance ProjectM36.HashSecurely.HashBytes ProjectM36.MerkleHash.MerkleHash instance ProjectM36.HashSecurely.HashBytes Data.Time.Clock.Internal.UTCTime.UTCTime module ProjectM36.TransactionGraph -- | Record a lookup for a specific transaction in the graph. data TransactionIdLookup TransactionIdLookup :: TransactionId -> TransactionIdLookup TransactionIdHeadNameLookup :: HeadName -> [TransactionIdHeadBacktrack] -> TransactionIdLookup -- | Used for git-style head backtracking such as topic~3^2. data TransactionIdHeadBacktrack -- | git equivalent of ~v: walk back n parents, arbitrarily choosing a -- parent when a choice must be made TransactionIdHeadParentBacktrack :: Int -> TransactionIdHeadBacktrack -- | git equivalent of ^: walk back one parent level to the nth -- arbitrarily-chosen parent TransactionIdHeadBranchBacktrack :: Int -> TransactionIdHeadBacktrack -- | git equivalent of 'git-rev-list -n 1 --before X' find the first -- transaction which was created before the timestamp TransactionStampHeadBacktrack :: UTCTime -> TransactionIdHeadBacktrack -- | Operators which manipulate a transaction graph and which transaction -- the current Session is based upon. data TransactionGraphOperator JumpToHead :: HeadName -> TransactionGraphOperator JumpToTransaction :: TransactionId -> TransactionGraphOperator WalkBackToTime :: UTCTime -> TransactionGraphOperator Branch :: HeadName -> TransactionGraphOperator DeleteBranch :: HeadName -> TransactionGraphOperator MergeTransactions :: MergeStrategy -> HeadName -> HeadName -> TransactionGraphOperator Commit :: TransactionGraphOperator Rollback :: TransactionGraphOperator isCommit :: TransactionGraphOperator -> Bool data ROTransactionGraphOperator ShowGraph :: ROTransactionGraphOperator ValidateMerkleHashes :: ROTransactionGraphOperator bootstrapTransactionGraph :: UTCTime -> TransactionId -> DatabaseContext -> TransactionGraph -- | Create a transaction graph from a context. freshTransactionGraph :: DatabaseContext -> IO (TransactionGraph, TransactionId) emptyTransactionGraph :: TransactionGraph transactionForHead :: HeadName -> TransactionGraph -> Maybe Transaction headList :: TransactionGraph -> [(HeadName, TransactionId)] headNameForTransaction :: Transaction -> TransactionGraph -> Maybe HeadName transactionsForIds :: Set TransactionId -> TransactionGraph -> Either RelationalError (Set Transaction) -- | A root transaction terminates a graph and has no parents. isRootTransaction :: Transaction -> Bool rootTransactions :: TransactionGraph -> Set Transaction parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (Set Transaction) childTransactions :: Transaction -> TransactionGraph -> Either RelationalError (Set Transaction) addBranch :: UTCTime -> TransactionId -> HeadName -> TransactionId -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph) addDisconnectedTransaction :: UTCTime -> TransactionId -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph) addTransactionToGraph :: HeadName -> Transaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph) newTransUncommittedReplace :: Transaction -> Transaction validateGraph :: TransactionGraph -> Maybe [RelationalError] walkParentTransactions :: Set TransactionId -> TransactionGraph -> Transaction -> Maybe RelationalError walkChildTransactions :: Set TransactionId -> TransactionGraph -> Transaction -> Maybe RelationalError evalGraphOp :: UTCTime -> TransactionId -> DisconnectedTransaction -> TransactionGraph -> TransactionGraphOperator -> Either RelationalError (DisconnectedTransaction, TransactionGraph) graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation transactionParentsRelation :: Transaction -> TransactionGraph -> Either RelationalError Relation -- | Execute the merge strategy against the transactions, returning a new -- transaction which can be then added to the transaction graph createMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction -- | Returns the correct Transaction for the branch name in the graph and -- ensures that it is one of the two transaction arguments in the tuple. validateHeadName :: HeadName -> TransactionGraph -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction subGraphOfFirstCommonAncestor :: TransactionGraph -> TransactionHeads -> Transaction -> Transaction -> Set Transaction -> Either RelationalError TransactionGraph -- | Search from a past graph point to all following heads for a specific -- transaction. If found, return the transaction path, otherwise a -- RelationalError. pathToTransaction :: TransactionGraph -> Transaction -> Transaction -> Set Transaction -> Either RelationalError (Set Transaction) mergeTransactions :: UTCTime -> TransactionId -> TransactionId -> MergeStrategy -> (HeadName, HeadName) -> GraphRefRelationalExprM (DisconnectedTransaction, TransactionGraph) showTransactionStructureX :: Bool -> Transaction -> TransactionGraph -> String showGraphStructureX :: Bool -> TransactionGraph -> String -- | After splicing out a subgraph, run it through this function to remove -- references to transactions which are not in the subgraph. filterSubGraph :: TransactionGraph -> TransactionHeads -> Either RelationalError TransactionGraph createUnionMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction lookupTransaction :: TransactionGraph -> TransactionIdLookup -> Either RelationalError Transaction traverseGraph :: TransactionGraph -> TransactionId -> [TransactionIdHeadBacktrack] -> Either RelationalError TransactionId backtrackGraph :: TransactionGraph -> TransactionId -> TransactionIdHeadBacktrack -> Either RelationalError TransactionId -- | Create a temporary branch for commit, merge the result to head, delete -- the temporary branch. This is useful to atomically commit a -- transaction, avoiding a TransactionIsNotHeadError but trading it for a -- potential MergeError. this is not a GraphOp because it combines -- multiple graph operations autoMergeToHead :: UTCTime -> (TransactionId, TransactionId, TransactionId) -> DisconnectedTransaction -> HeadName -> MergeStrategy -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph) addMerkleHash :: TransactionGraph -> Transaction -> Transaction calculateMerkleHash :: Transaction -> TransactionGraph -> MerkleHash validateMerkleHash :: Transaction -> TransactionGraph -> Either MerkleValidationError () data MerkleValidationError MerkleValidationError :: TransactionId -> MerkleHash -> MerkleHash -> MerkleValidationError validateMerkleHashes :: TransactionGraph -> Either [MerkleValidationError] () -- | Ensure that referenced transactions remain in the graph. validateConnectivity :: TransactionGraph -> Either RelationalError TransactionGraph instance Codec.Winery.Class.Serialise ProjectM36.TransactionGraph.TransactionIdHeadBacktrack instance GHC.Generics.Generic ProjectM36.TransactionGraph.TransactionIdHeadBacktrack instance GHC.Classes.Eq ProjectM36.TransactionGraph.TransactionIdHeadBacktrack instance GHC.Show.Show ProjectM36.TransactionGraph.TransactionIdHeadBacktrack instance Codec.Winery.Class.Serialise ProjectM36.TransactionGraph.TransactionIdLookup instance GHC.Generics.Generic ProjectM36.TransactionGraph.TransactionIdLookup instance GHC.Classes.Eq ProjectM36.TransactionGraph.TransactionIdLookup instance GHC.Show.Show ProjectM36.TransactionGraph.TransactionIdLookup instance Codec.Winery.Class.Serialise ProjectM36.TransactionGraph.TransactionGraphOperator instance GHC.Generics.Generic ProjectM36.TransactionGraph.TransactionGraphOperator instance GHC.Show.Show ProjectM36.TransactionGraph.TransactionGraphOperator instance GHC.Classes.Eq ProjectM36.TransactionGraph.TransactionGraphOperator instance GHC.Show.Show ProjectM36.TransactionGraph.ROTransactionGraphOperator instance GHC.Generics.Generic ProjectM36.TransactionGraph.MerkleValidationError instance GHC.Classes.Eq ProjectM36.TransactionGraph.MerkleValidationError instance GHC.Show.Show ProjectM36.TransactionGraph.MerkleValidationError module ProjectM36.TransactionGraph.Show showTransactionStructure :: Transaction -> TransactionGraph -> String showGraphStructure :: TransactionGraph -> String module ProjectM36.TransGraphRelationalExpression -- | The TransGraphRelationalExpression is equivalent to a relational -- expression except that relation variables can reference points in the -- transaction graph (at previous points in time). type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup type TransGraphAttributeNames = AttributeNamesBase TransactionIdLookup type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup type TransGraphTupleExpr = TupleExprBase TransactionIdLookup type TransGraphTupleExprs = TupleExprsBase TransactionIdLookup type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup type TransGraphAtomExpr = AtomExprBase TransactionIdLookup type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup type TransGraphWithNameExpr = WithNameExprBase TransactionIdLookup newtype TransGraphEvalEnv TransGraphEvalEnv :: TransactionGraph -> TransGraphEvalEnv [tge_graph] :: TransGraphEvalEnv -> TransactionGraph type TransGraphEvalMonad a = ReaderT TransGraphEvalEnv (ExceptT RelationalError Identity) a process :: TransGraphEvalEnv -> TransGraphRelationalExpr -> Either RelationalError GraphRefRelationalExpr liftE :: Either RelationalError a -> TransGraphEvalMonad a askGraph :: TransGraphEvalMonad TransactionGraph findTransId :: TransactionIdLookup -> TransGraphEvalMonad GraphRefTransactionMarker findTrans :: TransactionIdLookup -> TransGraphEvalMonad Transaction processTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransGraphEvalMonad GraphRefRelationalExpr processTransGraphTupleExprs :: TransGraphTupleExprs -> TransGraphEvalMonad GraphRefTupleExprs processTransGraphTupleExpr :: TransGraphTupleExpr -> TransGraphEvalMonad GraphRefTupleExpr processTransGraphAtomExpr :: TransGraphAtomExpr -> TransGraphEvalMonad GraphRefAtomExpr evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransGraphEvalMonad GraphRefRestrictionPredicateExpr processTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransGraphEvalMonad GraphRefExtendTupleExpr processTransGraphAttributeExpr :: TransGraphAttributeExpr -> TransGraphEvalMonad GraphRefAttributeExpr processTransGraphAttributeNames :: TransGraphAttributeNames -> TransGraphEvalMonad GraphRefAttributeNames processTransGraphWithNameExpr :: TransGraphWithNameExpr -> TransGraphEvalMonad GraphRefWithNameExpr module ProjectM36.StaticOptimizer data GraphRefSOptRelationalExprEnv GraphRefSOptRelationalExprEnv :: TransactionGraph -> Maybe DatabaseContext -> GraphRefSOptRelationalExprEnv [ore_graph] :: GraphRefSOptRelationalExprEnv -> TransactionGraph [ore_mcontext] :: GraphRefSOptRelationalExprEnv -> Maybe DatabaseContext type GraphRefSOptRelationalExprM a = ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity) a data GraphRefSOptDatabaseContextExprEnv GraphRefSOptDatabaseContextExprEnv :: TransactionGraph -> DatabaseContext -> TransactionId -> GraphRefSOptDatabaseContextExprEnv [odce_graph] :: GraphRefSOptDatabaseContextExprEnv -> TransactionGraph [odce_context] :: GraphRefSOptDatabaseContextExprEnv -> DatabaseContext [odce_transId] :: GraphRefSOptDatabaseContextExprEnv -> TransactionId type GraphRefSOptDatabaseContextExprM a = ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity) a -- | A temporary function to be replaced by IO-based implementation. optimizeAndEvalRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError Relation optimizeRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError GraphRefRelationalExpr class Monad m => AskGraphContext m askGraph :: AskGraphContext m => m TransactionGraph askContext :: AskGraphContext m => m DatabaseContext askTransId :: GraphRefSOptDatabaseContextExprM TransactionId askMaybeContext :: GraphRefSOptRelationalExprM (Maybe DatabaseContext) optimizeDatabaseContextExpr :: DatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr optimizeAndEvalDatabaseContextExpr :: Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad () optimizeAndEvalTransGraphRelationalExpr :: TransactionGraph -> TransGraphRelationalExpr -> Either RelationalError Relation optimizeAndEvalDatabaseContextIOExpr :: DatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ()) runGraphRefSOptRelationalExprM :: Maybe DatabaseContext -> TransactionGraph -> GraphRefSOptRelationalExprM a -> Either RelationalError a runGraphRefSOptDatabaseContextExprM :: TransactionId -> DatabaseContext -> TransactionGraph -> GraphRefSOptDatabaseContextExprM a -> Either RelationalError a optimizeGraphRefRelationalExpr' :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExpr -> Either RelationalError GraphRefRelationalExpr -- | optimize relational expression within database context expr monad liftGraphRefRelExpr :: GraphRefSOptRelationalExprM a -> GraphRefSOptDatabaseContextExprM a fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr optimizeGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr applyStaticPredicateOptimization :: GraphRefRestrictionPredicateExpr -> GraphRefSOptRelationalExprM GraphRefRestrictionPredicateExpr isTrueExpr :: RestrictionPredicateExprBase a -> Bool isFalseExpr :: RestrictionPredicateExprBase a -> Bool isEmptyRelationExpr :: RelationalExprBase a -> Bool replaceStaticAtomExprs :: GraphRefRestrictionPredicateExpr -> Map AttributeName GraphRefAtomExpr -> GraphRefRestrictionPredicateExpr findStaticRestrictionPredicates :: GraphRefRestrictionPredicateExpr -> Map AttributeName GraphRefAtomExpr isStaticAtomExpr :: AtomExpr -> Bool applyStaticJoinElimination :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr applyStaticRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr sequentialRestrictions :: RelationalExprBase a -> [RelationalExprBase a] applyStaticRestrictionPushdown :: GraphRefRelationalExpr -> GraphRefRelationalExpr applyRedundantRenameCleanup :: GraphRefRelationalExpr -> GraphRefRelationalExpr optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextIOExpr instance ProjectM36.StaticOptimizer.AskGraphContext (Control.Monad.Trans.Reader.ReaderT ProjectM36.StaticOptimizer.GraphRefSOptDatabaseContextExprEnv (Control.Monad.Trans.Except.ExceptT ProjectM36.Error.RelationalError Data.Functor.Identity.Identity)) instance ProjectM36.StaticOptimizer.AskGraphContext (Control.Monad.Trans.Reader.ReaderT ProjectM36.StaticOptimizer.GraphRefSOptRelationalExprEnv (Control.Monad.Trans.Except.ExceptT ProjectM36.Error.RelationalError Data.Functor.Identity.Identity)) module ProjectM36.Notifications -- | Returns the notifications which should be triggered based on the -- transition from the first DatabaseContext to the second -- DatabaseContext. notificationChanges :: Notifications -> TransactionGraph -> DatabaseContext -> DatabaseContext -> Notifications module ProjectM36.Server.RemoteCallTypes -- | The initial login message. The argument should be the process id of -- the initiating client. This ProcessId will receive notification -- callbacks. data Login Login :: DatabaseName -> Login data Logout Logout :: Logout data ExecuteRelationalExpr ExecuteRelationalExpr :: SessionId -> RelationalExpr -> ExecuteRelationalExpr data ExecuteDataFrameExpr ExecuteDataFrameExpr :: SessionId -> DataFrameExpr -> ExecuteDataFrameExpr data ExecuteDatabaseContextExpr ExecuteDatabaseContextExpr :: SessionId -> DatabaseContextExpr -> ExecuteDatabaseContextExpr data ExecuteDatabaseContextIOExpr ExecuteDatabaseContextIOExpr :: SessionId -> DatabaseContextIOExpr -> ExecuteDatabaseContextIOExpr data ExecuteGraphExpr ExecuteGraphExpr :: SessionId -> TransactionGraphOperator -> ExecuteGraphExpr data ExecuteTransGraphRelationalExpr ExecuteTransGraphRelationalExpr :: SessionId -> TransGraphRelationalExpr -> ExecuteTransGraphRelationalExpr data ExecuteHeadName ExecuteHeadName :: SessionId -> ExecuteHeadName data ExecuteTypeForRelationalExpr ExecuteTypeForRelationalExpr :: SessionId -> RelationalExpr -> ExecuteTypeForRelationalExpr data ExecuteSchemaExpr ExecuteSchemaExpr :: SessionId -> SchemaExpr -> ExecuteSchemaExpr data ExecuteSetCurrentSchema ExecuteSetCurrentSchema :: SessionId -> SchemaName -> ExecuteSetCurrentSchema data RetrieveInclusionDependencies RetrieveInclusionDependencies :: SessionId -> RetrieveInclusionDependencies data RetrievePlanForDatabaseContextExpr RetrievePlanForDatabaseContextExpr :: SessionId -> DatabaseContextExpr -> RetrievePlanForDatabaseContextExpr data RetrieveTransactionGraph RetrieveTransactionGraph :: SessionId -> RetrieveTransactionGraph data RetrieveHeadTransactionId RetrieveHeadTransactionId :: SessionId -> RetrieveHeadTransactionId data CreateSessionAtCommit CreateSessionAtCommit :: TransactionId -> CreateSessionAtCommit data CreateSessionAtHead CreateSessionAtHead :: HeadName -> CreateSessionAtHead data CloseSession CloseSession :: SessionId -> CloseSession data RetrieveAtomTypesAsRelation RetrieveAtomTypesAsRelation :: SessionId -> RetrieveAtomTypesAsRelation data RetrieveNotificationsAsRelation RetrieveNotificationsAsRelation :: SessionId -> RetrieveNotificationsAsRelation data RetrieveRelationVariableSummary RetrieveRelationVariableSummary :: SessionId -> RetrieveRelationVariableSummary data RetrieveAtomFunctionSummary RetrieveAtomFunctionSummary :: SessionId -> RetrieveAtomFunctionSummary data RetrieveDatabaseContextFunctionSummary RetrieveDatabaseContextFunctionSummary :: SessionId -> RetrieveDatabaseContextFunctionSummary data RetrieveCurrentSchemaName RetrieveCurrentSchemaName :: SessionId -> RetrieveCurrentSchemaName data TestTimeout TestTimeout :: SessionId -> TestTimeout data RetrieveSessionIsDirty RetrieveSessionIsDirty :: SessionId -> RetrieveSessionIsDirty data ExecuteAutoMergeToHead ExecuteAutoMergeToHead :: SessionId -> MergeStrategy -> HeadName -> ExecuteAutoMergeToHead data RetrieveTypeConstructorMapping RetrieveTypeConstructorMapping :: SessionId -> RetrieveTypeConstructorMapping data ExecuteValidateMerkleHashes ExecuteValidateMerkleHashes :: SessionId -> ExecuteValidateMerkleHashes data GetDDLHash GetDDLHash :: SessionId -> GetDDLHash data RetrieveDDLAsRelation RetrieveDDLAsRelation :: SessionId -> RetrieveDDLAsRelation data RetrieveRegisteredQueries RetrieveRegisteredQueries :: SessionId -> RetrieveRegisteredQueries data ConvertSQLQuery ConvertSQLQuery :: SessionId -> Query -> ConvertSQLQuery data ConvertSQLUpdates ConvertSQLUpdates :: SessionId -> [DBUpdate] -> ConvertSQLUpdates instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.Login instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.Login instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.Logout instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.Logout instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteRelationalExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteRelationalExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteDataFrameExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteDataFrameExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteDatabaseContextExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteDatabaseContextExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteDatabaseContextIOExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteDatabaseContextIOExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteGraphExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteGraphExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteTransGraphRelationalExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteTransGraphRelationalExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteHeadName instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteHeadName instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteTypeForRelationalExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteTypeForRelationalExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteSchemaExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteSchemaExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteSetCurrentSchema instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteSetCurrentSchema instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveInclusionDependencies instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveInclusionDependencies instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrievePlanForDatabaseContextExpr instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrievePlanForDatabaseContextExpr instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveTransactionGraph instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveTransactionGraph instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveHeadTransactionId instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveHeadTransactionId instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.CreateSessionAtCommit instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.CreateSessionAtCommit instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.CreateSessionAtHead instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.CreateSessionAtHead instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.CloseSession instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.CloseSession instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveAtomTypesAsRelation instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveAtomTypesAsRelation instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveNotificationsAsRelation instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveNotificationsAsRelation instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveRelationVariableSummary instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveRelationVariableSummary instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveAtomFunctionSummary instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveAtomFunctionSummary instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveDatabaseContextFunctionSummary instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveDatabaseContextFunctionSummary instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveCurrentSchemaName instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveCurrentSchemaName instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.TestTimeout instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.TestTimeout instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveSessionIsDirty instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveSessionIsDirty instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteAutoMergeToHead instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteAutoMergeToHead instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveTypeConstructorMapping instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveTypeConstructorMapping instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ExecuteValidateMerkleHashes instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ExecuteValidateMerkleHashes instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.GetDDLHash instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.GetDDLHash instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveDDLAsRelation instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveDDLAsRelation instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.RetrieveRegisteredQueries instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.RetrieveRegisteredQueries instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ConvertSQLQuery instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ConvertSQLQuery instance Codec.Winery.Class.Serialise ProjectM36.Server.RemoteCallTypes.ConvertSQLUpdates instance GHC.Generics.Generic ProjectM36.Server.RemoteCallTypes.ConvertSQLUpdates module ProjectM36.DatabaseContextFunctionUtils executeDatabaseContextExpr :: DatabaseContextExpr -> TransactionId -> TransactionGraph -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext executeRelationalExpr :: RelationalExpr -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation module ProjectM36.DDLType -- | Return a hash of just DDL-specific (schema) attributes. This is useful -- for determining if a client has the appropriate updates needed to work -- with the current schema. ddlHash :: DatabaseContext -> TransactionGraph -> Either RelationalError SecureHash -- | Process all relations within the context of the transaction graph to -- extract the relation variables types. typesForRelationVariables :: DatabaseContext -> TransactionGraph -> Either RelationalError (Map RelVarName Relation) -- | Return a Relation which represents the database context's current DDL -- schema. ddlType :: Schema -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation -- | 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. module ProjectM36.Client -- | 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 ConnectionInfo InProcessConnectionInfo :: PersistenceStrategy -> NotificationCallback -> [GhcPkgPath] -> DatabaseContext -> ConnectionInfo RemoteConnectionInfo :: DatabaseName -> RemoteServerAddress -> NotificationCallback -> ConnectionInfo data Connection InProcessConnection :: InProcessConnectionConf -> Connection RemoteConnection :: RemoteConnectionConf -> Connection type Port = Word16 type Hostname = String -- | Either a service name e.g., "http" or a numeric port number. type ServiceName = String type DatabaseName = String -- | There are several reasons why a connection can fail. data ConnectionError SetupDatabaseDirectoryError :: PersistenceError -> ConnectionError IOExceptionError :: IOException -> ConnectionError NoSuchDatabaseByNameError :: DatabaseName -> ConnectionError DatabaseValidationError :: [MerkleValidationError] -> ConnectionError LoginError :: ConnectionError -- | To create a Connection to a remote or local database, create a -- ConnectionInfo and call connectProjectM36. connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection) -- | close cleans up the database access connection and closes any -- relevant sockets. close :: Connection -> IO () closeRemote_ :: Connection -> IO () -- | Execute a relational expression in the context of the session and -- connection. Relational expressions are queries and therefore cannot -- alter the database. executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) -- | 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. executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ()) -- | 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 executeDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ()) executeDataFrameExpr :: SessionId -> Connection -> DataFrameExpr -> IO (Either RelationalError DataFrame) -- | Execute a transaction graph expression in the context of the session -- and connection. Transaction graph operators modify the transaction -- graph state. executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ()) -- | Schema expressions manipulate the isomorphic schemas for the current -- DatabaseContext. executeSchemaExpr :: SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ()) -- | A trans-graph expression is a relational query executed against the -- entirety of a transaction graph. executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation) -- | 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. commit :: SessionId -> Connection -> IO (Either RelationalError ()) -- | 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. rollback :: SessionId -> Connection -> IO (Either RelationalError ()) -- | 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. typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) -- | Return a Map of the database's constraints at the context of -- the session and connection. inclusionDependencies :: SessionId -> Connection -> IO (Either RelationalError InclusionDependencies) typeConstructorMapping :: SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping) databaseContextFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) -- | 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. planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr) -- | Returns the name of the currently selected isomorphic schema. currentSchemaName :: SessionId -> Connection -> IO (Either RelationalError SchemaName) type SchemaName = StringType -- | 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. type HeadName = StringType -- | Switch to the named isomorphic schema. setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ()) -- | 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 transactionGraphAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) -- | Returns the names and types of the relation variables in the current -- Session. relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) registeredQueriesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) notificationsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) -- | Returns a relation representing the complete DDL of the current -- DatabaseContext. ddlAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) -- | Returns the names and types of the atom functions in the current -- Session. atomFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool) -- | Returns Just the name of the head of the current disconnected -- transaction or Nothing. headName :: SessionId -> Connection -> IO (Either RelationalError HeadName) remoteDBLookupName :: DatabaseName -> String -- | Use this for connecting to remote servers on the default port. defaultServerPort :: Port -- | Returns the transaction id for the connection's disconnected -- transaction committed parent transaction. headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId) -- | Use this for connecting to remote servers with the default database -- name. defaultDatabaseName :: DatabaseName -- | 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. defaultRemoteConnectionInfo :: ConnectionInfo -- | Use this for connecting to remote servers with the default head name. defaultHeadName :: HeadName addClientNode :: Connection -> Locking Socket -> IO () -- | 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). getDDLHash :: SessionId -> Connection -> IO (Either RelationalError SecureHash) -- | Convert a SQL Query expression into a DataFrameExpr. Because the -- conversion process requires substantial database metadata access (such -- as retrieving types for various subexpressions), we cannot process SQL -- client-side. However, the underlying DBMS is completely unaware that -- the resultant DataFrameExpr has come from SQL. convertSQLQuery :: SessionId -> Connection -> Query -> IO (Either RelationalError DataFrameExpr) convertSQLDBUpdates :: SessionId -> Connection -> [DBUpdate] -> IO (Either RelationalError DatabaseContextExpr) -- | The persistence strategy is a global database option which represents -- how to persist the database in the filesystem, if at all. data PersistenceStrategy -- | no filesystem persistence/memory-only database NoPersistence :: PersistenceStrategy -- | fsync off, not crash-safe MinimalPersistence :: FilePath -> PersistenceStrategy -- | full fsync to disk (flushes kernel and physical drive buffers to -- ensure that the transaction is on non-volatile storage) CrashSafePersistence :: FilePath -> PersistenceStrategy type RelationalExpr = RelationalExprBase () -- | A relational expression represents query (read) operations on a -- database. data RelationalExprBase a MakeRelationFromExprs :: Maybe [AttributeExprBase a] -> TupleExprsBase a -> RelationalExprBase a MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExprBase a ExistingRelation :: Relation -> RelationalExprBase a RelationVariable :: RelVarName -> a -> RelationalExprBase a -- | Extract a relation from an Atom that is a nested relation (a -- relation within a relation). RelationValuedAttribute :: AttributeName -> RelationalExprBase a Project :: AttributeNamesBase a -> RelationalExprBase a -> RelationalExprBase a Union :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Join :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Rename :: Set (AttributeName, AttributeName) -> RelationalExprBase a -> RelationalExprBase a Difference :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Group :: AttributeNamesBase a -> AttributeName -> RelationalExprBase a -> RelationalExprBase a Ungroup :: AttributeName -> RelationalExprBase a -> RelationalExprBase a Restrict :: RestrictionPredicateExprBase a -> RelationalExprBase a -> RelationalExprBase a Equals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a NotEquals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Extend :: ExtendTupleExprBase a -> RelationalExprBase a -> RelationalExprBase a With :: WithNamesAssocsBase a -> RelationalExprBase a -> RelationalExprBase a -- | Database context expressions modify the database context. data DatabaseContextExprBase a NoOperation :: DatabaseContextExprBase a Define :: RelVarName -> [AttributeExprBase a] -> DatabaseContextExprBase a Undefine :: RelVarName -> DatabaseContextExprBase a Assign :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Insert :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Delete :: RelVarName -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a Update :: RelVarName -> AttributeNameAtomExprMap -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a AddInclusionDependency :: IncDepName -> InclusionDependency -> DatabaseContextExprBase a RemoveInclusionDependency :: IncDepName -> DatabaseContextExprBase a AddNotification :: NotificationName -> RelationalExpr -> RelationalExpr -> RelationalExpr -> DatabaseContextExprBase a RemoveNotification :: NotificationName -> DatabaseContextExprBase a AddTypeConstructor :: TypeConstructorDef -> [DataConstructorDef] -> DatabaseContextExprBase a RemoveTypeConstructor :: TypeConstructorName -> DatabaseContextExprBase a RemoveAtomFunction :: FunctionName -> DatabaseContextExprBase a RemoveDatabaseContextFunction :: FunctionName -> DatabaseContextExprBase a ExecuteDatabaseContextFunction :: FunctionName -> [AtomExprBase a] -> DatabaseContextExprBase a AddRegisteredQuery :: RegisteredQueryName -> RelationalExpr -> DatabaseContextExprBase a RemoveRegisteredQuery :: RegisteredQueryName -> DatabaseContextExprBase a MultipleExpr :: [DatabaseContextExprBase a] -> DatabaseContextExprBase a type DatabaseContextExpr = DatabaseContextExprBase () -- | Adding an atom function should be nominally a DatabaseExpr except for -- the fact that it cannot be performed purely. Thus, we create the -- DatabaseContextIOExpr. data DatabaseContextIOExprBase a AddAtomFunction :: FunctionName -> [TypeConstructor] -> FunctionBodyScript -> DatabaseContextIOExprBase a LoadAtomFunctions :: ObjModuleName -> ObjFunctionName -> FilePath -> DatabaseContextIOExprBase a AddDatabaseContextFunction :: FunctionName -> [TypeConstructor] -> FunctionBodyScript -> DatabaseContextIOExprBase a LoadDatabaseContextFunctions :: ObjModuleName -> ObjFunctionName -> FilePath -> DatabaseContextIOExprBase a CreateArbitraryRelation :: RelVarName -> [AttributeExprBase a] -> Range -> DatabaseContextIOExprBase a type DatabaseContextIOExpr = DatabaseContextIOExprBase () -- | A relation's type is composed of attribute names and types. data Attribute Attribute :: AttributeName -> AtomType -> Attribute data MergeStrategy -- | 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) UnionMergeStrategy :: MergeStrategy -- | Similar to a union merge, but, on conflict, prefer the unmerged -- section (relvar, function, etc.) from the branch named as the -- argument. UnionPreferMergeStrategy :: HeadName -> MergeStrategy -- | 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. SelectedBranchMergeStrategy :: HeadName -> MergeStrategy attributesFromList :: [Attribute] -> Attributes -- | Create a new session at the transaction id and return the session's -- Id. createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId) -- | 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. createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId) -- | Discards a session, eliminating any uncommitted changes present in the -- session. closeSession :: SessionId -> Connection -> IO () callTestTimeout_ :: SessionId -> Connection -> IO Bool -- | Used to represent the number of tuples in a relation. data RelationCardinality Countable :: RelationCardinality Finite :: Int -> RelationCardinality -- | Operators which manipulate a transaction graph and which transaction -- the current Session is based upon. data TransactionGraphOperator JumpToHead :: HeadName -> TransactionGraphOperator JumpToTransaction :: TransactionId -> TransactionGraphOperator WalkBackToTime :: UTCTime -> TransactionGraphOperator Branch :: HeadName -> TransactionGraphOperator DeleteBranch :: HeadName -> TransactionGraphOperator MergeTransactions :: MergeStrategy -> HeadName -> HeadName -> TransactionGraphOperator Commit :: TransactionGraphOperator Rollback :: TransactionGraphOperator -- | 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. autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ()) transactionGraph_ :: Connection -> IO TransactionGraph disconnectedTransaction_ :: SessionId -> Connection -> IO DisconnectedTransaction -- | The TransGraphRelationalExpression is equivalent to a relational -- expression except that relation variables can reference points in the -- transaction graph (at previous points in time). type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup -- | Record a lookup for a specific transaction in the graph. data TransactionIdLookup TransactionIdLookup :: TransactionId -> TransactionIdLookup TransactionIdHeadNameLookup :: HeadName -> [TransactionIdHeadBacktrack] -> TransactionIdLookup -- | Used for git-style head backtracking such as topic~3^2. data TransactionIdHeadBacktrack -- | git equivalent of ~v: walk back n parents, arbitrarily choosing a -- parent when a choice must be made TransactionIdHeadParentBacktrack :: Int -> TransactionIdHeadBacktrack -- | git equivalent of ^: walk back one parent level to the nth -- arbitrarily-chosen parent TransactionIdHeadBranchBacktrack :: Int -> TransactionIdHeadBacktrack -- | git equivalent of 'git-rev-list -n 1 --before X' find the first -- transaction which was created before the timestamp TransactionStampHeadBacktrack :: UTCTime -> TransactionIdHeadBacktrack -- | Database atoms are the smallest, undecomposable units of a tuple. -- Common examples are integers, text, or unique identity keys. data Atom IntegerAtom :: !Integer -> Atom IntAtom :: !Int -> Atom ScientificAtom :: !Scientific -> Atom DoubleAtom :: !Double -> Atom TextAtom :: !Text -> Atom DayAtom :: !Day -> Atom DateTimeAtom :: !UTCTime -> Atom ByteStringAtom :: !ByteString -> Atom BoolAtom :: !Bool -> Atom UUIDAtom :: !UUID -> Atom RelationAtom :: !Relation -> Atom RelationalExprAtom :: !RelationalExpr -> Atom SubrelationFoldAtom :: !Relation -> !AttributeName -> Atom ConstructedAtom :: !DataConstructorName -> !AtomType -> [Atom] -> Atom -- | 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. data Session type SessionId = UUID -- | 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. type NotificationCallback = NotificationName -> EvaluatedNotification -> IO () -- | The empty notification callback ignores all callbacks. emptyNotificationCallback :: NotificationCallback -- | 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. data EvaluatedNotification EvaluatedNotification :: Notification -> Either RelationalError Relation -> Either RelationalError Relation -> EvaluatedNotification [notification] :: EvaluatedNotification -> Notification [reportOldRelation] :: EvaluatedNotification -> Either RelationalError Relation [reportNewRelation] :: EvaluatedNotification -> Either RelationalError Relation -- | Returns a listing of all available atom types. atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation) type AttributeExpr = AttributeExprBase () -- | Create a uniqueness constraint for the attribute names and relational -- expression. Note that constraint can span multiple relation variables. inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency -- | Create a DatabaseContextExpr which can be used to add a -- uniqueness constraint to attributes on one relation variable. databaseContextExprForUniqueKey :: RelVarName -> [AttributeName] -> DatabaseContextExpr -- | Create a foreign key constraint from the first relation variable and -- attributes to the second. databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr -- | Create a DatabaseContextIOExpr which can be used to load a new -- atom function written in Haskell and loaded at runtime. createScriptedAtomFunction :: FunctionName -> [TypeConstructor] -> TypeConstructor -> FunctionBodyScript -> DatabaseContextIOExpr validateMerkleHashes :: SessionId -> Connection -> IO (Either RelationalError ()) -- | Create attributes dynamically. data AttributeExprBase a AttributeAndTypeNameExpr :: AttributeName -> TypeConstructor -> a -> AttributeExprBase a NakedAttributeExpr :: Attribute -> AttributeExprBase a data TypeConstructorBase a ADTypeConstructor :: TypeConstructorName -> [TypeConstructor] -> TypeConstructorBase a PrimitiveTypeConstructor :: TypeConstructorName -> AtomType -> TypeConstructorBase a RelationAtomTypeConstructor :: [AttributeExprBase a] -> TypeConstructorBase a TypeVariable :: TypeVarName -> TypeConstructorBase a -- | Metadata definition for type constructors such as data Either a -- b. data TypeConstructorDef ADTypeConstructorDef :: TypeConstructorName -> [TypeVarName] -> TypeConstructorDef PrimitiveTypeConstructorDef :: TypeConstructorName -> AtomType -> TypeConstructorDef -- | Used to define a data constructor in a type constructor context such -- as Left a | Right b data DataConstructorDef DataConstructorDef :: DataConstructorName -> [DataConstructorDefArg] -> DataConstructorDef -- | 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"). data AttributeNamesBase a AttributeNames :: Set AttributeName -> AttributeNamesBase a InvertedAttributeNames :: Set AttributeName -> AttributeNamesBase a UnionAttributeNames :: AttributeNamesBase a -> AttributeNamesBase a -> AttributeNamesBase a IntersectAttributeNames :: AttributeNamesBase a -> AttributeNamesBase a -> AttributeNamesBase a RelationalExprAttributeNames :: RelationalExprBase a -> AttributeNamesBase a -- | Relation variables are identified by their names. type RelVarName = StringType type IncDepName = StringType -- | Inclusion dependencies represent every possible database constraint. -- Constraints enforce specific, arbitrarily-complex rules to which the -- database context's relation variables must adhere unconditionally. data InclusionDependency InclusionDependency :: RelationalExpr -> RelationalExpr -> InclusionDependency -- | The AttributeName is the name of an attribute in a relation. type AttributeName = StringType data DataFrame -- | A Relation can be converted to a DataFrame for sorting, limits, and -- offsets. data DataFrameExpr data AttributeOrderExpr data Order AscendingOrder :: Order DescendingOrder :: Order data RelationalError NoSuchAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeCountMismatchError :: Int -> RelationalError EmptyAttributesError :: RelationalError DuplicateAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeTypeMismatchError :: Attributes -> RelationalError AttributeCountMismatchError :: Int -> RelationalError AttributeNamesMismatchError :: Set AttributeName -> RelationalError AttributeTypesMismatchError :: Attributes -> RelationalError AttributeNameInUseError :: AttributeName -> RelationalError AttributeIsNotRelationValuedError :: AttributeName -> RelationalError CouldNotInferAttributes :: RelationalError RelVarNotDefinedError :: RelVarName -> RelationalError RelVarAlreadyDefinedError :: RelVarName -> RelationalError RelationTypeMismatchError :: Attributes -> Attributes -> RelationalError InclusionDependencyCheckError :: IncDepName -> Maybe RelationalError -> RelationalError InclusionDependencyNameInUseError :: IncDepName -> RelationalError InclusionDependencyNameNotInUseError :: IncDepName -> RelationalError ParseError :: Text -> RelationalError PredicateExpressionError :: Text -> RelationalError NoCommonTransactionAncestorError :: TransactionId -> TransactionId -> RelationalError NoSuchTransactionError :: TransactionId -> RelationalError RootTransactionTraversalError :: RelationalError HeadNameSwitchingHeadProhibitedError :: HeadName -> RelationalError NoSuchHeadNameError :: HeadName -> RelationalError UnknownHeadError :: RelationalError NewTransactionMayNotHaveChildrenError :: TransactionId -> RelationalError ParentCountTraversalError :: Int -> Int -> RelationalError NewTransactionMissingParentError :: TransactionId -> RelationalError TransactionIsNotAHeadError :: TransactionId -> RelationalError TransactionGraphCycleError :: TransactionId -> RelationalError SessionIdInUseError :: TransactionId -> RelationalError NoSuchSessionError :: TransactionId -> RelationalError FailedToFindTransactionError :: TransactionId -> RelationalError TransactionIdInUseError :: TransactionId -> RelationalError NoSuchFunctionError :: FunctionName -> RelationalError NoSuchTypeConstructorName :: TypeConstructorName -> RelationalError TypeConstructorAtomTypeMismatch :: TypeConstructorName -> AtomType -> RelationalError AtomTypeMismatchError :: AtomType -> AtomType -> RelationalError TypeConstructorNameMismatch :: TypeConstructorName -> TypeConstructorName -> RelationalError AtomTypeTypeConstructorReconciliationError :: AtomType -> TypeConstructorName -> RelationalError DataConstructorNameInUseError :: DataConstructorName -> RelationalError DataConstructorUsesUndeclaredTypeVariable :: TypeVarName -> RelationalError TypeConstructorTypeVarsMismatch :: Set TypeVarName -> Set TypeVarName -> RelationalError TypeConstructorTypeVarMissing :: TypeVarName -> RelationalError TypeConstructorTypeVarsTypesMismatch :: TypeConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError DataConstructorTypeVarsMismatch :: DataConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError AtomFunctionTypeVariableResolutionError :: FunctionName -> TypeVarName -> RelationalError AtomFunctionTypeVariableMismatch :: TypeVarName -> AtomType -> AtomType -> RelationalError IfThenExprExpectedBooleanError :: AtomType -> RelationalError AtomTypeNameInUseError :: AtomTypeName -> RelationalError IncompletelyDefinedAtomTypeWithConstructorError :: RelationalError AtomTypeNameNotInUseError :: AtomTypeName -> RelationalError AttributeNotSortableError :: Attribute -> RelationalError FunctionNameInUseError :: FunctionName -> RelationalError FunctionNameNotInUseError :: FunctionName -> RelationalError EmptyCommitError :: RelationalError FunctionArgumentCountMismatchError :: Int -> Int -> RelationalError ConstructedAtomArgumentCountMismatchError :: Int -> Int -> RelationalError NoSuchDataConstructorError :: DataConstructorName -> RelationalError NoSuchTypeConstructorError :: TypeConstructorName -> RelationalError InvalidAtomTypeName :: AtomTypeName -> RelationalError AtomTypeNotSupported :: AttributeName -> RelationalError AtomOperatorNotSupported :: Text -> RelationalError EmptyTuplesError :: RelationalError AtomTypeCountError :: [AtomType] -> [AtomType] -> RelationalError AtomFunctionTypeError :: FunctionName -> Int -> AtomType -> AtomType -> RelationalError AtomFunctionUserError :: AtomFunctionError -> RelationalError PrecompiledFunctionRemoveError :: FunctionName -> RelationalError RelationValuedAttributesNotSupportedError :: [AttributeName] -> RelationalError NotificationNameInUseError :: NotificationName -> RelationalError NotificationNameNotInUseError :: NotificationName -> RelationalError NotificationValidationError :: NotificationName -> NotificationExpression -> RelationalError -> RelationalError ImportError :: ImportError' -> RelationalError ExportError :: Text -> RelationalError UnhandledExceptionError :: String -> RelationalError MergeTransactionError :: MergeError -> RelationalError ScriptError :: ScriptCompilationError -> RelationalError LoadFunctionError :: RelationalError SecurityLoadFunctionError :: RelationalError DatabaseContextFunctionUserError :: DatabaseContextFunctionError -> RelationalError DatabaseLoadError :: PersistenceError -> RelationalError SubschemaNameInUseError :: SchemaName -> RelationalError SubschemaNameNotInUseError :: SchemaName -> RelationalError SchemaCreationError :: SchemaError -> RelationalError ImproperDatabaseStateError :: RelationalError NonConcreteSchemaPlanError :: RelationalError NoUncommittedContextInEvalError :: RelationalError TupleExprsReferenceMultipleMarkersError :: RelationalError MerkleHashValidationError :: TransactionId -> MerkleHash -> MerkleHash -> RelationalError RegisteredQueryValidationError :: RegisteredQueryName -> RelationalError -> RelationalError RegisteredQueryNameInUseError :: RegisteredQueryName -> RelationalError RegisteredQueryNameNotInUseError :: RegisteredQueryName -> RelationalError SQLConversionError :: SQLError -> RelationalError MultipleErrors :: [RelationalError] -> RelationalError data RequestTimeoutException RequestTimeoutException :: RequestTimeoutException data RemoteProcessDiedException RemoteProcessDiedException :: RemoteProcessDiedException -- | The AtomType uniquely identifies the type of a atom. data AtomType IntAtomType :: AtomType IntegerAtomType :: AtomType ScientificAtomType :: AtomType DoubleAtomType :: AtomType TextAtomType :: AtomType DayAtomType :: AtomType DateTimeAtomType :: AtomType ByteStringAtomType :: AtomType BoolAtomType :: AtomType UUIDAtomType :: AtomType RelationAtomType :: Attributes -> AtomType SubrelationFoldAtomType :: AtomType -> AtomType ConstructedAtomType :: TypeConstructorName -> TypeVarMap -> AtomType RelationalExprAtomType :: AtomType TypeVariableType :: TypeVarName -> AtomType -- | 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. class (Eq a, NFData a, Serialise a, Show a) => Atomable a toAtom :: Atomable a => a -> Atom toAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => a -> Atom fromAtom :: Atomable a => Atom -> a fromAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => Atom -> a toAtomType :: Atomable a => proxy a -> AtomType toAtomType :: (Atomable a, Generic a, AtomableG (Rep a)) => proxy a -> AtomType -- | Creates DatabaseContextExpr necessary to load the type constructor and -- data constructor into the database. toAddTypeExpr :: Atomable a => proxy a -> DatabaseContextExpr -- | Creates DatabaseContextExpr necessary to load the type constructor and -- data constructor into the database. toAddTypeExpr :: (Atomable a, Generic a, AtomableG (Rep a)) => proxy a -> DatabaseContextExpr -- | Dynamically create a tuple from attribute names and AtomExprs. newtype TupleExprBase a TupleExpr :: Map AttributeName (AtomExprBase a) -> TupleExprBase a data TupleExprsBase a TupleExprs :: a -> [TupleExprBase a] -> TupleExprsBase a -- | An atom expression represents an action to take when extending a -- relation or when statically defining a relation or a new tuple. data AtomExprBase a AttributeAtomExpr :: AttributeName -> AtomExprBase a SubrelationAttributeAtomExpr :: AttributeName -> AttributeName -> AtomExprBase a NakedAtomExpr :: !Atom -> AtomExprBase a FunctionAtomExpr :: !FunctionName -> [AtomExprBase a] -> a -> AtomExprBase a RelationAtomExpr :: RelationalExprBase a -> AtomExprBase a IfThenAtomExpr :: AtomExprBase a -> AtomExprBase a -> AtomExprBase a -> AtomExprBase a ConstructedAtomExpr :: DataConstructorName -> [AtomExprBase a] -> a -> AtomExprBase a -- | Restriction predicates are boolean algebra components which, when -- composed, indicate whether or not a tuple should be retained during a -- restriction (filtering) operation. data RestrictionPredicateExprBase a TruePredicate :: RestrictionPredicateExprBase a AndPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a OrPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a NotPredicate :: RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a RelationalExprPredicate :: RelationalExprBase a -> RestrictionPredicateExprBase a AtomExprPredicate :: AtomExprBase a -> RestrictionPredicateExprBase a AttributeEqualityPredicate :: AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a -- | Runs an IO monad, commits the result when the monad returns no errors, -- otherwise, rolls back the changes and the error. withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a) basicDatabaseContext :: DatabaseContext data RemoteServerAddress RemoteServerHostAddress :: Hostname -> Port -> RemoteServerAddress RemoteServerUnixDomainSocketAddress :: FilePath -> RemoteServerAddress -- | Resolve a server address using DNS, if necessary. The caller is -- expected to set any necessary socket options afterwards. resolveRemoteServerAddress :: RemoteServerAddress -> IO (SockSpec, SockAddr) -- | Use this for connecting to the default remote server. defaultRemoteServerAddress :: RemoteServerAddress defaultServerHostname :: Hostname instance GHC.Show.Show ProjectM36.Client.RemoteServerAddress instance GHC.Classes.Eq ProjectM36.Client.RemoteProcessDiedException instance GHC.Show.Show ProjectM36.Client.RemoteProcessDiedException instance GHC.Classes.Eq ProjectM36.Client.RequestTimeoutException instance GHC.Show.Show ProjectM36.Client.RequestTimeoutException instance Codec.Winery.Class.Serialise ProjectM36.Client.EvaluatedNotification instance GHC.Generics.Generic ProjectM36.Client.EvaluatedNotification instance GHC.Show.Show ProjectM36.Client.EvaluatedNotification instance GHC.Classes.Eq ProjectM36.Client.EvaluatedNotification instance Codec.Winery.Class.Serialise ProjectM36.Client.NotificationMessage instance GHC.Generics.Generic ProjectM36.Client.NotificationMessage instance GHC.Show.Show ProjectM36.Client.NotificationMessage instance GHC.Classes.Eq ProjectM36.Client.NotificationMessage instance GHC.Generics.Generic ProjectM36.Client.ConnectionError instance GHC.Classes.Eq ProjectM36.Client.ConnectionError instance GHC.Show.Show ProjectM36.Client.ConnectionError instance GHC.Classes.Eq ProjectM36.Client.ClientInfo instance Data.Hashable.Class.Hashable ProjectM36.Client.ClientInfo instance GHC.Exception.Type.Exception ProjectM36.Client.RequestTimeoutException instance GHC.Exception.Type.Exception ProjectM36.Client.RemoteProcessDiedException module ProjectM36.Server.EntryPoints timeoutOrDie :: Maybe Timeout -> IO a -> IO (Maybe a) timeoutRelErr :: Maybe Timeout -> IO (Either RelationalError a) -> IO (Either RelationalError a) handleExecuteRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) handleExecuteDataFrameExpr :: Maybe Timeout -> SessionId -> Connection -> DataFrameExpr -> IO (Either RelationalError DataFrame) handleExecuteDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ()) handleExecuteDatabaseContextIOExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ()) handleExecuteHeadName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError HeadName) handleLogin :: Connection -> Locking Socket -> IO Bool handleExecuteGraphExpr :: Maybe Timeout -> SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ()) handleExecuteTransGraphRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation) handleExecuteTypeForRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation) handleRetrieveInclusionDependencies :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError (Map IncDepName InclusionDependency)) handleRetrievePlanForDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr) handleRetrieveTransactionGraph :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleRetrieveHeadTransactionId :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TransactionId) handleCreateSessionAtCommit :: Maybe Timeout -> Connection -> TransactionId -> IO (Either RelationalError SessionId) handleCreateSessionAtHead :: Maybe Timeout -> Connection -> HeadName -> IO (Either RelationalError SessionId) handleCloseSession :: SessionId -> Connection -> IO () handleRetrieveAtomTypesAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) -- | Returns a relation which lists the names of relvars in the current -- session as well as its types. handleRetrieveRelationVariableSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleRetrieveAtomFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleRetrieveDatabaseContextFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleRetrieveCurrentSchemaName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SchemaName) handleExecuteSchemaExpr :: Maybe Timeout -> SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ()) handleLogout :: Maybe Timeout -> Connection -> IO Bool handleTestTimeout :: Maybe Timeout -> SessionId -> Connection -> IO Bool handleRetrieveSessionIsDirty :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Bool) handleExecuteAutoMergeToHead :: Maybe Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ()) handleRetrieveTypeConstructorMapping :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping) handleValidateMerkleHashes :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError ()) handleGetDDLHash :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SecureHash) handleRetrieveDDLAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleRetrieveRegisteredQueries :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) handleConvertSQLQuery :: Maybe Timeout -> SessionId -> Connection -> Query -> IO (Either RelationalError DataFrameExpr) handleConvertSQLUpdates :: Maybe Timeout -> SessionId -> Connection -> [DBUpdate] -> IO (Either RelationalError DatabaseContextExpr) handleRetrieveNotificationsAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) module ProjectM36.Server.Config data ServerConfig ServerConfig :: PersistenceStrategy -> Bool -> DatabaseName -> RemoteServerAddress -> [String] -> Int -> Bool -> ServerConfig [persistenceStrategy] :: ServerConfig -> PersistenceStrategy [checkFS] :: ServerConfig -> Bool [databaseName] :: ServerConfig -> DatabaseName [bindAddress] :: ServerConfig -> RemoteServerAddress [ghcPkgPaths] :: ServerConfig -> [String] [perRequestTimeout] :: ServerConfig -> Int [testMode] :: ServerConfig -> Bool data WebsocketServerConfig WebsocketServerConfig :: ServerConfig -> Maybe String -> Maybe String -> WebsocketServerConfig [wsServerConfig] :: WebsocketServerConfig -> ServerConfig [tlsCertificatePath] :: WebsocketServerConfig -> Maybe String [tlsKeyPath] :: WebsocketServerConfig -> Maybe String defaultServerConfig :: ServerConfig instance GHC.Show.Show ProjectM36.Server.Config.ServerConfig instance GHC.Show.Show ProjectM36.Server.Config.WebsocketServerConfig module ProjectM36.Server.ParseArgs parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig parsePersistenceStrategy :: Parser PersistenceStrategy parseTestMode :: Parser Bool parseCheckFS :: Parser Bool parseServerAddress :: Parser RemoteServerAddress parseUnixDomainSocketPath :: Parser FilePath parseDatabaseName :: Parser DatabaseName parseHostname :: Hostname -> Parser Hostname parsePort :: Port -> Parser Port parseGhcPkgPath :: Parser String parseTimeout :: Int -> Parser Int parseConfig :: IO ServerConfig parseConfigWithDefaults :: ServerConfig -> IO ServerConfig parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig parseTlsCertificatePath :: Parser (Maybe String) parseTlsKeyPath :: Parser (Maybe String) helpOption :: Parser (a -> a) module ProjectM36.Server type TestMode = Bool requestHandlers :: TestMode -> Maybe Timeout -> RequestHandlers ServerState getConn :: ConnectionState ServerState -> IO Connection testModeHandlers :: Maybe Timeout -> RequestHandlers ServerState -- | A notification callback which logs the notification to stderr and does -- nothing else. loggingNotificationCallback :: NotificationCallback checkFSType :: Bool -> PersistenceStrategy -> IO Bool checkFSErrorMsg :: String type SocketString = String data ServerState ServerState :: Map DatabaseName Connection -> Map SocketString DatabaseName -> ServerState [stateDBMap] :: ServerState -> Map DatabaseName Connection [stateClientMap] :: ServerState -> Map SocketString DatabaseName addClientLogin :: DatabaseName -> ConnectionState ServerState -> IO () connectionForClient :: Socket -> ServerState -> IO (Maybe Connection) initialServerState :: DatabaseName -> Connection -> IO ServerState -- | A synchronous function to start the project-m36 daemon given an -- appropriate ServerConfig. Note that this function only returns -- if the server exits. Returns False if the daemon exited due to an -- error. If the second argument is not Nothing, the port is put after -- the server is ready to service the port. launchServer :: ServerConfig -> Maybe (MVar SockAddr) -> IO Bool -- | A simplified client interface for Project:M36 database access. module ProjectM36.Client.Simple -- | Same as simpleConnectProjectM36At but always connects to the -- master branch. simpleConnectProjectM36 :: ConnectionInfo -> IO (Either DbError DbConn) -- | A simple alternative to connectProjectM36 which includes -- simple session management. simpleConnectProjectM36At :: HeadName -> ConnectionInfo -> IO (Either DbError DbConn) -- | Runs a Db monad which may include some database updates. If an -- exception or error occurs, the transaction is rolled back. Otherwise, -- the transaction is committed to the head of the current branch. withTransaction :: DbConn -> Db a -> IO (Either DbError a) -- | Same as withTransaction except that the merge strategy can be -- specified. withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a) -- | Execute a DatabaseContextExpr in the DB monad. -- Database context expressions manipulate the state of the database. In -- case of an error, the transaction is terminated and the connection's -- session is rolled back. execute :: DatabaseContextExpr -> Db () -- | Run a DatabaseContextExpr update expression. If there is an -- error, just return it without cancelling the current transaction. executeOrErr :: DatabaseContextExpr -> Db (Either RelationalError ()) -- | Run a RelationalExpr query in the DB monad. Relational -- expressions perform read-only queries against the current database -- state. query :: RelationalExpr -> Db Relation -- | Run a RelationalExpr query expression. If there is an error, -- just return it without cancelling the transaction. queryOrErr :: RelationalExpr -> Db (Either RelationalError Relation) -- | Cancel a transaction and carry some error information with it. cancelTransaction :: DbError -> Db a -- | Converts the Either result from a Db action into an -- immediate cancel in the case of error. orCancelTransaction :: Either RelationalError a -> Db a -- | Unconditionally roll back the current transaction and throw an -- exception to terminate the execution of the Db monad. rollback :: Db () -- | Closes the database connection. close :: DbConn -> IO () -- | Database atoms are the smallest, undecomposable units of a tuple. -- Common examples are integers, text, or unique identity keys. data Atom IntegerAtom :: !Integer -> Atom IntAtom :: !Int -> Atom ScientificAtom :: !Scientific -> Atom DoubleAtom :: !Double -> Atom TextAtom :: !Text -> Atom DayAtom :: !Day -> Atom DateTimeAtom :: !UTCTime -> Atom ByteStringAtom :: !ByteString -> Atom BoolAtom :: !Bool -> Atom UUIDAtom :: !UUID -> Atom RelationAtom :: !Relation -> Atom RelationalExprAtom :: !RelationalExpr -> Atom SubrelationFoldAtom :: !Relation -> !AttributeName -> Atom ConstructedAtom :: !DataConstructorName -> !AtomType -> [Atom] -> Atom -- | The AtomType uniquely identifies the type of a atom. data AtomType IntAtomType :: AtomType IntegerAtomType :: AtomType ScientificAtomType :: AtomType DoubleAtomType :: AtomType TextAtomType :: AtomType DayAtomType :: AtomType DateTimeAtomType :: AtomType ByteStringAtomType :: AtomType BoolAtomType :: AtomType UUIDAtomType :: AtomType RelationAtomType :: Attributes -> AtomType SubrelationFoldAtomType :: AtomType -> AtomType ConstructedAtomType :: TypeConstructorName -> TypeVarMap -> AtomType RelationalExprAtomType :: AtomType TypeVariableType :: TypeVarName -> AtomType data Db a type DbConn = (SessionId, Connection) -- | A union of connection and other errors that can be returned from -- withTransaction. data DbError ConnError :: ConnectionError -> DbError RelError :: RelationalError -> DbError TransactionRolledBack :: DbError data RelationalError NoSuchAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeCountMismatchError :: Int -> RelationalError EmptyAttributesError :: RelationalError DuplicateAttributeNamesError :: Set AttributeName -> RelationalError TupleAttributeTypeMismatchError :: Attributes -> RelationalError AttributeCountMismatchError :: Int -> RelationalError AttributeNamesMismatchError :: Set AttributeName -> RelationalError AttributeTypesMismatchError :: Attributes -> RelationalError AttributeNameInUseError :: AttributeName -> RelationalError AttributeIsNotRelationValuedError :: AttributeName -> RelationalError CouldNotInferAttributes :: RelationalError RelVarNotDefinedError :: RelVarName -> RelationalError RelVarAlreadyDefinedError :: RelVarName -> RelationalError RelationTypeMismatchError :: Attributes -> Attributes -> RelationalError InclusionDependencyCheckError :: IncDepName -> Maybe RelationalError -> RelationalError InclusionDependencyNameInUseError :: IncDepName -> RelationalError InclusionDependencyNameNotInUseError :: IncDepName -> RelationalError ParseError :: Text -> RelationalError PredicateExpressionError :: Text -> RelationalError NoCommonTransactionAncestorError :: TransactionId -> TransactionId -> RelationalError NoSuchTransactionError :: TransactionId -> RelationalError RootTransactionTraversalError :: RelationalError HeadNameSwitchingHeadProhibitedError :: HeadName -> RelationalError NoSuchHeadNameError :: HeadName -> RelationalError UnknownHeadError :: RelationalError NewTransactionMayNotHaveChildrenError :: TransactionId -> RelationalError ParentCountTraversalError :: Int -> Int -> RelationalError NewTransactionMissingParentError :: TransactionId -> RelationalError TransactionIsNotAHeadError :: TransactionId -> RelationalError TransactionGraphCycleError :: TransactionId -> RelationalError SessionIdInUseError :: TransactionId -> RelationalError NoSuchSessionError :: TransactionId -> RelationalError FailedToFindTransactionError :: TransactionId -> RelationalError TransactionIdInUseError :: TransactionId -> RelationalError NoSuchFunctionError :: FunctionName -> RelationalError NoSuchTypeConstructorName :: TypeConstructorName -> RelationalError TypeConstructorAtomTypeMismatch :: TypeConstructorName -> AtomType -> RelationalError AtomTypeMismatchError :: AtomType -> AtomType -> RelationalError TypeConstructorNameMismatch :: TypeConstructorName -> TypeConstructorName -> RelationalError AtomTypeTypeConstructorReconciliationError :: AtomType -> TypeConstructorName -> RelationalError DataConstructorNameInUseError :: DataConstructorName -> RelationalError DataConstructorUsesUndeclaredTypeVariable :: TypeVarName -> RelationalError TypeConstructorTypeVarsMismatch :: Set TypeVarName -> Set TypeVarName -> RelationalError TypeConstructorTypeVarMissing :: TypeVarName -> RelationalError TypeConstructorTypeVarsTypesMismatch :: TypeConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError DataConstructorTypeVarsMismatch :: DataConstructorName -> TypeVarMap -> TypeVarMap -> RelationalError AtomFunctionTypeVariableResolutionError :: FunctionName -> TypeVarName -> RelationalError AtomFunctionTypeVariableMismatch :: TypeVarName -> AtomType -> AtomType -> RelationalError IfThenExprExpectedBooleanError :: AtomType -> RelationalError AtomTypeNameInUseError :: AtomTypeName -> RelationalError IncompletelyDefinedAtomTypeWithConstructorError :: RelationalError AtomTypeNameNotInUseError :: AtomTypeName -> RelationalError AttributeNotSortableError :: Attribute -> RelationalError FunctionNameInUseError :: FunctionName -> RelationalError FunctionNameNotInUseError :: FunctionName -> RelationalError EmptyCommitError :: RelationalError FunctionArgumentCountMismatchError :: Int -> Int -> RelationalError ConstructedAtomArgumentCountMismatchError :: Int -> Int -> RelationalError NoSuchDataConstructorError :: DataConstructorName -> RelationalError NoSuchTypeConstructorError :: TypeConstructorName -> RelationalError InvalidAtomTypeName :: AtomTypeName -> RelationalError AtomTypeNotSupported :: AttributeName -> RelationalError AtomOperatorNotSupported :: Text -> RelationalError EmptyTuplesError :: RelationalError AtomTypeCountError :: [AtomType] -> [AtomType] -> RelationalError AtomFunctionTypeError :: FunctionName -> Int -> AtomType -> AtomType -> RelationalError AtomFunctionUserError :: AtomFunctionError -> RelationalError PrecompiledFunctionRemoveError :: FunctionName -> RelationalError RelationValuedAttributesNotSupportedError :: [AttributeName] -> RelationalError NotificationNameInUseError :: NotificationName -> RelationalError NotificationNameNotInUseError :: NotificationName -> RelationalError NotificationValidationError :: NotificationName -> NotificationExpression -> RelationalError -> RelationalError ImportError :: ImportError' -> RelationalError ExportError :: Text -> RelationalError UnhandledExceptionError :: String -> RelationalError MergeTransactionError :: MergeError -> RelationalError ScriptError :: ScriptCompilationError -> RelationalError LoadFunctionError :: RelationalError SecurityLoadFunctionError :: RelationalError DatabaseContextFunctionUserError :: DatabaseContextFunctionError -> RelationalError DatabaseLoadError :: PersistenceError -> RelationalError SubschemaNameInUseError :: SchemaName -> RelationalError SubschemaNameNotInUseError :: SchemaName -> RelationalError SchemaCreationError :: SchemaError -> RelationalError ImproperDatabaseStateError :: RelationalError NonConcreteSchemaPlanError :: RelationalError NoUncommittedContextInEvalError :: RelationalError TupleExprsReferenceMultipleMarkersError :: RelationalError MerkleHashValidationError :: TransactionId -> MerkleHash -> MerkleHash -> RelationalError RegisteredQueryValidationError :: RegisteredQueryName -> RelationalError -> RelationalError RegisteredQueryNameInUseError :: RegisteredQueryName -> RelationalError RegisteredQueryNameNotInUseError :: RegisteredQueryName -> RelationalError SQLConversionError :: SQLError -> RelationalError MultipleErrors :: [RelationalError] -> RelationalError -- | A relation's type is composed of attribute names and types. data Attribute Attribute :: AttributeName -> AtomType -> Attribute -- | 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. class (Eq a, NFData a, Serialise a, Show a) => Atomable a toAtom :: Atomable a => a -> Atom toAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => a -> Atom fromAtom :: Atomable a => Atom -> a fromAtom :: (Atomable a, Generic a, AtomableG (Rep a)) => Atom -> a -- | 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 ConnectionInfo InProcessConnectionInfo :: PersistenceStrategy -> NotificationCallback -> [GhcPkgPath] -> DatabaseContext -> ConnectionInfo RemoteConnectionInfo :: DatabaseName -> RemoteServerAddress -> NotificationCallback -> ConnectionInfo -- | The persistence strategy is a global database option which represents -- how to persist the database in the filesystem, if at all. data PersistenceStrategy -- | no filesystem persistence/memory-only database NoPersistence :: PersistenceStrategy -- | fsync off, not crash-safe MinimalPersistence :: FilePath -> PersistenceStrategy -- | full fsync to disk (flushes kernel and physical drive buffers to -- ensure that the transaction is on non-volatile storage) CrashSafePersistence :: FilePath -> PersistenceStrategy -- | 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. type NotificationCallback = NotificationName -> EvaluatedNotification -> IO () -- | The empty notification callback ignores all callbacks. emptyNotificationCallback :: NotificationCallback -- | Database context expressions modify the database context. data DatabaseContextExprBase a NoOperation :: DatabaseContextExprBase a Define :: RelVarName -> [AttributeExprBase a] -> DatabaseContextExprBase a Undefine :: RelVarName -> DatabaseContextExprBase a Assign :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Insert :: RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a Delete :: RelVarName -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a Update :: RelVarName -> AttributeNameAtomExprMap -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a AddInclusionDependency :: IncDepName -> InclusionDependency -> DatabaseContextExprBase a RemoveInclusionDependency :: IncDepName -> DatabaseContextExprBase a AddNotification :: NotificationName -> RelationalExpr -> RelationalExpr -> RelationalExpr -> DatabaseContextExprBase a RemoveNotification :: NotificationName -> DatabaseContextExprBase a AddTypeConstructor :: TypeConstructorDef -> [DataConstructorDef] -> DatabaseContextExprBase a RemoveTypeConstructor :: TypeConstructorName -> DatabaseContextExprBase a RemoveAtomFunction :: FunctionName -> DatabaseContextExprBase a RemoveDatabaseContextFunction :: FunctionName -> DatabaseContextExprBase a ExecuteDatabaseContextFunction :: FunctionName -> [AtomExprBase a] -> DatabaseContextExprBase a AddRegisteredQuery :: RegisteredQueryName -> RelationalExpr -> DatabaseContextExprBase a RemoveRegisteredQuery :: RegisteredQueryName -> DatabaseContextExprBase a MultipleExpr :: [DatabaseContextExprBase a] -> DatabaseContextExprBase a type DatabaseContextExpr = DatabaseContextExprBase () -- | A relational expression represents query (read) operations on a -- database. data RelationalExprBase a MakeRelationFromExprs :: Maybe [AttributeExprBase a] -> TupleExprsBase a -> RelationalExprBase a MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExprBase a ExistingRelation :: Relation -> RelationalExprBase a RelationVariable :: RelVarName -> a -> RelationalExprBase a -- | Extract a relation from an Atom that is a nested relation (a -- relation within a relation). RelationValuedAttribute :: AttributeName -> RelationalExprBase a Project :: AttributeNamesBase a -> RelationalExprBase a -> RelationalExprBase a Union :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Join :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Rename :: Set (AttributeName, AttributeName) -> RelationalExprBase a -> RelationalExprBase a Difference :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Group :: AttributeNamesBase a -> AttributeName -> RelationalExprBase a -> RelationalExprBase a Ungroup :: AttributeName -> RelationalExprBase a -> RelationalExprBase a Restrict :: RestrictionPredicateExprBase a -> RelationalExprBase a -> RelationalExprBase a Equals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a NotEquals :: RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a Extend :: ExtendTupleExprBase a -> RelationalExprBase a -> RelationalExprBase a With :: WithNamesAssocsBase a -> RelationalExprBase a -> RelationalExprBase a instance Control.Monad.IO.Class.MonadIO ProjectM36.Client.Simple.Db instance GHC.Base.Monad ProjectM36.Client.Simple.Db instance GHC.Base.Applicative ProjectM36.Client.Simple.Db instance GHC.Base.Functor ProjectM36.Client.Simple.Db instance GHC.Show.Show ProjectM36.Client.Simple.DbError instance GHC.Classes.Eq ProjectM36.Client.Simple.DbError instance GHC.Show.Show ProjectM36.Client.Simple.TransactionCancelled instance GHC.Exception.Type.Exception ProjectM36.Client.Simple.TransactionCancelled