project-m36 1.0.0 → 1.0.1

raw patch · 42 files changed

+285/−137 lines, 42 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Changelog.markdown +4/−0
• project-m36.cabal +1/−1
• src/bin/TutorialD/Interpreter/Base.hs +3/−1
• src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs +7/−7
• src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs +1/−1
• src/bin/TutorialD/Interpreter/Import/BasicExamples.hs +1/−1
• src/bin/TutorialD/Interpreter/Import/CSV.hs +1/−1
• src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs +2/−2
• src/bin/TutorialD/Interpreter/RelationalExpr.hs +32/−9
• src/bin/TutorialD/Interpreter/SchemaOperator.hs +2/−2
• src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs +1/−1
• src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs +7/−7
• src/bin/TutorialD/Interpreter/Types.hs +12/−7
• src/bin/TutorialD/Printer.hs +4/−1
• src/lib/ProjectM36/Arbitrary.hs +11/−1
• src/lib/ProjectM36/Atom.hs +1/−1
• src/lib/ProjectM36/AtomFunction.hs +3/−1
• src/lib/ProjectM36/AtomFunctionError.hs +3/−1
• src/lib/ProjectM36/AtomFunctions/Primitive.hs +42/−20
• src/lib/ProjectM36/AtomType.hs +6/−1
• src/lib/ProjectM36/Atomable.hs +2/−0
• src/lib/ProjectM36/Base.hs +13/−4
• src/lib/ProjectM36/DataTypes/Interval.hs +2/−0
• src/lib/ProjectM36/DataTypes/Primitive.hs +1/−0
• src/lib/ProjectM36/DataTypes/SQL/Null.hs +5/−3
• src/lib/ProjectM36/DataTypes/Sorting.hs +2/−0
• src/lib/ProjectM36/FunctionalDependency.hs +0/−0
• src/lib/ProjectM36/HashSecurely.hs +3/−0
• src/lib/ProjectM36/NormalizeExpr.hs +1/−0
• src/lib/ProjectM36/ReferencedTransactionIds.hs +1/−0
• src/lib/ProjectM36/Relation/Parse/CSV.hs +4/−1
• src/lib/ProjectM36/RelationalExpression.hs +38/−16
• src/lib/ProjectM36/SQL/Convert.hs +31/−28
• src/lib/ProjectM36/StaticOptimizer.hs +1/−0
• src/lib/ProjectM36/TransGraphRelationalExpression.hs +1/−0
• src/lib/ProjectM36/Transaction/Persist.hs +4/−1
• src/lib/ProjectM36/TransactionGraph.hs +1/−1
• src/lib/ProjectM36/TransactionGraph/Merge.hs +1/−1
• src/lib/ProjectM36/Tuple.hs +3/−1
• src/lib/ProjectM36/WithNameExpr.hs +1/−0
• test/SQL/InterpreterTest.hs +10/−9
• test/TutorialD/InterpreterTest.hs +16/−6

@@ -1,3 +1,7 @@+# 2024-07-15 (v1.0.1)++* add support for aggregate functions using sub-relation attributes+ # 2024-06-06 (v1.0.0)  * add support for relational expression evaluation against sub-relations

@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: project-m36-Version: 1.0.0+Version: 1.0.1 License: MIT --note that this license specification is erroneous and only labeled MIT to appease hackage which does not recognize public domain packages in cabal >2.2- Project:M36 is dedicated to the public domain Build-Type: Simple

@@ -69,10 +69,12 @@   istart <- letterChar <|> char '_'   identifierRemainder istart +identifierP :: Parser Text+identifierP = identifier <* spaceConsumer+ identifierRemainder :: Char -> Parser Text identifierRemainder c = do   rest <- many (alphaNumChar <|> char '_' <|> char '#')-  spaceConsumer   pure (pack (c:rest))  symbol :: ParseStr -> Parser Text

@@ -98,7 +98,7 @@ addConstraintP :: Parser DatabaseContextExpr addConstraintP = do   reservedOp "constraint" <|> reservedOp "foreign key"-  constraintName <- identifier+  constraintName <- identifierP   subset <- relExprP   op <- (reservedOp "in" $> SubsetOp) <|> (reservedOp "equals" $> EqualityOp)   superset <- relExprP@@ -112,13 +112,13 @@ deleteConstraintP :: Parser DatabaseContextExpr   deleteConstraintP = do   reserved "deleteconstraint"-  RemoveInclusionDependency <$> identifier+  RemoveInclusionDependency <$> identifierP    -- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr> keyP :: Parser DatabaseContextExpr   keyP = do   reserved "key"-  keyName <- identifier+  keyName <- identifierP   uniquenessAttrNames <- braces attributeListP   uniquenessExpr <- relExprP   let newIncDep = inclusionDependencyForKey uniquenessAttrNames uniquenessExpr@@ -127,7 +127,7 @@ funcDepP :: Parser DatabaseContextExpr   funcDepP = do   reserved "funcdep"-  keyName <- identifier+  keyName <- identifierP   source <- parens attributeListP   reserved "->"   dependents <- parens attributeListP@@ -141,7 +141,7 @@    attributeAssignmentP :: Parser (AttributeName, AtomExpr) attributeAssignmentP = do-  attrName <- identifier+  attrName <- identifierP   reservedOp ":="   atomExpr <- atomExprP   pure (attrName, atomExpr)@@ -149,7 +149,7 @@ addNotificationP :: Parser DatabaseContextExpr addNotificationP = do   reserved "notify"-  notName <- identifier+  notName <- identifierP   triggerExpr <- relExprP    resultOldExpr <- relExprP   AddNotification notName triggerExpr resultOldExpr <$> relExprP@@ -157,7 +157,7 @@ removeNotificationP :: Parser DatabaseContextExpr   removeNotificationP = do   reserved "unnotify"-  RemoveNotification <$> identifier+  RemoveNotification <$> identifierP  -- | data Hair = Bald | Color Text addTypeConstructorP :: Parser DatabaseContextExpr

@@ -15,7 +15,7 @@ createArbitraryRelationP :: Parser DatabaseContextIOExpr createArbitraryRelationP = do   reserved "createarbitraryrelation"-  relVarName <- identifier+  relVarName <- identifierP   attrExprs <- makeAttributeExprsP :: Parser [AttributeExpr]   min' <- fromInteger <$> integer   _ <- symbol "-"

@@ -20,7 +20,7 @@ importBasicExampleOperatorP :: Parser ImportBasicExampleOperator importBasicExampleOperatorP = do    reservedOp ":importexample"-  example <- identifier+  example <- identifierP   if example == "cjdate" then     pure ImportBasicDateExampleOperator     else

@@ -25,6 +25,6 @@   reserved ":importcsv"   path <- quotedString   spaceConsumer-  relVarName <- identifier+  relVarName <- identifierP   return $ RelVarDataImportOperator relVarName (T.unpack path) importCSVRelation   

@@ -73,7 +73,7 @@ showConstraintsP :: Parser RODatabaseContextOperator showConstraintsP = do   colonOp ":constraints"-  ShowConstraints <$> option "" identifier+  ShowConstraints <$> option "" identifierP    plotRelExprP :: Parser RODatabaseContextOperator   plotRelExprP = do@@ -227,7 +227,7 @@ attrOrdersExprP = reserved "orderby" *> braces (sepBy attrOrderExprP comma)  attrOrderExprP :: Parser DF.AttributeOrderExpr-attrOrderExprP = DF.AttributeOrderExpr <$> identifier <*> orderP+attrOrderExprP = DF.AttributeOrderExpr <$> identifierP <*> orderP  orderP :: Parser DF.Order orderP = try (reservedOp "ascending" >> pure DF.AscendingOrder) <|> try (reservedOp "descending" >> pure DF.DescendingOrder) <|> pure DF.AscendingOrder

@@ -15,6 +15,7 @@ import qualified Data.Map as M import Data.List (sort) import ProjectM36.MiscUtils+import Control.Monad (void)  --used in projection attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)@@ -207,14 +208,16 @@ atomExprP = consumeAtomExprP True  consumeAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)-consumeAtomExprP consume = try functionAtomExprP <|>-            ifThenAtomExprP <|>  -            boolAtomExprP <|> -- we do this before the constructed atom parser to consume True and False -            try (parens (constructedAtomExprP True)) <|>-            constructedAtomExprP consume <|>-            relationalAtomExprP <|>-            attributeAtomExprP <|>-            try nakedAtomExprP+consumeAtomExprP consume =+  try functionAtomExprP <|>+  ifThenAtomExprP <|>  +  boolAtomExprP <|> -- we do this before the constructed atom parser to consume True and False +  try (parens (constructedAtomExprP True)) <|>+  constructedAtomExprP consume <|>+  try subrelationAttributeExprP <|>  +  relationalAtomExprP <|>+  attributeAtomExprP <|>+  try nakedAtomExprP  attributeAtomExprP :: Parser (AtomExprBase a) attributeAtomExprP = do@@ -247,6 +250,26 @@   reserved "else"   IfThenAtomExpr ifE thenE <$> atomExprP ++-- "@relattr.subrelattr"+subrelationAttributeNameP :: Parser (AttributeName, AttributeName)+subrelationAttributeNameP = do+  void $ single '@'+  relAttr <- uncapitalizedOrQuotedIdentifier+  void $ single '.'+  subrelAttr <- uncapitalizedOrQuotedIdentifier+  spaceConsumer+  pure (relAttr, subrelAttr)++subrelationAttributeExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)+subrelationAttributeExprP = do+  void $ single '@'+  relAttr <- uncapitalizedOrQuotedIdentifier+  void $ single '.'+  subrelAttr <- uncapitalizedOrQuotedIdentifier+  spaceConsumer+  pure (SubrelationAttributeAtomExpr relAttr subrelAttr)+ functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a) functionAtomExprP =   FunctionAtomExpr <$> functionNameP <*> parens (sepBy atomExprP comma) <*> parseMarkerP@@ -291,7 +314,7 @@  createMacroP :: RelationalMarkerExpr a => Parser (WithNameExprBase a, RelationalExprBase a) createMacroP = do -  name <- identifier+  name <- identifierP   reservedOp "as"   expr <- relExprP   marker <- parseMarkerP

@@ -19,7 +19,7 @@ setCurrentSchemaP :: Parser SchemaOperator setCurrentSchemaP = do   reserved ":setschema"-  SetCurrentSchema <$> identifier+  SetCurrentSchema <$> identifierP    schemaExprP :: Parser SchemaExpr schemaExprP = addSubschemaP <|>@@ -28,7 +28,7 @@ addSubschemaP :: Parser SchemaExpr addSubschemaP = do   reserved ":addschema"-  AddSubschema <$> identifier <*> parens (sepBy schemaIsomorphP comma)+  AddSubschema <$> identifierP <*> parens (sepBy schemaIsomorphP comma)    schemaIsomorphP :: Parser SchemaIsomorph   schemaIsomorphP = isoRestrictP <|> isoUnionP <|> isoRenameP <|> isoPassthrough

@@ -20,7 +20,7 @@  transactionIdLookupP :: Parser TransactionIdLookup transactionIdLookupP =  (TransactionIdLookup <$> uuidP) <|>-                        (TransactionIdHeadNameLookup <$> identifier <*> many transactionIdHeadBacktrackP)+                        (TransactionIdHeadNameLookup <$> identifierP <*> many transactionIdHeadBacktrackP)                          transactionIdHeadBacktrackP :: Parser TransactionIdHeadBacktrack                         transactionIdHeadBacktrackP = (string "~" *> (TransactionIdHeadParentBacktrack <$> backtrackP)) <|>

@@ -17,12 +17,12 @@ autoMergeToHeadP :: Parser ConvenienceTransactionGraphOperator autoMergeToHeadP = do   reserved ":automergetohead"-  AutoMergeToHead <$> mergeTransactionStrategyP <*> identifier+  AutoMergeToHead <$> mergeTransactionStrategyP <*> identifierP  jumpToHeadP :: Parser TransactionGraphOperator jumpToHeadP = do   reservedOp ":jumphead"-  JumpToHead <$> identifier+  JumpToHead <$> identifierP  jumpToTransactionP :: Parser TransactionGraphOperator jumpToTransactionP = do@@ -37,12 +37,12 @@ branchTransactionP :: Parser TransactionGraphOperator branchTransactionP = do   reservedOp ":branch"-  Branch <$> identifier+  Branch <$> identifierP  deleteBranchP :: Parser TransactionGraphOperator deleteBranchP = do   reserved ":deletebranch"-  DeleteBranch <$> identifier+  DeleteBranch <$> identifierP  commitTransactionP :: Parser TransactionGraphOperator commitTransactionP = do@@ -63,15 +63,15 @@ mergeTransactionStrategyP = (reserved "union" $> UnionMergeStrategy) <|>                             (do                                 reserved "selectedbranch"-                                SelectedBranchMergeStrategy <$> identifier) <|>+                                SelectedBranchMergeStrategy <$> identifierP) <|>                             (do                                 reserved "unionpreferbranch"-                                UnionPreferMergeStrategy <$> identifier)+                                UnionPreferMergeStrategy <$> identifierP)    mergeTransactionsP :: Parser TransactionGraphOperator mergeTransactionsP = do   reservedOp ":mergetrans"-  MergeTransactions <$> mergeTransactionStrategyP <*> identifier <*> identifier+  MergeTransactions <$> mergeTransactionStrategyP <*> identifierP <*> identifierP  validateMerkleHashesP :: Parser ROTransactionGraphOperator validateMerkleHashesP = reservedOp ":validatemerklehashes" $> ValidateMerkleHashes

@@ -13,20 +13,25 @@   parseMarkerP = pure ()  typeConstructorNameP :: Parser TypeConstructorName-typeConstructorNameP = capitalizedIdentifier+typeConstructorNameP = capitalizedIdentifier <* spaceConsumer  dataConstructorNameP :: Parser DataConstructorName dataConstructorNameP = try $ do-  ident <- capitalizedIdentifier+  ident <- capitalizedIdentifier <* spaceConsumer   when (ident `elem` ["True", "False"]) $ failure Nothing mempty --don't parse True or False as ConstructedAtoms (use NakedAtoms instead)   pure ident  attributeNameP :: Parser AttributeName-attributeNameP = try uncapitalizedIdentifier <|> quotedIdentifier+attributeNameP = uncapitalizedOrQuotedIdentifier <* spaceConsumer  functionNameP :: Parser FunctionName-functionNameP = try uncapitalizedIdentifier <|> quotedIdentifier+functionNameP = uncapitalizedOrQuotedIdentifier <* spaceConsumer +-- does not consumer following spaces+uncapitalizedOrQuotedIdentifier :: Parser StringType+uncapitalizedOrQuotedIdentifier =+  try uncapitalizedIdentifier <|> quotedIdentifier+ -- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments. -- data *Either a b* = Left a | Right b typeConstructorDefP :: Parser TypeConstructorDef@@ -58,10 +63,10 @@ attributeAndTypeNameP = AttributeAndTypeNameExpr <$> attributeNameP <*> typeConstructorP <*> parseMarkerP  typeIdentifierP :: Parser TypeConstructorName-typeIdentifierP = capitalizedIdentifier+typeIdentifierP = capitalizedIdentifier <* spaceConsumer  typeVariableIdentifierP :: Parser TypeVarName-typeVariableIdentifierP = uncapitalizedIdentifier+typeVariableIdentifierP = uncapitalizedIdentifier <* spaceConsumer                              -- *Either Int Text*, *Int* typeConstructorP :: Parser TypeConstructor                  @@ -75,4 +80,4 @@                      relVarNameP :: Parser RelVarName-relVarNameP = try uncapitalizedIdentifier <|> quotedIdentifier+relVarNameP = uncapitalizedOrQuotedIdentifier <* spaceConsumer

@@ -40,10 +40,12 @@   pretty (UUIDAtom u) = pretty u   pretty (RelationAtom x) = pretty x   pretty (RelationalExprAtom re) = pretty re+  pretty (SubrelationFoldAtom _rel _subAttr) = "SubrelationFoldAtom" -- this is only used as an argument to aggregate functions, so users should never be able to construct it directly   pretty (ConstructedAtom n _ as) = pretty n <+> prettyList as  instance Pretty AtomExpr where-  pretty (AttributeAtomExpr attrName) = prettyAttributeName ("@" <> attrName)+  pretty (AttributeAtomExpr attrName) = "@" <> prettyAttributeName attrName+  pretty (SubrelationAttributeAtomExpr relAttr subAttr) = "@" <> prettyAttributeName relAttr <> "." <> prettyAttributeName subAttr   pretty (NakedAtomExpr atom)         = pretty atom   pretty (FunctionAtomExpr atomFuncName' atomExprs _) = pretty atomFuncName' <> prettyAtomExprsAsArguments atomExprs   pretty (RelationAtomExpr relExpr) = pretty relExpr@@ -154,6 +156,7 @@   pretty BoolAtomType = "Bool"   pretty UUIDAtomType = "UUID"   pretty (RelationAtomType attrs) = "relation " <+> prettyBracesList (A.toList attrs)+  pretty (SubrelationFoldAtomType typ) = "SubRelationFoldAtomType" <+> pretty typ   pretty (ConstructedAtomType tcName tvMap) = pretty tcName <+> hsep (map pretty (M.toList tvMap)) --order matters   pretty RelationalExprAtomType = "RelationalExpr"   pretty (TypeVariableType x) = pretty x

@@ -3,6 +3,7 @@  module ProjectM36.Arbitrary where import ProjectM36.Base+import qualified ProjectM36.Attribute as A import ProjectM36.Error import ProjectM36.AtomFunctionError import ProjectM36.AtomType@@ -28,11 +29,20 @@   Right . ScientificAtom <$> lift (arbitrary :: Gen Scientific)  arbitrary' (RelationAtomType attrs)  = do-  tcMap <-ask+  tcMap <- ask   maybeRel <- lift $ runReaderT (arbitraryRelation attrs (0,5)) tcMap   case maybeRel of     Left err -> pure $ Left err     Right rel -> pure $ Right $ RelationAtom rel++arbitrary' (SubrelationFoldAtomType typ) = do+  tcMap <- ask+  maybeRel <- lift $ runReaderT (arbitraryRelation (A.attributesFromList [Attribute "a" typ]) (0,5)) tcMap+  case maybeRel of+    Left err -> pure $ Left err+    Right rel -> do+      anAttr <- lift $ elements (A.attributeNamesList (attributes rel))+      pure (Right (SubrelationFoldAtom rel anAttr))  arbitrary' IntAtomType =    Right . IntAtom <$> lift (arbitrary :: Gen Int)

@@ -23,7 +23,7 @@ atomToText (BoolAtom i) = (T.pack . show) i atomToText (UUIDAtom u) = (T.pack . show) u atomToText (RelationalExprAtom re) = (T.pack . show) re-+atomToText (SubrelationFoldAtom rel attrName) = (T.pack . show) rel <> " @" <> attrName atomToText (RelationAtom i) = (T.pack . show) i atomToText (ConstructedAtom dConsName typ atoms)    | isIntervalAtomType typ = case atoms of --special handling for printing intervals

@@ -13,7 +13,9 @@  foldAtomFuncType :: AtomType -> AtomType -> [AtomType] --the underscore in the attribute name means that any attributes are acceptable-foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]+foldAtomFuncType foldType returnType =+  [SubrelationFoldAtomType foldType,+   returnType]  atomFunctionForName :: FunctionName -> AtomFunctions -> Either RelationalError AtomFunction atomFunctionForName funcName' funcSet = if HS.null foundFunc then

@@ -9,11 +9,13 @@                          AtomFunctionParseError String |                          InvalidIntervalOrderingError |                          InvalidIntervalBoundariesError |+                         AtomFunctionAttributeNameNotFoundError Text |                          InvalidIntBoundError |                          InvalidUUIDString Text |+                         RelationAtomExpectedError Text |                          AtomFunctionEmptyRelationError |                          AtomTypeDoesNotSupportOrderingError Text |                          AtomTypeDoesNotSupportIntervalError Text |                          AtomFunctionBytesDecodingError String-                       deriving(Generic, Eq, Show, NFData)+                       deriving (Generic, Eq, Show, NFData) 

@@ -4,8 +4,8 @@ import ProjectM36.Tuple import ProjectM36.AtomFunctionError import ProjectM36.AtomFunction+import ProjectM36.AtomType import qualified Data.HashSet as HS-import qualified Data.Vector as V import Control.Monad import qualified Data.UUID as U import qualified Data.Text as T@@ -35,23 +35,24 @@                                )},     Function { funcName = "sum",                funcType = foldAtomFuncType IntegerAtomType IntegerAtomType,-               funcBody = body $ relationAtomFunc relationSum+               funcBody = body $ relationFoldFunc relationSum              },     Function { funcName = "count",-               funcType = foldAtomFuncType (TypeVariableType "a") IntegerAtomType,+               funcType = [anyRelationAtomType,+                           IntegerAtomType],                funcBody = body $ relationAtomFunc relationCount              },     Function { funcName = "max",                funcType = foldAtomFuncType IntegerAtomType IntegerAtomType,-               funcBody = body $ relationAtomFunc relationMax +               funcBody = body $ relationFoldFunc relationMax               },     Function { funcName = "min",                funcType = foldAtomFuncType IntegerAtomType IntegerAtomType,-               funcBody = body $ relationAtomFunc relationMin+               funcBody = body $ relationFoldFunc relationMin              },     Function { funcName = "mean",                funcType = foldAtomFuncType IntegerAtomType IntegerAtomType,-               funcBody = body $ relationAtomFunc relationMean+               funcBody = body $ relationFoldFunc relationMean              },     Function { funcName = "eq",                funcType = [TypeVariableType "a", TypeVariableType "a", BoolAtomType],@@ -117,13 +118,21 @@                  [BoolAtom b1, BoolAtom b2] ->                    Right $ BoolAtom (b1 || b2)                  _ -> Left AtomFunctionTypeMismatchError                   +             },+    Function { funcName = "increment",+               funcType = [IntegerAtomType, IntegerAtomType],+               funcBody = body $ \case+                 [IntegerAtom i] -> pure (IntegerAtom (i+1))+                 _ -> Left AtomFunctionTypeMismatchError              }        ] <> scientificAtomFunctions   where     body = FunctionBuiltInBody-    relationAtomFunc f [RelationAtom x] = f x+    relationAtomFunc f [RelationAtom rel] = f rel     relationAtomFunc _ _ = Left AtomFunctionTypeMismatchError+    relationFoldFunc f [SubrelationFoldAtom rel subAttr] = f rel subAttr+    relationFoldFunc _ _ = Left AtomFunctionTypeMismatchError                           integerAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom integerAtomFuncLessThan equality (IntegerAtom i1:IntegerAtom i2:_) = pure (BoolAtom (i1 `op` i2))@@ -136,35 +145,48 @@ boolAtomNot _ = error "boolAtomNot called on non-Bool atom"  --used by sum atom function-relationSum :: Relation -> Either AtomFunctionError Atom-relationSum relIn = pure (IntegerAtom (relFold (\tupIn acc -> acc + newVal tupIn) 0 relIn))+relationSum :: Relation -> AttributeName -> Either AtomFunctionError Atom+relationSum relIn subAttr = pure (IntegerAtom (relFold (\tupIn acc -> acc + newVal tupIn) 0 relIn))   where     --extract Integer from Atom-    newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)+    newVal tupIn =+      case atomForAttributeName subAttr tupIn of+        Left err -> error (show err)+        Right atom -> castInteger atom      relationCount :: Relation -> Either AtomFunctionError Atom relationCount relIn = pure (IntegerAtom (relFold (\_ acc -> acc + 1) (0::Integer) relIn)) -relationMax :: Relation -> Either AtomFunctionError Atom-relationMax relIn = case oneTuple relIn of+relationMax :: Relation -> AttributeName -> Either AtomFunctionError Atom+relationMax relIn subAttr = case oneTuple relIn of     Nothing -> Left AtomFunctionEmptyRelationError     Just oneTup -> pure (IntegerAtom (relFold (\tupIn acc -> max acc (newVal tupIn)) (newVal oneTup) relIn))   where-    newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)+    newVal tupIn =+      case atomForAttributeName subAttr tupIn of+        Left err -> error (show err)+        Right atom -> castInteger atom -relationMin :: Relation -> Either AtomFunctionError Atom-relationMin relIn = case oneTuple relIn of +relationMin :: Relation -> AttributeName -> Either AtomFunctionError Atom+relationMin relIn subAttr = case oneTuple relIn of    Nothing -> Left AtomFunctionEmptyRelationError   Just oneTup -> pure (IntegerAtom (relFold (\tupIn acc -> min acc (newVal tupIn)) (newVal oneTup) relIn))   where-    newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)+    newVal tupIn =+      case atomForAttributeName subAttr tupIn of+        Left err -> error (show err)+        Right atom -> castInteger atom -relationMean :: Relation -> Either AtomFunctionError Atom-relationMean relIn = case oneTuple relIn of++relationMean :: Relation -> AttributeName -> Either AtomFunctionError Atom+relationMean relIn subAttr = case oneTuple relIn of   Nothing -> Left AtomFunctionEmptyRelationError   Just _oneTup -> do     let (sum'', count') = relFold (\tupIn (sum', count) -> (sum' + newVal tupIn, count + 1)) (0, 0) relIn-        newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)+        newVal tupIn =+          case atomForAttributeName subAttr tupIn of+            Left err -> error (show err)+            Right atom -> castInteger atom     pure (IntegerAtom (sum'' `div` count'))      @@ -174,7 +196,7 @@  castInteger :: Atom -> Integer castInteger (IntegerAtom i) = i -castInteger _ = error "attempted to cast non-IntegerAtom to Int"+castInteger _ = error "attempted to cast non-IntegerAtom to Integer"   scientificAtomFunctions :: AtomFunctions

@@ -358,6 +358,9 @@                                else                                  atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip (attributesVec attrs1) (attributesVec attrs2))   return x+atomTypeVerify (SubrelationFoldAtomType typ1) (SubrelationFoldAtomType typ2) = do+  resTyp <- atomTypeVerify typ1 typ2+  pure (SubrelationFoldAtomType resTyp) atomTypeVerify x y = if x == y then                        Right x                      else@@ -448,6 +451,7 @@     RelationalExprAtomType -> True     RelationAtomType attrs -> isResolvedAttributes attrs     ConstructedAtomType _ tvMap -> all isResolvedType (M.elems tvMap)+    SubrelationFoldAtomType typ' -> isResolvedType typ'     TypeVariableType _ -> False  isResolvedAttributes :: Attributes -> Bool@@ -456,4 +460,5 @@ isResolvedAttribute :: Attribute -> Bool isResolvedAttribute = isResolvedType . A.atomType ---given two AtomTypes x,y+anyRelationAtomType :: AtomType+anyRelationAtomType = RelationAtomType (A.attributesFromList [Attribute "_" (TypeVariableType "a")])

@@ -256,6 +256,8 @@   = RelationAtomTypeConstructor $ map attrToAttrExpr $ V.toList (attributesVec attrs)   where     attrToAttrExpr (Attribute n t) = AttributeAndTypeNameExpr n (typeToTypeConstructor t) ()+typeToTypeConstructor (SubrelationFoldAtomType _typ) =+  error "typeToTypeConstructor for SubrelationFoldAtomType is nonsense" typeToTypeConstructor (ConstructedAtomType tcName tvMap)   = ADTypeConstructor tcName $ map typeToTypeConstructor (M.elems tvMap) typeToTypeConstructor (TypeVariableType tvName) = TypeVariable tvName

@@ -67,6 +67,7 @@             UUIDAtom !UUID |             RelationAtom !Relation |             RelationalExprAtom !RelationalExpr | --used for returning inc deps+            SubrelationFoldAtom !Relation !AttributeName |             ConstructedAtom !DataConstructorName !AtomType [Atom]             deriving (Eq, Show, Typeable, NFData, Generic, Read)                      @@ -85,6 +86,7 @@   hashWithSalt salt (UUIDAtom u) = salt `hashWithSalt` u   hashWithSalt salt (RelationAtom r) = salt `hashWithSalt` r   hashWithSalt salt (RelationalExprAtom re) = salt `hashWithSalt` re+  hashWithSalt salt (SubrelationFoldAtom rel attrName) = salt `hashWithSalt` rel `hashWithSalt` attrName  -- I suspect the definition of ConstructedAtomType with its name alone is insufficient to disambiguate the cases; for example, one could create a type named X, remove a type named X, and re-add it using different constructors. However, as long as requests are served from only one DatabaseContext at-a-time, the type name is unambiguous. This will become a problem for time-travel, however. -- | The AtomType uniquely identifies the type of a atom.@@ -99,6 +101,7 @@                 BoolAtomType |                 UUIDAtomType |                 RelationAtomType Attributes |+                SubrelationFoldAtomType AtomType |                 ConstructedAtomType TypeConstructorName TypeVarMap |                 RelationalExprAtomType |                 TypeVariableType TypeVarName@@ -233,9 +236,9 @@   --relational variables should also be able to be explicitly-typed like in Haskell   --- | Reference a relation variable by its name.   RelationVariable RelVarName a |   -  --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)+  -- | Extract a relation from an `Atom` that is a nested relation (a relation within a relation).     RelationValuedAttribute AttributeName |-  -- | Extract a relation from an `Atom` that is a nested relation (a relation within a relation).+  --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)     Project (AttributeNamesBase a) (RelationalExprBase a) |   --- | Create a union of two relational expressions. The expressions should have identical attributes.   Union (RelationalExprBase a) (RelationalExprBase a) |@@ -504,10 +507,14 @@  type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker +type AggAtomFuncExprInfo = (AttributeName, AttributeName) -- (relvar attribute name, subrel attribute name)+ -- | 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 |+data AtomExprBase a = AttributeAtomExpr AttributeName |+                      SubrelationAttributeAtomExpr AttributeName AttributeName |                       NakedAtomExpr !Atom |-                      FunctionAtomExpr FunctionName [AtomExprBase a] a |+                      FunctionAtomExpr !FunctionName [AtomExprBase a] a |+                      -- as a simple, first aggregation case, we can only apply an aggregation to a RelationAtom while "selecting" one attribute                       RelationAtomExpr (RelationalExprBase a) |                       IfThenAtomExpr (AtomExprBase a) (AtomExprBase a) (AtomExprBase a) | -- if, then, else                       ConstructedAtomExpr DataConstructorName [AtomExprBase a] a@@ -653,6 +660,7 @@   BoolAtomType -> S.empty   UUIDAtomType -> S.empty   RelationalExprAtomType -> S.empty+  SubrelationFoldAtomType{} -> S.empty   (RelationAtomType attrs) -> S.unions (map attrTypeVars (V.toList (attributesVec attrs)))   (ConstructedAtomType _ tvMap) -> M.keysSet tvMap   (TypeVariableType nam) -> S.singleton nam@@ -679,6 +687,7 @@ atomTypeVars BoolAtomType = S.empty atomTypeVars UUIDAtomType = S.empty atomTypeVars RelationalExprAtomType = S.empty+atomTypeVars SubrelationFoldAtomType{} = S.empty atomTypeVars (RelationAtomType attrs) = S.unions (map attrTypeVars (V.toList (attributesVec attrs))) atomTypeVars (ConstructedAtomType _ tvMap) = M.keysSet tvMap atomTypeVars (TypeVariableType nam) = S.singleton nam

@@ -40,6 +40,7 @@   RelationAtomType _ -> False   ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this   RelationalExprAtomType -> False+  SubrelationFoldAtomType{} -> False   TypeVariableType _ -> False    supportsOrdering :: AtomType -> Bool  @@ -56,6 +57,7 @@   UUIDAtomType -> False   RelationAtomType _ -> False   RelationalExprAtomType -> False+  SubrelationFoldAtomType{} -> False   ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this   TypeVariableType _ -> False   

@@ -51,3 +51,4 @@ atomTypeForAtom (RelationAtom (Relation attrs _)) = RelationAtomType attrs atomTypeForAtom (ConstructedAtom _ aType _) = aType atomTypeForAtom (RelationalExprAtom _) = RelationalExprAtomType+atomTypeForAtom (SubrelationFoldAtom _ _) = SubrelationFoldAtomType (TypeVariableType "a")

@@ -4,7 +4,6 @@ import qualified Data.Map as M import qualified Data.HashSet as HS import ProjectM36.DataTypes.Primitive-import qualified Data.Vector as V import ProjectM36.AtomFunction import ProjectM36.Tuple import ProjectM36.Relation@@ -264,7 +263,7 @@ sqlSum = sqlIntegerAgg (+)  sqlIntegerAgg :: (Integer -> Integer -> Integer) -> [Atom] -> Either AtomFunctionError Atom-sqlIntegerAgg op [RelationAtom relIn] =+sqlIntegerAgg op [SubrelationFoldAtom relIn subAttr] =   case oneTuple relIn of     Nothing -> pure $ nullAtom IntegerAtomType Nothing -- SQL max/min of empty table is NULL     Just oneTup ->@@ -273,7 +272,10 @@         else         pure $ relFold (\tupIn acc -> nullMax acc (newVal tupIn)) (newVal oneTup) relIn  where-   newVal tupIn = tupleAtoms tupIn V.! 0+   newVal tupIn =+      case atomForAttributeName subAttr tupIn of+        Left err -> error (show err)+        Right atom -> atom    nullMax acc nextVal =      let mNextVal = sqlNullableIntegerToMaybe nextVal          mOldVal = sqlNullableIntegerToMaybe acc

@@ -30,6 +30,8 @@   UUIDAtomType -> False   RelationalExprAtomType -> False   RelationAtomType _ -> False+  SubrelationFoldAtomType{} -> False   ConstructedAtomType _ _ -> False   TypeVariableType _ -> False+     

@@ -50,6 +50,7 @@       UUIDAtom u -> up ("UUIDAtom" <> BL.toStrict (UUID.toByteString u))       RelationAtom r -> hashBytesL ctx "RelationAtom" [SHash r]       RelationalExprAtom e -> hashBytesL ctx "RelationalExprAtom" [SHash e]+      SubrelationFoldAtom rel subAttr -> hashBytesL ctx "SubrelationFoldAtom" [SHash rel, SHash subAttr]       ConstructedAtom d typ args ->           hashBytesL ctx "ConstructedAtom" ([SHash d, SHash typ] <> map SHash args)       where@@ -138,6 +139,7 @@   hashBytes atomExpr ctx =     case atomExpr of       (AttributeAtomExpr a) -> hashBytesL ctx "AttributeAtomExpr" [SHash a]+      (SubrelationAttributeAtomExpr relAttr subAttr) -> hashBytesL ctx "SubrelationAttributeAtomExpr" [SHash relAttr, SHash subAttr]       (NakedAtomExpr a) -> hashBytesL ctx "NakedAtomExpr" [SHash a]       (FunctionAtomExpr fname args marker) ->         hashBytesL ctx "FunctionAtomExpr" $ [SHash fname, SHash marker] <> map SHash args@@ -165,6 +167,7 @@       RelationAtomType attrs -> hashBytesL ctx "RelationAtomType" (V.map SHash (attributesVec attrs))       ConstructedAtomType tConsName tvarMap -> hashBytesL ctx "ConstructedAtomType" (SHash tConsName : map SHash (M.toAscList tvarMap))       RelationalExprAtomType -> hashb "RelationalExprAtomType"+      SubrelationFoldAtomType typ' -> hashBytesL ctx "SubrelationFoldAtomType" [SHash typ']       TypeVariableType tvn -> hashBytesL ctx "TypeVariableType" [SHash tvn]     where       hashb = SHA256.update ctx

@@ -112,6 +112,7 @@  processAtomExpr :: AtomExpr -> ProcessExprM GraphRefAtomExpr processAtomExpr (AttributeAtomExpr nam) = pure $ AttributeAtomExpr nam+processAtomExpr (SubrelationAttributeAtomExpr relAttr subAttr) = pure (SubrelationAttributeAtomExpr relAttr subAttr) processAtomExpr (NakedAtomExpr atom) = pure $ NakedAtomExpr atom processAtomExpr (FunctionAtomExpr fName atomExprs ()) =   FunctionAtomExpr fName <$> mapM processAtomExpr atomExprs  <*> askMarker

@@ -96,6 +96,7 @@     case expr of       AttributeAtomExpr{} -> mempty       NakedAtomExpr{} -> mempty+      SubrelationAttributeAtomExpr{} -> mempty       FunctionAtomExpr _ args marker ->         S.unions (referencedTransactionIds marker : (referencedTransactionIds <$> args))       RelationAtomExpr rExpr ->

@@ -134,7 +134,10 @@             case lefts atomArgs of               [] -> pure (Right (ConstructedAtom dConsName typ (rights atomArgs)))               errs -> pure (Left (someErrors errs))-parseCSVAtomP attrName _ (RelationAtomType _) _ = pure (Left (RelationValuedAttributesNotSupportedError [attrName]))+parseCSVAtomP attrName _ (RelationAtomType _) _ =+  pure (Left (RelationValuedAttributesNotSupportedError [attrName]))+parseCSVAtomP attrName _ (SubrelationFoldAtomType _) _ =+  pure (Left (RelationValuedAttributesNotSupportedError [attrName])) parseCSVAtomP _ _ (TypeVariableType x) _ = pure (Left (TypeConstructorTypeVarMissing x))        capitalizedIdentifier :: APT.Parser T.Text

@@ -51,8 +51,6 @@ import GHC.Paths #endif ---import Debug.Trace- data DatabaseContextExprDetails = CountUpdatedTuples  databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc@@ -855,18 +853,22 @@                Right (tupleAtomExtend newAttrName atom tup)                ) +  + evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom evalGraphRefAtomExpr tupIn (AttributeAtomExpr attrName) =   case atomForAttributeName attrName tupIn of-    Right atom -> pure atom-    Left err@(NoSuchAttributeNamesError _) -> do-      env <- askEnv-      case gre_extra env of-        Nothing -> throwError err-        Just (Left ctxtup) -> lift $ except $ atomForAttributeName attrName ctxtup-        Just (Right _) -> throwError err-    Left err -> throwError err+      Right atom -> pure atom+      Left err@(NoSuchAttributeNamesError _) -> do+        env <- askEnv+        case gre_extra env of+          Nothing -> throwError err+          Just (Left ctxtup) -> lift $ except $ atomForAttributeName attrName ctxtup+          Just (Right _) -> throwError err+      Left err -> throwError err+   evalGraphRefAtomExpr _ (NakedAtomExpr atom) = pure atom+-- first argumentr is starting value, second argument is relationatom evalGraphRefAtomExpr tupIn (FunctionAtomExpr funcName' arguments tid) = do   argTypes <- mapM (typeForGraphRefAtomExpr (tupleAttributes tupIn)) arguments   context <- gfDatabaseContextForMarker tid@@ -895,6 +897,12 @@   let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn env   relAtom <- lift $ except $ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)   pure (RelationAtom relAtom)+evalGraphRefAtomExpr tupIn (SubrelationAttributeAtomExpr relAttr subAttr) = do+  atom <- evalGraphRefAtomExpr tupIn (AttributeAtomExpr relAttr)+  case atom of+    RelationAtom rel ->+      pure (SubrelationFoldAtom rel subAttr)+    _ -> throwError (AttributeIsNotRelationValuedError relAttr) evalGraphRefAtomExpr tupIn (IfThenAtomExpr ifExpr thenExpr elseExpr) = do   conditional <- evalGraphRefAtomExpr tupIn ifExpr   case conditional of@@ -909,7 +917,7 @@   aType <- local mergeEnv (typeForGraphRefAtomExpr (tupleAttributes tupIn) cons)   argAtoms <- local mergeEnv $     mapM (evalGraphRefAtomExpr tupIn) dConsArgs-  pure (ConstructedAtom dConsName aType argAtoms)+  pure (ConstructedAtom dConsName aType argAtoms)   typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do@@ -923,10 +931,17 @@         Right attr -> pure (A.atomType attr)         Left _ -> case atomForAttributeName attrName envTup of           Right atom -> pure (atomTypeForAtom atom)-          Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)+          Left _ ->              throwError err     Left err -> throwError err-+typeForGraphRefAtomExpr attrs (SubrelationAttributeAtomExpr relAttr subAttr) = do+  relType <- typeForGraphRefAtomExpr attrs (AttributeAtomExpr relAttr)+  case relType of+    RelationAtomType relAttrs -> +      case A.atomTypeForAttributeName subAttr relAttrs of+        Left err -> throwError err+        Right attrType -> pure (SubrelationFoldAtomType attrType)+    _ -> throwError (AttributeIsNotRelationValuedError relAttr) typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom) typeForGraphRefAtomExpr attrs (FunctionAtomExpr funcName' atomArgs transId) = do   funcs <- atomFunctions <$> gfDatabaseContextForMarker transId@@ -941,7 +956,8 @@       argTypes <- mapM (typeForGraphRefAtomExpr attrs) atomArgs       mapM_ (\(fArg,arg,argCount) -> do                 let handler :: RelationalError -> GraphRefRelationalExprM AtomType-                    handler (AtomTypeMismatchError expSubType actSubType) = throwError (AtomFunctionTypeError funcName' argCount expSubType actSubType)+                    handler (AtomTypeMismatchError expSubType actSubType) = do+                      throwError (AtomFunctionTypeError funcName' argCount expSubType actSubType)                     handler err = throwError err                 lift (except $ atomTypeVerify fArg arg) `catchError` handler             ) (zip3 funcArgTypes argTypes [1..])@@ -989,6 +1005,11 @@  verifyGraphRefAtomExprTypes _ (NakedAtomExpr atom) expectedType =   lift $ except $ atomTypeVerify expectedType (atomTypeForAtom atom)+verifyGraphRefAtomExprTypes relIn (SubrelationAttributeAtomExpr relAttr subAttr) expectedType = do+    let mergedAttrsEnv = mergeAttributesIntoGraphRefRelationalExprEnv (attributes relIn)+    (Relation relAttrs _) <- R.local mergedAttrsEnv (typeForGraphRefRelationalExpr (RelationValuedAttribute relAttr))+    subAttrType <- lift $ except $ A.atomTypeForAttributeName subAttr relAttrs+    lift $ except $ atomTypeVerify expectedType (SubrelationFoldAtomType subAttrType) verifyGraphRefAtomExprTypes relIn (FunctionAtomExpr funcName' funcArgExprs tid) expectedType = do   context <- gfDatabaseContextForMarker tid   let functions = atomFunctions context@@ -996,7 +1017,8 @@   let expectedArgTypes = funcType func       funcArgVerifier (atomExpr, expectedType2, argCount) = do         let handler :: RelationalError -> GraphRefRelationalExprM AtomType-            handler (AtomTypeMismatchError expSubType actSubType) = throwError (AtomFunctionTypeError funcName' argCount expSubType actSubType)+            handler (AtomTypeMismatchError expSubType actSubType) = do+              throwError (AtomFunctionTypeError funcName' argCount expSubType actSubType)             handler err = throwError err         verifyGraphRefAtomExprTypes relIn atomExpr expectedType2 `catchError` handler      funcArgTypes <- mapM funcArgVerifier $ zip3 funcArgExprs expectedArgTypes [1..]@@ -1237,7 +1259,6 @@           case typ of             RelationAtomType relAttrs -> pure $ emptyRelationWithAttrs relAttrs             other -> throwError (AtomTypeMismatchError (RelationAtomType A.emptyAttributes) other)-         typeForGraphRefRelationalExpr (Project attrNames expr) = do   exprType' <- typeForGraphRefRelationalExpr expr   projectionAttrs <- evalGraphRefAttributeNames attrNames expr@@ -1462,6 +1483,7 @@  instance ResolveGraphRefTransactionMarker GraphRefAtomExpr where   resolve orig@AttributeAtomExpr{} = pure orig+  resolve orig@SubrelationAttributeAtomExpr{} = pure orig   resolve orig@NakedAtomExpr{} = pure orig   resolve (FunctionAtomExpr nam atomExprs marker) =     FunctionAtomExpr nam <$> mapM resolve atomExprs <*> pure marker

@@ -555,7 +555,7 @@                               (S.fromList (map fst (nonAggregates groupInfo)))) "_sql_aggregate"               else                 pure id-    let coalesceBoolF expr = FunctionAtomExpr "sql_coalesce_bool" [expr] ()                +    let coalesceBoolF expr = func "sql_coalesce_bool" [expr]     fGroupHavingExtend <-        case havingRestriction groupInfo of         Nothing -> pure id@@ -632,11 +632,14 @@                                  limit = limitClause tExpr }     pure (dfExpr, columnMap) +func :: FunctionName -> [AtomExpr] -> AtomExpr+func fname args = FunctionAtomExpr fname args ()+ convertWhereClause :: TypeForRelExprF -> RestrictionExpr -> ConvertM RestrictionPredicateExpr convertWhereClause typeF (RestrictionExpr rexpr) = do     let wrongType t = throwSQLE $ TypeMismatchError t BoolAtomType --must be boolean expression-        coalesceBoolF expr = FunctionAtomExpr "sql_coalesce_bool" [expr] ()-        sqlEq l = FunctionAtomExpr "sql_equals" l ()+        coalesceBoolF expr = func "sql_coalesce_bool" [expr]+        sqlEq = func "sql_equals"     case rexpr of       IntegerLiteral{} -> wrongType IntegerAtomType       DoubleLiteral{} -> wrongType DoubleAtomType@@ -650,7 +653,7 @@       BinaryOperator (Identifier colName) (OperatorName ["="]) exprMatch -> do --we don't know here if this results in a boolean expression, so we pass it down         attrName <- attributeNameForColumnName colName         expr' <- convertScalarExpr typeF exprMatch-        pure (AtomExprPredicate (coalesceBoolF (FunctionAtomExpr "sql_equals" [AttributeAtomExpr attrName, expr'] ())))+        pure (AtomExprPredicate (coalesceBoolF (func "sql_equals" [AttributeAtomExpr attrName, expr'])))       BinaryOperator exprA op exprB -> do         a <- convertScalarExpr typeF exprA         b <- convertScalarExpr typeF exprB@@ -658,7 +661,7 @@         pure (AtomExprPredicate (coalesceBoolF (f [a,b])))       PostfixOperator expr (OperatorName ops) -> do         expr' <- convertScalarExpr typeF expr-        let isnull = AtomExprPredicate (coalesceBoolF (FunctionAtomExpr "sql_isnull" [expr'] ()))+        let isnull = AtomExprPredicate (coalesceBoolF (func "sql_isnull" [expr']))         case ops of           ["is", "null"] ->              pure isnull@@ -673,7 +676,7 @@            let predExpr' = sqlEq [eqExpr, firstItem]                folder predExpr'' sexprItem = do                  item <- convertScalarExpr typeF sexprItem-                 pure $ FunctionAtomExpr "sql_or" [sqlEq [eqExpr,item], predExpr''] ()+                 pure $ func "sql_or" [sqlEq [eqExpr,item], predExpr'']            res <- AtomExprPredicate . coalesceBoolF <$> foldM folder predExpr' matches             case inOrNotIn of              In -> pure res@@ -708,9 +711,9 @@         f <- lookupOperator False op         pure $ f [a,b]       FunctionApplication funcName' fargs -> do-        func <- lookupFunc funcName'+        func' <- lookupFunc funcName'         fargs' <- mapM (convertScalarExpr typeF) fargs-        pure (func fargs')+        pure (func' fargs')       other -> throwSQLE $ NotSupportedError ("scalar expr: " <> T.pack (show other))  -- SQL conflates projection and extension so we use the SQL context name here@@ -736,19 +739,19 @@         f <- lookupOperator False op         pure $ f [a,b]       FunctionApplication fname fargs -> do-        func <- lookupFunc fname+        func' <- lookupFunc fname         -- as a special case, count(*) is valid, if non-sensical SQL, so handle it here         fargs' <- if fname == FuncName ["count"] && fargs == [Identifier (ColumnProjectionName [Asterisk])] then                    pure [AttributeAtomExpr "_sql_aggregate"]                  else                     mapM (convertProjectionScalarExpr typeF) fargs-        pure (func fargs')+        pure (func' fargs')       PrefixOperator op sexpr -> do-        func <- lookupOperator True op+        func' <- lookupOperator True op         arg <- convertProjectionScalarExpr typeF sexpr-        pure (func [arg])+        pure (func' [arg])       CaseExpr conditionals mElse -> do-        let coalesceBoolF expr' = FunctionAtomExpr "sql_coalesce_bool" [expr'] ()+        let coalesceBoolF expr' = func "sql_coalesce_bool" [expr']         conditionals' <- mapM (\(ifExpr, thenExpr) -> do                                   ifE <- coalesceBoolF <$> convertProjectionScalarExpr typeF ifExpr                                   thenE <- convertProjectionScalarExpr typeF thenExpr@@ -932,7 +935,7 @@                     else                     new_name                 joinName = firstAvailableName (1::Int) allAttrs-                extender = AttributeExtendTupleExpr joinName (FunctionAtomExpr "sql_coalesce_bool" [joinRe] ())+                extender = AttributeExtendTupleExpr joinName (func "sql_coalesce_bool" [joinRe])                 --joinMatchRestriction = Restrict (AttributeEqualityPredicate joinName (ConstructedAtomExpr "True" [] ()))                 joinMatchRestriction = Restrict (AttributeEqualityPredicate joinName (NakedAtomExpr (BoolAtom True)))                 projectAwayJoinMatch = Project (InvertedAttributeNames (S.fromList [joinName]))@@ -942,7 +945,7 @@ lookupOperator :: Bool -> OperatorName -> ConvertM ([AtomExpr] -> AtomExpr) lookupOperator isPrefix op@(OperatorName nam)   | isPrefix = do-      let f n args = FunctionAtomExpr n args ()+      let f = func       case nam of         ["-"] -> pure $ f "sql_negate"         _ -> throwSQLE $ NoSuchSQLOperatorError op@@ -960,7 +963,7 @@         Just match -> pure match     other -> throwSQLE $ NotSupportedError ("function name: " <> T.pack (show other))   where-    f n args = FunctionAtomExpr n args ()+    f = func     aggMapper (FuncName [nam], nam') = (nam, f nam')     aggMapper (FuncName other,_) = error ("unexpected multi-component SQL aggregate function: " <> show other)     sqlFuncs = [(">",f "sql_gt"),@@ -974,7 +977,7 @@                  ("and", f "sql_and"),                  ("or", f "sql_or"),                  ("abs", f "sql_abs")-               ] <> map aggMapper aggregateFunctions+               ] <> map aggMapper aggregateFunctionsMap   -- | Used in join condition detection necessary for renames to enable natural joins.@@ -1082,6 +1085,7 @@       case expr of         x@AttributeAtomExpr{} -> x --potential rename         x@NakedAtomExpr{} -> x+        x@SubrelationAttributeAtomExpr{} -> x          FunctionAtomExpr fname args () -> FunctionAtomExpr fname (pushAtom <$> args) ()         RelationAtomExpr e -> RelationAtomExpr (push e)         IfThenAtomExpr ifE thenE elseE -> IfThenAtomExpr (pushAtom ifE) (pushAtom thenE) (pushAtom elseE)@@ -1300,7 +1304,7 @@   where     incDep = inclusionDependencyForKey (AttributeNames (S.singleton attrName)) (Restrict notNull (RelationVariable rvname ()))     incDepName = rvname <> "_" <> attrName <> "_unique"-    notNull = NotPredicate (AtomExprPredicate (FunctionAtomExpr "sql_isnull" [AttributeAtomExpr attrName] ()))+    notNull = NotPredicate (AtomExprPredicate (func "sql_isnull" [AttributeAtomExpr attrName] ))                                     {-@@ -1389,14 +1393,14 @@ emptyGroupByInfo :: GroupByInfo emptyGroupByInfo = GroupByInfo { aggregates = [], nonAggregates = [], havingRestriction = Nothing } -aggregateFunctions :: [(FuncName, FunctionName)]-aggregateFunctions = [(FuncName ["max"], "sql_max"),+aggregateFunctionsMap :: [(FuncName, FunctionName)]+aggregateFunctionsMap = [(FuncName ["max"], "sql_max"),                        (FuncName ["min"], "sql_min"),                        (FuncName ["sum"], "sql_sum"),                        (FuncName ["count"], "sql_count")]  isAggregateFunction :: FuncName -> Bool-isAggregateFunction fname = fname `elem` map fst aggregateFunctions+isAggregateFunction fname = fname `elem` map fst aggregateFunctionsMap  containsAggregate :: ProjectionScalarExpr -> Bool containsAggregate expr =@@ -1479,21 +1483,20 @@   case expr of     AttributeAtomExpr{} -> expr     NakedAtomExpr{} -> expr+    SubrelationAttributeAtomExpr{} -> expr     FunctionAtomExpr fname [AttributeAtomExpr attrName] ()       | fname == "sql_count" && -- count(*) counts the number of rows         attrName == "_sql_aggregate" -> expr       | fname == "sql_count" -> -- count(city) counts the number city elements that are not null-        callF fname [RelationAtomExpr+        func fname [RelationAtomExpr                      (Restrict                        (NotPredicate                         (AtomExprPredicate-                         (callF "sql_isnull" [AttributeAtomExpr attrName]))) (RelationValuedAttribute "_sql_aggregate"))]-      | fname `elem` map snd aggregateFunctions ->-          FunctionAtomExpr fname-            [RelationAtomExpr (Project (AttributeNames (S.singleton attrName)) (RelationValuedAttribute "_sql_aggregate"))] ()+                         (func "sql_isnull" [AttributeAtomExpr attrName]))) (RelationValuedAttribute "_sql_aggregate"))]+      | fname `elem` map snd aggregateFunctionsMap ->+          func fname+            [SubrelationAttributeAtomExpr "_sql_aggregate" attrName]     FunctionAtomExpr fname args () -> FunctionAtomExpr fname (map processSQLAggregateFunctions args) ()     RelationAtomExpr{} -> expr --not supported in SQL     IfThenAtomExpr ifE thenE elseE -> IfThenAtomExpr (processSQLAggregateFunctions ifE) (processSQLAggregateFunctions thenE) (processSQLAggregateFunctions elseE)     ConstructedAtomExpr{} -> expr --not supported in SQL-  where-    callF fname args = FunctionAtomExpr fname args ()

@@ -437,6 +437,7 @@  isStaticAtomExpr :: AtomExpr -> Bool isStaticAtomExpr NakedAtomExpr{} = True+isStaticAtomExpr SubrelationAttributeAtomExpr{} = False isStaticAtomExpr ConstructedAtomExpr{} = True isStaticAtomExpr AttributeAtomExpr{} = False isStaticAtomExpr FunctionAtomExpr{} = False

@@ -122,6 +122,7 @@    processTransGraphAtomExpr :: TransGraphAtomExpr -> TransGraphEvalMonad GraphRefAtomExpr processTransGraphAtomExpr (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname+processTransGraphAtomExpr (SubrelationAttributeAtomExpr relAttr subAttr) = pure $ SubrelationAttributeAtomExpr relAttr subAttr processTransGraphAtomExpr (NakedAtomExpr atom) = pure $ NakedAtomExpr atom processTransGraphAtomExpr (FunctionAtomExpr funcName' args tLookup) =   FunctionAtomExpr funcName' <$> mapM processTransGraphAtomExpr args <*> findTransId tLookup

@@ -69,6 +69,9 @@ registeredQueriesPath :: FilePath -> FilePath registeredQueriesPath transdir = transdir </> "registered_queries" +aggregateFunctionsPath :: FilePath -> FilePath+aggregateFunctionsPath transdir = transdir </> "aggregateFunctions"+ -- | where compiled modules are stored within the database directory objectFilesPath :: FilePath -> FilePath objectFilesPath transdir = transdir </> ".." </> "compiled_modules"@@ -93,7 +96,7 @@                                        relationVariables = relvars,                                        typeConstructorMapping = typeCons,                                        notifications = notifs,-                                       atomFunctions = atomFuncs, +                                       atomFunctions = atomFuncs,                                        dbcFunctions = dbcFuncs,                                        registeredQueries = registeredQs }         newSchemas = Schemas newContext sschemas

@@ -517,7 +517,7 @@   let newContext = DatabaseContext {         inclusionDependencies = incDeps,          relationVariables = relVars, -        atomFunctions = atomFuncs, +        atomFunctions = atomFuncs,         dbcFunctions = dbcFuncs,         notifications = notifs,         typeConstructorMapping = types,

@@ -62,7 +62,7 @@   PreferFirst -> pure $ HS.union funcsA funcsB   PreferSecond -> pure $ HS.union funcsB funcsA   PreferNeither -> pure $ HS.union funcsA funcsB-  + unionMergeTypeConstructorMapping :: MergePreference -> TypeConstructorMapping -> TypeConstructorMapping -> Either MergeError TypeConstructorMapping   unionMergeTypeConstructorMapping prefer typesA typesB = do   let allFuncNames = S.fromList $ map (\(tc,_) -> TCD.name tc) (typesA ++ typesB)

@@ -61,7 +61,6 @@     unknownAttrNames = V.filter (`V.notElem` attributeNames attrs) attrNameVec     mapper attrName = fromMaybe (error "logic failure in vectorIndicesForAttributeNames") (V.elemIndex attrName (attributeNames attrs)) - relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation relationForAttributeName attrName tuple = do   aType <- atomTypeForAttributeName attrName (tupleAttributes tuple)@@ -222,3 +221,6 @@   RelationTuple newAttrs (V.drop index vals)   where     newAttrs = A.drop index attrs+  +  +  

@@ -84,6 +84,7 @@ substituteWithNameMacrosAtomExpr macros atomExpr =   case atomExpr of     e@AttributeAtomExpr{} -> e+    e@SubrelationAttributeAtomExpr{} -> e     e@NakedAtomExpr{} -> e     FunctionAtomExpr fname atomExprs tid ->       FunctionAtomExpr fname (map (substituteWithNameMacrosAtomExpr macros) atomExprs) tid

@@ -24,6 +24,7 @@ import Text.Megaparsec import qualified Data.Text as T import qualified Data.Map as M+import TutorialD.Printer  main :: IO () main = do@@ -59,7 +60,7 @@   (tgraph,transId) <- freshTransactionGraph sqlDBContext   (sess, conn) <- dateExamplesConnection emptyNotificationCallback   -  let readTests = [+  let readTests = [{-         -- simple relvar         ("SELECT * FROM s", "(s)", "(s)"),         -- simple projection@@ -163,24 +164,24 @@         ("SELECT abs(-4)",          "((relation{}{tuple{}}:{attr_1:=sql_abs(sql_negate(4))}){attr_1})",          "(relation{tuple{attr_1 SQLJust 4}})"-         ),+         ),-}         -- where not exists         -- group by with max aggregate         ("SELECT city,max(status) FROM s GROUP BY city",-         "((s group ({all but city} as `_sql_aggregate`) : {attr_2:=sql_max(@`_sql_aggregate`{status})}){city,attr_2})",+         "((s group ({all but city} as `_sql_aggregate`) : {attr_2:=sql_max(@`_sql_aggregate`.status)}){city,attr_2})",          "(relation{city Text, attr_2 SQLNullable Integer}{tuple{city \"London\", attr_2 SQLJust 20}, tuple{city \"Paris\", attr_2 SQLJust 30}, tuple{city \"Athens\", attr_2 SQLJust 30}})"-         ),+         ){-,         -- group by with aggregate max column alias         ("SELECT city,max(status) as status FROM s GROUP BY city",-         "((s group ({all but city} as `_sql_aggregate`) : {status:=sql_max(@`_sql_aggregate`{status})}){city,status})",+         "((s group ({all but city} as `_sql_aggregate`) : {status:=sql_max(@`_sql_aggregate`.status)}){city,status})",          "(relation{city Text, status SQLNullable Integer}{tuple{city \"London\", status SQLJust 20}, tuple{city \"Paris\", status SQLJust 30}, tuple{city \"Athens\", status SQLJust 30}})"),         -- aggregate max without grouping         ("SELECT max(status) as status FROM s",-         "(((s group ({all but } as `_sql_aggregate`)):{status:=sql_max( (@`_sql_aggregate`){ status } )}){ status })",+         "(((s group ({all but } as `_sql_aggregate`)):{status:=sql_max( (@`_sql_aggregate`.status)}){ status })",          "(relation{status SQLNullable Integer}{tuple{status SQLJust 30}})"),         -- group by having max         ("select city,max(status) as status from s group by city having max(status)=30",-         "((((s group ({all but city} as `_sql_aggregate`)):{status:=sql_max( (@`_sql_aggregate`){ status } ), `_sql_having`:=sql_coalesce_bool( sql_equals( sql_max( (@`_sql_aggregate`){ status } ), 30 ) )}){ city, status }) where `_sql_having`=True)",+         "((((s group ({all but city} as `_sql_aggregate`)):{status:=sql_max( (@`_sql_aggregate`.status), `_sql_having`:=sql_coalesce_bool( sql_equals( sql_max( (@`_sql_aggregate`.status), 30 ) )}){ city, status }) where `_sql_having`=True)",          "(relation{city Text,status SQLNullable Integer}{tuple{city \"Athens\",status SQLJust 30},tuple{city \"Paris\",status SQLJust 30}})"),         -- count(*) aggregate         ("select count(*) as c from s",@@ -282,7 +283,7 @@          "(relation{attr_1 SQLNullable Bool}{tuple{attr_1 SQLNull}})"),         ("SELECT NULL OR TRUE",          "((relation{}{tuple{}}:{attr_1:=sql_or(SQLNullOfUnknownType,True)}){attr_1})",-         "(relation{attr_1 SQLNullable Bool}{tuple{attr_1 SQLJust True}})")+         "(relation{attr_1 SQLNullable Bool}{tuple{attr_1 SQLJust True}})")-}         ]       gfEnv = GraphRefRelationalExprEnv {         gre_context = Just sqlDBContext,@@ -315,7 +316,7 @@          --print ("selectAsRelExpr"::String, queryAsRelExpr)         --print ("expected: "::String, pretty tutdAsDFExpr)-        --print ("actual  : "::String, pretty queryAsDFExpr)+        print ("actual  : "::String, renderPretty queryAsDFExpr)         assertEqual (T.unpack sql) tutdAsDFExpr queryAsDFExpr         --check that the expression can actually be executed         eEvald <- executeDataFrameExpr sess conn tutdAsDFExpr

@@ -95,7 +95,8 @@       testShowDDL,       testRegisteredQueries,       testCrossJoin,-      testIfThenExpr+      testIfThenExpr,+      testSubrelationAttributeAtomExpr       ]  simpleRelTests :: Test@@ -184,14 +185,14 @@                            --relatom function tests                            ("x:=((s group ({city} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ IntegerAtom 1)])),                            ("x:=(sp group ({s#} as y)) ungroup y", Right supplierProductsRel),-                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=max(@x)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),-                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=min(@x)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),-                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=sum(@x)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),+                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=max(@x.qty)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),+                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=min(@x.qty)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),+                           ("x:=((sp{s#,qty}) group ({qty} as x):{z:=sum(@x.qty)}){s#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [TextAtom s,IntegerAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),                            --boolean function restriction                            ("x:=s where lt(@status,20)", mkRelationFromList (R.attributes suppliersRel) [[TextAtom "S2", TextAtom "Jones", IntegerAtom 10, TextAtom "Paris"]]),                            ("x:=s where gt(@status,20)", mkRelationFromList (R.attributes suppliersRel) [[TextAtom "S3", TextAtom "Blake", IntegerAtom 30, TextAtom "Paris"],                                                                                                        [TextAtom "S5", TextAtom "Adams", IntegerAtom 30, TextAtom "Athens"]]),-                           ("x:=s where sum(@status)", Left $ AtomFunctionTypeError "sum" 1 (RelationAtomType (attributesFromList [Attribute "_" IntegerAtomType])) IntegerAtomType),+                           ("x:=s where sum(@status)", Left $ AtomFunctionTypeError "sum" 1 (SubrelationFoldAtomType IntegerAtomType) IntegerAtomType),                            ("x:=s where not(gte(@status,20))", mkRelationFromList (R.attributes suppliersRel) [[TextAtom "S2", TextAtom "Jones", IntegerAtom 10, TextAtom "Paris"]]),                            --test "all but" attribute inversion syntax                            ("x:=s{all but s#} = s{city,sname,status}", Right relationTrue),@@ -805,7 +806,7 @@   Right hash2 <- getDDLHash sessionId dbconn     assertBool "add relvar" (hash1 /= hash2)   -- the test should break if the hash is calculated differently-  assertEqual "static hash check" "ds0uvEvV8CvivyYyxJ75S0CeAnNzKAAH5AdOv74+ydM=" (B64.encode (_unSecureHash hash1))+  assertEqual "static hash check" "3aNi/azK9QNSXQQQ0QOuGcqAPlRh0d7zX0bNwjowPDA=" (B64.encode (_unSecureHash hash1))   -- remove an rv   executeTutorialD sessionId dbconn "undefine x"   Right hash3 <- getDDLHash sessionId dbconn@@ -876,3 +877,12 @@   executeTutorialD session dbconn "x:=(s:{islondon:=if eq(@city,\"London\") then True else False}){city,islondon} = relation{tuple{city \"London\", islondon True},tuple{city \"Paris\",islondon False},tuple{city \"Athens\", islondon False}}"   eEqRel <- executeRelationalExpr session dbconn (RelationVariable "x" ())   assertEqual "if-then" (Right relationTrue) eEqRel++testSubrelationAttributeAtomExpr :: Test+testSubrelationAttributeAtomExpr = TestCase $ do+  (session, dbconn) <- dateExamplesConnection emptyNotificationCallback+  executeTutorialD session dbconn "x:=(s group ({all from s} as sub):{l:=sum(@sub.status)}){l}"+  executeTutorialD session dbconn "y:=relation{tuple{l 110}}"+  executeTutorialD session dbconn "z:= x = y"+  res <- executeRelationalExpr session dbconn (RelationVariable "z" ())+  assertEqual "sum" (Right relationTrue) res