ffd382f · project-m36 · git.iko.soy

git.iko.soy/project-m36

implement simple tuple expressions for relational "extend"

- includes functions and relation extension - all tests pass

commitffd382ffab4cad0d66ab10dc2a54fd103bd4123f authorAgentM <agentm@themactionfaction.com> dateFri 15 May 2015, 21:10 (11 years ago) parent2b5f249

9 files changed+197−60

compare with master

unifiedsplit

ProjectM36/Atom.hs−1 ProjectM36/Attribute.hs+9−9 ProjectM36/Base.hs+38−6 ProjectM36/Error.hs+3 ProjectM36/Relation.hs+7−5 ProjectM36/RelationalExpression.hs+94−26 ProjectM36/Tuple.hs+19−7 TutorialD/Interpreter.hs+26−5 test/Relation/Basic.hs+1−1

ProjectM36/Atom.hs−1

@@ -11,4 +11,3 @@ atomTypeForAtom :: Atom -> AtomType

1111atomTypeForAtom (StringAtom _) = StringAtomType

1212atomTypeForAtom (IntAtom _) = IntAtomType

1313atomTypeForAtom (RelationAtom (Relation attributes _)) = RelationAtomType attributes

14−

ProjectM36/Attribute.hs+9−9

@@ -59,15 +59,15 @@ renameAttributes oldAttrName newAttrName attrs = V.map renamer attrs

5959 else

6060 attr

6161

62−atomTypeForAttributeName :: AttributeName -> Attributes -> Maybe AtomType

63−atomTypeForAttributeName attrName attrs = case attr of

64− (Just (Attribute _ atype)) -> Just atype

65− _ -> Nothing

66− where

67− attr = attributeForName attrName attrs

68−

69−attributeForName :: AttributeName -> Attributes -> Maybe Attribute

70−attributeForName attrName attrs = V.find ((attrName ==) . attributeName) attrs

62+atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType

63+atomTypeForAttributeName attrName attrs = do

64+ (Attribute _ atype) <- attributeForName attrName attrs

65+ return atype

66+

67+attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute

68+attributeForName attrName attrs = case V.find ((attrName ==) . attributeName) attrs of

69+ Nothing -> Left $ NoSuchAttributeNameError attrName

70+ Just attr -> Right attr

7171

7272attributesForNames :: S.Set AttributeName -> Attributes -> Attributes

7373attributesForNames attrNameSet attrs = V.foldr folder V.empty attrs

ProjectM36/Base.hs+38−6

@@ -17,7 +17,8 @@ type StringType = T.Text

1717

1818data Atom = StringAtom StringType |

1919 IntAtom Int |

20− RelationAtom Relation deriving (Show, Eq, Generic)

20+ RelationAtom Relation

21+ deriving (Show, Eq, Generic)

2122

2223instance NFData Atom where rnf = genericRnf

2324

@@ -25,7 +26,9 @@ instance Hash.Hashable Atom

2526

2627data AtomType = StringAtomType |

2728 IntAtomType |

28− RelationAtomType Attributes deriving (Eq, Show, Generic)

29+ RelationAtomType Attributes |

30+ AnyAtomType --AnyAtomType is used as a wildcard

31+ deriving (Eq, Show, Generic)

2932

3033instance NFData AtomType where rnf = genericRnf

3134

@@ -117,7 +120,8 @@ data RelationalExpr where

117120

118121data DatabaseContext = DatabaseContext {

119122 inclusionDependencies :: HS.HashSet InclusionDependency,

120− relationVariables :: M.Map RelVarName Relation

123+ relationVariables :: M.Map RelVarName Relation,

124+ atomFunctions :: AtomFunctions

121125 } deriving (Show)

122126

123127type IncDepName = StringType

@@ -192,7 +196,35 @@ instance Eq Transaction where

192196instance Ord Transaction where

193197 compare (Transaction uuidA _ _) (Transaction uuidB _ _) = compare uuidA uuidB

194198

199+--used on the right side of attribute assignments

200+data AtomExpr = AttributeAtomExpr AttributeName |

201+ NakedAtomExpr Atom |

202+ FunctionAtomExpr AtomFunctionName [AtomExpr] |

203+ RelationAtomExpr RelationalExpr

204+ deriving (Eq,Show)

205+

195206--used to extend a relation

196−data TupleExpr = AttributeTupleExpr AttributeName AttributeName |

197− MultipleTupleExpr [TupleExpr] --new attr, old attr to clone

198− deriving (Show, Eq)

207+data TupleExpr = AttributeTupleExpr AttributeName AtomExpr

208+ deriving (Show, Eq)

209+

210+--enumerates the list of functions available to be run as part of tuple expressions

211+type AtomFunctions = HS.HashSet AtomFunction

212+

213+type AtomFunctionName = StringType

214+

215+data AtomFunction = AtomFunction {

216+ atomFuncName :: AtomFunctionName,

217+ atomFuncType :: [AtomType],

218+ atomFunc :: [Atom] -> Atom

219+ }

220+

221+instance Hash.Hashable AtomFunction where

222+ hashWithSalt salt func = salt `Hash.hashWithSalt` (atomFuncName func)

223+

224+instance Eq AtomFunction where

225+ f1 == f2 = (atomFuncName f1) == (atomFuncName f2)

226+

227+instance Show AtomFunction where

228+ show aFunc = T.unpack (atomFuncName aFunc) ++ "::" ++ showArgTypes

229+ where

230+ showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

ProjectM36/Error.hs+3

@@ -25,6 +25,9 @@ data RelationalError = NoSuchAttributeNameError AttributeName

2525 | NoSuchHeadNameError HeadName

2626 | TransactionIsNotAHeadError U.UUID

2727 | TransactionGraphCycleError U.UUID

28+ | NoSuchTupleExprFunctionError AtomFunctionName

29+ | AtomTypeMismatchError AtomType AtomType

30+ | AtomTypeCountError [AtomType] [AtomType]

2831 deriving (Show,Eq,Generic)

2932

3033

ProjectM36/Relation.hs+7−5

@@ -21,13 +21,13 @@ attributes (Relation attrs _ ) = attrs

2121attributeNames :: Relation -> S.Set AttributeName

2222attributeNames (Relation attrs _) = A.attributeNameSet attrs

2323

24−attributeForName :: AttributeName -> Relation -> Maybe Attribute

24+attributeForName :: AttributeName -> Relation -> Either RelationalError Attribute

2525attributeForName attrName (Relation attrs _) = A.attributeForName attrName attrs

2626

2727attributesForNames :: S.Set AttributeName -> Relation -> Attributes

2828attributesForNames attrNameSet (Relation attrs _) = A.attributesForNames attrNameSet attrs

2929

30−atomTypeForName :: AttributeName -> Relation -> Maybe AtomType

30+atomTypeForName :: AttributeName -> Relation -> Either RelationalError AtomType

3131atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrName attrs

3232

3333atomValueType :: Atom -> AtomType

@@ -197,9 +197,11 @@ tupleUngroup relvalAttrName newAttrs tuple = do

197197 Right accRel -> union accRel $ Relation newAttrs (HS.singleton (tupleExtend nonGroupTupleProjection tupleIn))

198198

199199attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes

200−attributesForRelval relvalAttrName (Relation attrs _) = case A.atomTypeForAttributeName relvalAttrName attrs of

201− (Just (RelationAtomType relAttrs)) -> Right relAttrs

202− _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

200+attributesForRelval relvalAttrName (Relation attrs _) = do

201+ atomType <- A.atomTypeForAttributeName relvalAttrName attrs

202+ case atomType of

203+ (RelationAtomType relAttrs) -> Right relAttrs

204+ _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

203205

204206restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relation

205207--restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

ProjectM36/RelationalExpression.hs+94−26

@@ -5,13 +5,13 @@ import ProjectM36.Tuple

55import ProjectM36.TupleSet

66import ProjectM36.Base

77import ProjectM36.Error

8+import ProjectM36.Atom

89import qualified ProjectM36.Attribute as A

910import qualified Data.Map as M

1011import qualified Data.HashSet as HS

11−import qualified Data.Set as S

12−import qualified Data.Vector as V

1312import Control.Monad.State hiding (join)

1413import Data.Maybe

14+import Data.Either

1515

1616--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

1717evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -91,25 +91,31 @@ evalRelationalExpr (Equals relExprA relExprB) = do

9191-- extending a relation adds a single attribute with the results of the per-tuple expression evaluated

9292evalRelationalExpr (Extend tupleExpression relExpr) = do

9393 evald <- evalRelationalExpr relExpr

94+ funcs <- liftM atomFunctions get

9495 case evald of

9596 Left err -> return $ Left err

9697 Right rel -> do

97− case tupleExpressionProcessor rel tupleExpression of

98+ case tupleExpressionProcessor rel tupleExpression funcs of

9899 Left err -> return $ Left err

99100 Right (newAttrs, tupProc) -> return $ relMogrify tupProc newAttrs rel

100101

101102emptyDatabaseContext :: DatabaseContext

102103emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

103− relationVariables = M.empty}

104+ relationVariables = M.empty,

105+ atomFunctions = HS.empty

106+ }

104107

105108basicDatabaseContext :: DatabaseContext

106109basicDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

107110 relationVariables = M.fromList [("true", relationTrue),

108− ("false", relationFalse)]}

111+ ("false", relationFalse)],

112+ atomFunctions = basicAtomFunctions

113+ }

109114

110115dateExamples :: DatabaseContext

111116dateExamples = DatabaseContext { inclusionDependencies = HS.empty, -- add foreign key relationships

112− relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars }

117+ relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars,

118+ atomFunctions = basicAtomFunctions}

113119 where

114120 dateRelVars = M.fromList [("S", suppliers),

115121 ("P", products),

@@ -184,7 +190,7 @@ setRelVar relVarName rel = do

184190 case checkConstraints currstate of

185191 Just err -> return $ Just err

186192 Nothing -> do

187− put $ DatabaseContext (inclusionDependencies currstate) newRelVars

193+ put $ DatabaseContext (inclusionDependencies currstate) newRelVars (atomFunctions currstate)

188194 return Nothing

189195

190196-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation

@@ -192,7 +198,7 @@ deleteRelVar :: RelVarName -> DatabaseState (Maybe RelationalError)

192198deleteRelVar relVarName = do

193199 currstate <- get

194200 let newRelVars = M.delete relVarName (relationVariables currstate)

195− put $ DatabaseContext (inclusionDependencies currstate) newRelVars

201+ put $ DatabaseContext (inclusionDependencies currstate) newRelVars (atomFunctions currstate)

196202 return Nothing

197203

198204evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)

@@ -252,7 +258,7 @@ evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = d

252258evalContextExpr (AddInclusionDependency dep) = do

253259 currstate <- get

254260 let newDeps = HS.insert dep (inclusionDependencies currstate)

255− put $ DatabaseContext newDeps (relationVariables currstate)

261+ put $ DatabaseContext newDeps (relationVariables currstate) (atomFunctions currstate)

256262 return Nothing

257263

258264evalContextExpr (MultipleExpr exprs) = do

@@ -313,8 +319,11 @@ typeForRelationalExpr expr = do

313319--returns a database context with all tuples removed

314320--this is useful for type checking and optimization

315321contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext

316−contextWithEmptyTupleSets contextIn = DatabaseContext (inclusionDependencies contextIn) $ M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

317−

322+contextWithEmptyTupleSets contextIn = DatabaseContext incDeps relVars funcs

323+ where

324+ incDeps = inclusionDependencies contextIn

325+ relVars = M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

326+ funcs = atomFunctions contextIn

318327

319328{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

320329predicateRestrictionFilter :: DatabaseContext -> RestrictionPredicateExpr -> Either RelationalError (RelationTuple -> Bool)

@@ -347,23 +356,82 @@ predicateRestrictionFilter _ (AttributeEqualityPredicate attrName atom) = Right

347356 Left _ -> False

348357 Right atom2 -> atom2 == atom

349358

350−tupleExpressionProcessor :: Relation -> TupleExpr -> Either RelationalError (Attributes, RelationTuple -> RelationTuple)

359+tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

360+tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName rel then

361+ Left $ AttributeNameInUseError attrName

362+ else

363+ Right rel

351364

352−--just clone an existing tuple as a new attribute

365+tupleExpressionProcessor :: Relation -> TupleExpr -> AtomFunctions -> Either RelationalError (Attributes, RelationTuple -> RelationTuple)

353366tupleExpressionProcessor relIn

354− (AttributeTupleExpr newAttrName oldAttrName) = if isNothing $ attributeForName oldAttrName relIn then

355− Left $ NoSuchAttributeNameError oldAttrName

356− else if isJust $ attributeForName newAttrName relIn then

357− Left $ AttributeNameInUseError newAttrName

358− else do

359− let newAttrs = A.renameAttributes oldAttrName newAttrName (attributesForNames (S.singleton oldAttrName) relIn)

360− let newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

361− return $ (newAndOldAttrs, \tup -> tupleExtend tup (RelationTuple newAttrs (atomsForAttributeNames (V.singleton oldAttrName) tup)))

367+ (AttributeTupleExpr newAttrName atomExpr) functions = do

368+ _ <- tupleExprCheckNewAttrName newAttrName relIn

369+ atomExprType <- typeFromAtomExpr (attributes relIn) functions atomExpr

370+ _ <- verifyAtomExprTypes relIn functions atomExpr atomExprType

371+ let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType]

372+ newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

373+ return $ (newAndOldAttrs, \tup -> case evalAtomExpr tup functions atomExpr of

374+ Left _ -> undefined -- ?!

375+ Right atom -> tupleAtomExtend newAttrName atom tup)

376+

377+basicAtomFunctions :: AtomFunctions

378+basicAtomFunctions = HS.fromList [

379+ --match on any relation type

380+ AtomFunction "add" [IntAtomType, IntAtomType, IntAtomType] (\(i1:i2:_) -> (\(IntAtom a) (IntAtom b) -> IntAtom (a + b)) i1 i2),

381+ AtomFunction { atomFuncName = "id",

382+ atomFuncType = [AnyAtomType],

383+ atomFunc = (\(x:_) -> x)}

362384

363−tupleExpressionProcessor relIn (MultipleTupleExpr exprList) = do

364− procList <- mapM (tupleExpressionProcessor relIn) exprList

365− -- add up all the new attributes from the procList

366− let folder (attrs, tupProc) (accAttrs, accTupProc) = (A.addAttributes attrs accAttrs, tupProc . accTupProc)

367− return $ foldl folder (A.emptyAttributes, id) procList

385+-- AtomFunction "count" [RelationAtomType , IntAtom],

386+-- AtomFunction "sum" [RelationAtomType IntAtomType

387+ ]

368388

389+atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction

390+atomFunctionForName funcName funcSet = if HS.null foundFunc then

391+ Left $ NoSuchTupleExprFunctionError funcName

392+ else

393+ Right $ head $ HS.toList foundFunc

394+ where

395+ foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

396+

397+typeFromAtomExpr :: Attributes -> AtomFunctions -> AtomExpr -> Either RelationalError AtomType

398+typeFromAtomExpr attrs _ (AttributeAtomExpr attrName) = A.atomTypeForAttributeName attrName attrs

399+typeFromAtomExpr _ _ (NakedAtomExpr atom) = Right (atomTypeForAtom atom)

400+typeFromAtomExpr _ funcs (FunctionAtomExpr funcName _) = do

401+ func <- atomFunctionForName funcName funcs

402+ return $ last (atomFuncType func)

369403

404+verifyAtomExprTypes :: Relation -> AtomFunctions -> AtomExpr -> AtomType -> Either RelationalError AtomType

405+verifyAtomExprTypes relIn _ (AttributeAtomExpr attrName) expectedType = do

406+ attrType <- A.atomTypeForAttributeName attrName (attributes relIn)

407+ atomTypeVerify expectedType attrType

408+verifyAtomExprTypes _ _ (NakedAtomExpr atom) expectedType = atomTypeVerify expectedType (atomTypeForAtom atom)

409+verifyAtomExprTypes relIn functions (FunctionAtomExpr funcName funcArgExprs) expectedType = do

410+ func <- atomFunctionForName funcName functions

411+ let expectedArgTypes = atomFuncType func

412+ funcArgTypes <- mapM (\(atomExpr,expectedType) -> verifyAtomExprTypes relIn functions atomExpr expectedType) $ zip funcArgExprs expectedArgTypes

413+ if length funcArgTypes /= length expectedArgTypes - 1 then

414+ Left $ AtomTypeCountError funcArgTypes expectedArgTypes

415+ else do

416+ atomTypeVerify expectedType (last expectedArgTypes)

417+

418+--determine if two types are equal or compatible

419+atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

420+atomTypeVerify AnyAtomType x = Right x

421+atomTypeVerify x AnyAtomType = Right x

422+atomTypeVerify x y = if x == y then

423+ Right x

424+ else

425+ Left $ AtomTypeMismatchError x y

426+

427+evalAtomExpr :: RelationTuple -> AtomFunctions -> AtomExpr -> Either RelationalError Atom

428+evalAtomExpr tupIn _ (AttributeAtomExpr attrName) = atomForAttributeName attrName tupIn

429+evalAtomExpr _ _ (NakedAtomExpr atom) = Right atom

430+evalAtomExpr tupIn functions (FunctionAtomExpr funcName arguments) = do

431+ func <- atomFunctionForName funcName functions

432+ argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) functions) arguments

433+ _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

434+ evaldArgs <- mapM (evalAtomExpr tupIn functions) arguments

435+ return $ (atomFunc func) evaldArgs

436+

437+

ProjectM36/Tuple.hs+19−7

@@ -32,6 +32,13 @@ atomForAttributeName attrName (RelationTuple tupAttrs tupVec) = case V.findIndex

3232 Just index -> case tupVec V.!? index of

3333 Nothing -> Left $ NoSuchAttributeNameError attrName

3434 Just atom -> Right atom

35+

36+{- -- resolve naming clash with Attribute and Relation later

37+atomTypeForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom

38+atomTypeForAttributeName attrName tup = do

39+ atom <- atomForAttributeName attrName tup

40+ return $ atomTypeForAtom atom

41+-}

3542

3643atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> V.Vector Atom

3744atomsForAttributeNames attrNames tuple = V.foldr folder V.empty attrNames

@@ -41,13 +48,13 @@ atomsForAttributeNames attrNames tuple = V.foldr folder V.empty attrNames

4148 Right atom -> V.snoc acc atom

4249

4350relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation

44−relationForAttributeName attrName tuple = if maybe False isRelationAtomType (atomTypeForAttributeName attrName (tupleAttributes tuple)) then

45− Left $ AttributeIsNotRelationValuedError attrName

46− else do

47− atomVal <- atomForAttributeName attrName tuple

48− relationForAtom atomVal

49−

50−

51+relationForAttributeName attrName tuple = do

52+ aType <- atomTypeForAttributeName attrName (tupleAttributes tuple)

53+ if not (isRelationAtomType aType) then

54+ Left $ AttributeIsNotRelationValuedError attrName

55+ else do

56+ atomVal <- atomForAttributeName attrName tuple

57+ relationForAtom atomVal

5158

5259--in case the oldattr does not exist in the tuple, then return the old tuple

5360tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple

@@ -103,6 +110,11 @@ tupleExtend (RelationTuple tupAttrs1 tupVec1) (RelationTuple tupAttrs2 tupVec2)

103110 where

104111 newAttrs = tupAttrs1 V.++ tupAttrs2

105112 newVec = tupVec1 V.++ tupVec2

113+

114+tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple

115+tupleAtomExtend newAttrName atom tupIn = tupleExtend tupIn newTup

116+ where

117+ newTup = RelationTuple (V.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)

106118

107119{- sort the associative list to match the header sorting -}

108120tupleSortedAssocs :: RelationTuple -> [(AttributeName, Atom)]

TutorialD/Interpreter.hs+26−5

@@ -21,7 +21,7 @@ import qualified Data.Set as S

2121import qualified Data.HashSet as HS

2222import qualified Data.Map as M

2323import qualified Data.List as L

24−import Control.Applicative (liftA, (<*), (*>), (<*>), (<$>))

24+import Control.Applicative (liftA, (<*), (*>), (<$>))

2525import Control.Monad.State

2626import System.Console.Haskeline

2727import System.IO

@@ -597,8 +597,8 @@ displayTransactionGraph :: TransactionGraph -> String

597597displayTransactionGraph (TransactionGraph _ transSet) = L.intercalate "\n" $ S.foldr (\(Transaction tUUID pUUID _ ) acc -> acc ++ [show tUUID ++ " " ++ show pUUID]) [] transSet

598598-}

599599

600−multiTupleExpressionP :: Parser TupleExpr

601−multiTupleExpressionP = MultipleTupleExpr <$> (sepBy tupleExpressionP comma)

600+multiTupleExpressionP :: Parser [TupleExpr]

601+multiTupleExpressionP = sepBy tupleExpressionP comma

602602

603603tupleExpressionP :: Parser TupleExpr

604604tupleExpressionP = attributeTupleExpressionP

@@ -607,6 +607,27 @@ attributeTupleExpressionP :: Parser TupleExpr

607607attributeTupleExpressionP = do

608608 newAttr <- identifier

609609 reservedOp ":="

610− attr <- identifier

611− return $ AttributeTupleExpr (T.pack newAttr) (T.pack attr)

610+ atom <- atomExprP

611+ return $ AttributeTupleExpr (T.pack newAttr) atom

612612

613+atomExprP :: Parser AtomExpr

614+atomExprP = try functionAtomExprP <|>

615+ attributeAtomExprP <|>

616+ nakedAtomExprP

617+

618+attributeAtomExprP :: Parser AtomExpr

619+attributeAtomExprP = do

620+ attrName <- identifier

621+ return $ AttributeAtomExpr (T.pack attrName)

622+

623+nakedAtomExprP :: Parser AtomExpr

624+nakedAtomExprP = NakedAtomExpr <$> (stringAtomP <|> intAtomP)

625+

626+functionAtomExprP :: Parser AtomExpr

627+functionAtomExprP = do

628+ funcName <- identifier

629+ argList <- parens (sepBy atomExprP comma)

630+ return $ FunctionAtomExpr (T.pack funcName) argList

631+

632+relationalAtomExprP :: Parser AtomExpr

633+relationalAtomExprP = RelationAtomExpr <$> relExpr

test/Relation/Basic.hs+1−1

@@ -50,7 +50,7 @@ validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = HS.foldr (\tu

5050 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)

5151 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of

5252 Left _ -> False

53− Right atom -> (Just $ atomTypeForAtom atom) ==

53+ Right atom -> (Right $ atomTypeForAtom atom) ==

5454 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)

5555

5656simpleRel :: Relation