61548c9 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

refactor RelationalExpr to allow for TransGraphRelationalExpr

61548c9AgentM10 years ago

src/bin/TutorialD/Interpreter/RelationalExpr.hs+44−43

compare with master

unifiedsplit

@@ -12,6 +12,12 @@ import Data.List (sort)

12import Control.Applicative (liftA)

13import ProjectM36.MiscUtils

15+class RelationalMarkerExpr a where

16+ parseMarkerP :: Parser a

17+

18+instance RelationalMarkerExpr () where

19+ parseMarkerP = pure ()

20+

15--used in projection

21--used in projection

16attributeListP :: Parser AttributeNames

22attributeListP :: Parser AttributeNames

17attributeListP = do

23attributeListP = do

@@ -20,23 +26,19 @@ attributeListP = do

20 attrs <- sepBy identifier comma

26 attrs <- sepBy identifier comma

21 pure $ constructor (S.fromList attrs)

27 pure $ constructor (S.fromList attrs)

23−makeRelationP :: Parser RelationalExpr

29+makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

24makeRelationP = do

30makeRelationP = do

25 reserved "relation"

31 reserved "relation"

26 attrExprs <- try (liftA Just makeAttributeExprsP) <|> pure Nothing

32 attrExprs <- try (liftA Just makeAttributeExprsP) <|> pure Nothing

27 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []

33 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []

28− pure $ MakeRelationFromExprs attrExprs tupleExprs

34+ pure $ MakeRelationFromExprs attrExprs tupleExprs

30--used in relation creation

36--used in relation creation

31−makeAttributeExprsP :: Parser [AttributeExpr]

37+makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]

32makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

38makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

34−attributeAndTypeNameP :: Parser AttributeExpr

40+attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)

35−attributeAndTypeNameP = do

41+attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP

36− attrName <- identifier

37− --convert type name into type

38− typeCons <- typeConstructorP

39− return $ AttributeAndTypeNameExpr attrName typeCons ()

41--abstract data type parser- in this context, the type constructor must not include any type arguments

43--abstract data type parser- in this context, the type constructor must not include any type arguments

42--Either Text Int

44--Either Text Int

@@ -46,7 +48,7 @@ adTypeConstructorP = do

46 tConsArgs <- many typeConstructorArgP

48 tConsArgs <- many typeConstructorArgP

47 pure $ ADTypeConstructor tConsName tConsArgs

49 pure $ ADTypeConstructor tConsName tConsArgs

49−tupleExprP :: Parser TupleExpr

51+tupleExprP :: RelationalMarkerExpr a => Parser (TupleExprBase a)

50tupleExprP = do

52tupleExprP = do

51 reservedOp "tuple"

53 reservedOp "tuple"

52 attrAssocs <- braces (sepBy tupleAtomExprP comma)

54 attrAssocs <- braces (sepBy tupleAtomExprP comma)

@@ -57,13 +59,13 @@ tupleExprP = do

57 else

59 else

58 pure (TupleExpr (M.fromList attrAssocs))

60 pure (TupleExpr (M.fromList attrAssocs))

60−tupleAtomExprP :: Parser (AttributeName, AtomExpr)

62+tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)

61tupleAtomExprP = do

63tupleAtomExprP = do

62 attributeName <- identifier

64 attributeName <- identifier

63 atomExpr <- atomExprP

65 atomExpr <- atomExprP

64 pure $ (attributeName, atomExpr)

66 pure $ (attributeName, atomExpr)

66−projectP :: Parser (RelationalExpr -> RelationalExpr)

68+projectP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

67projectP = do

69projectP = do

68 attrs <- braces attributeListP

70 attrs <- braces attributeListP

69 pure $ Project attrs

71 pure $ Project attrs

@@ -75,17 +77,14 @@ renameClauseP = do

75 newAttr <- identifier

77 newAttr <- identifier

76 pure $ (oldAttr, newAttr)

78 pure $ (oldAttr, newAttr)

78−renameP :: Parser (RelationalExpr -> RelationalExpr)

80+renameP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

79renameP = do

81renameP = do

80 reservedOp "rename"

82 reservedOp "rename"

81 (oldAttr, newAttr) <- braces renameClauseP

83 (oldAttr, newAttr) <- braces renameClauseP

82 return $ Rename oldAttr newAttr

84 return $ Rename oldAttr newAttr

84−whereClauseP :: Parser (RelationalExpr -> RelationalExpr)

86+whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

85−whereClauseP = do

86− reservedOp "where"

87+whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)

87− boolExpr <- restrictionPredicateP

88− return $ Restrict boolExpr

90groupClauseP :: Parser (AttributeNames, T.Text)

89groupClauseP :: Parser (AttributeNames, T.Text)

91groupClauseP = do

90groupClauseP = do

@@ -94,26 +93,26 @@ groupClauseP = do

94 newAttrName <- identifier

93 newAttrName <- identifier

95 return $ (attrs, newAttrName)

94 return $ (attrs, newAttrName)

97−groupP :: Parser (RelationalExpr -> RelationalExpr)

96+groupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

98groupP = do

97groupP = do

99 reservedOp "group"

98 reservedOp "group"

100 (groupAttrList, groupAttrName) <- parens groupClauseP

99 (groupAttrList, groupAttrName) <- parens groupClauseP

101 pure $ Group groupAttrList groupAttrName

100 pure $ Group groupAttrList groupAttrName

102

101

103--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.

102--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.

104−ungroupP :: Parser (RelationalExpr -> RelationalExpr)

103+ungroupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

105ungroupP = do

104ungroupP = do

106 reservedOp "ungroup"

105 reservedOp "ungroup"

107 rvaAttrName <- identifier

106 rvaAttrName <- identifier

108 pure $ Ungroup rvaAttrName

107 pure $ Ungroup rvaAttrName

109

108

110−extendP :: Parser (RelationalExpr -> RelationalExpr)

109+extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

111extendP = do

110extendP = do

112 reservedOp ":"

111 reservedOp ":"

113 tupleExpr <- braces extendTupleExpressionP

112 tupleExpr <- braces extendTupleExpressionP

114 return $ Extend tupleExpr

113 return $ Extend tupleExpr

115

114

116−relOperators :: [[Operator Parser RelationalExpr]]

115+relOperators :: RelationalMarkerExpr a => [[Operator Parser (RelationalExprBase a)]]

117relOperators = [

116relOperators = [

118 [Postfix projectP],

117 [Postfix projectP],

119 [Postfix renameP],

118 [Postfix renameP],

@@ -127,18 +126,18 @@ relOperators = [

127 [Postfix extendP]

126 [Postfix extendP]

128 ]

127 ]

129

128

130−relExprP :: Parser RelationalExpr

129+relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

131relExprP = makeExprParser relTerm relOperators

130relExprP = makeExprParser relTerm relOperators

132

131

133−relVarP :: Parser RelationalExpr

132+relVarP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

134−relVarP = RelationVariable <$> identifier <*> pure ()

133+relVarP = RelationVariable <$> identifier <*> parseMarkerP

135

134

136−relTerm :: Parser RelationalExpr

135+relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

137relTerm = parens relExprP

136relTerm = parens relExprP

138 <|> makeRelationP

137 <|> makeRelationP

139 <|> relVarP

138 <|> relVarP

140

139

141−restrictionPredicateP :: Parser RestrictionPredicateExpr

140+restrictionPredicateP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

142restrictionPredicateP = makeExprParser predicateTerm predicateOperators

141restrictionPredicateP = makeExprParser predicateTerm predicateOperators

143 where

142 where

144 predicateOperators = [

143 predicateOperators = [

@@ -152,40 +151,40 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

152 <|> try relationalBooleanExprP

151 <|> try relationalBooleanExprP

153

152

154

153

155−relationalBooleanExprP :: Parser RestrictionPredicateExpr

154+relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

156relationalBooleanExprP = do

155relationalBooleanExprP = do

157 relexpr <- relExprP

156 relexpr <- relExprP

158 return $ RelationalExprPredicate relexpr

157 return $ RelationalExprPredicate relexpr

159

158

160−restrictionAttributeEqualityP :: Parser RestrictionPredicateExpr

159+restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

161restrictionAttributeEqualityP = do

160restrictionAttributeEqualityP = do

162 attributeName <- identifier

161 attributeName <- identifier

163 reservedOp "="

162 reservedOp "="

164 atomexpr <- atomExprP

163 atomexpr <- atomExprP

165 return $ AttributeEqualityPredicate attributeName atomexpr

164 return $ AttributeEqualityPredicate attributeName atomexpr

166

165

167−restrictionAtomExprP :: Parser RestrictionPredicateExpr --atoms which are of type "boolean"

166+restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

168restrictionAtomExprP = do

167restrictionAtomExprP = do

169 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

168 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

170 AtomExprPredicate <$> atomExprP

169 AtomExprPredicate <$> atomExprP

171

170

172−multiTupleExpressionP :: Parser [ExtendTupleExpr]

171+multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]

173multiTupleExpressionP = sepBy extendTupleExpressionP comma

172multiTupleExpressionP = sepBy extendTupleExpressionP comma

174

173

175−extendTupleExpressionP :: Parser ExtendTupleExpr

174+extendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

176extendTupleExpressionP = attributeExtendTupleExpressionP

175extendTupleExpressionP = attributeExtendTupleExpressionP

177

176

178−attributeExtendTupleExpressionP :: Parser ExtendTupleExpr

177+attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

179attributeExtendTupleExpressionP = do

178attributeExtendTupleExpressionP = do

180 newAttr <- identifier

179 newAttr <- identifier

181 reservedOp ":="

180 reservedOp ":="

182 atom <- atomExprP

181 atom <- atomExprP

183 return $ AttributeExtendTupleExpr newAttr atom

182 return $ AttributeExtendTupleExpr newAttr atom

184

183

185−atomExprP :: Parser AtomExpr

184+atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

186atomExprP = consumeAtomExprP True

185atomExprP = consumeAtomExprP True

187

186

188−consumeAtomExprP :: Bool -> Parser AtomExpr

187+consumeAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

189consumeAtomExprP consume = try functionAtomExprP <|>

188consumeAtomExprP consume = try functionAtomExprP <|>

190 try (parens (constructedAtomExprP True)) <|>

189 try (parens (constructedAtomExprP True)) <|>

191 constructedAtomExprP consume <|>

190 constructedAtomExprP consume <|>

@@ -193,20 +192,21 @@ consumeAtomExprP consume = try functionAtomExprP <|>

193 nakedAtomExprP <|>

192 nakedAtomExprP <|>

194 relationalAtomExprP

193 relationalAtomExprP

195

194

196−attributeAtomExprP :: Parser AtomExpr

195+attributeAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

197attributeAtomExprP = do

196attributeAtomExprP = do

198 _ <- string "@"

197 _ <- string "@"

199 attrName <- identifier

198 attrName <- identifier

200 return $ AttributeAtomExpr attrName

199 return $ AttributeAtomExpr attrName

201

200

202−nakedAtomExprP :: Parser AtomExpr

201+nakedAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

203nakedAtomExprP = NakedAtomExpr <$> atomP

202nakedAtomExprP = NakedAtomExpr <$> atomP

204

203

205−constructedAtomExprP :: Bool -> Parser AtomExpr

204+constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

206constructedAtomExprP consume = do

205constructedAtomExprP consume = do

207 dConsName <- capitalizedIdentifier

206 dConsName <- capitalizedIdentifier

208 dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []

207 dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []

208+ marker <- parseMarkerP

209− pure $ ConstructedAtomExpr dConsName dConsArgs ()

209+ pure $ ConstructedAtomExpr dConsName dConsArgs marker

210

211-- used only for primitive type parsing ?

212atomP :: Parser Atom

@@ -215,13 +215,14 @@ atomP = stringAtomP <|>

215 intAtomP <|>

216 boolAtomP

217

218−functionAtomExprP :: Parser AtomExpr

218+functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

219functionAtomExprP = do

220 funcName <- identifier

221 argList <- parens (sepBy atomExprP comma)

222+ marker <- parseMarkerP

222− return $ FunctionAtomExpr funcName argList ()

223+ return $ FunctionAtomExpr funcName argList marker

223

224

224−relationalAtomExprP :: Parser AtomExpr

225+relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

225relationalAtomExprP = RelationAtomExpr <$> relExprP

226relationalAtomExprP = RelationAtomExpr <$> relExprP

226

227

227stringAtomP :: Parser Atom

228stringAtomP :: Parser Atom

@@ -240,5 +241,5 @@ boolAtomP = do

240 val <- char 't' <|> char 'f'

241 val <- char 't' <|> char 'f'

241 return $ BoolAtom (val == 't')

242 return $ BoolAtom (val == 't')

242

243

243−relationAtomExprP :: Parser AtomExpr

244+relationAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

244relationAtomExprP = RelationAtomExpr <$> makeRelationP

245relationAtomExprP = RelationAtomExpr <$> makeRelationP

src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs+3−241

@@ -1,30 +1,18 @@

1{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

2module TutorialD.Interpreter.TransGraphRelationalOperator where

3module TutorialD.Interpreter.TransGraphRelationalOperator where

3−import ProjectM36.Base

4import ProjectM36.TransGraphRelationalExpression

5import ProjectM36.TransactionGraph

6−import ProjectM36.MiscUtils

7import qualified ProjectM36.Client as C

6import qualified ProjectM36.Client as C

9import TutorialD.Interpreter.Base

8import TutorialD.Interpreter.Base

10−import TutorialD.Interpreter.Types

9+import TutorialD.Interpreter.RelationalExpr

12import Text.Megaparsec

11import Text.Megaparsec

13import Text.Megaparsec.Text

12import Text.Megaparsec.Text

14−import Text.Megaparsec.Expr

16−import Control.Applicative

17−import qualified Data.Set as S

18−import qualified Data.Map as M

19import qualified Data.Text as T

14import qualified Data.Text as T

20−import Data.List (sort)

22−class RelationalMarkerExpr a where

23− parseMarkerP :: Parser a

24−

25−instance RelationalMarkerExpr () where

26− parseMarkerP = pure ()

27−

28instance RelationalMarkerExpr TransactionIdLookup where

16instance RelationalMarkerExpr TransactionIdLookup where

29 parseMarkerP = string "@" *> transactionIdLookupP

17 parseMarkerP = string "@" *> transactionIdLookupP

@@ -40,233 +28,7 @@ transGraphRelationalOpP = showTransGraphRelationalOpP

40showTransGraphRelationalOpP :: Parser TransGraphRelationalOperator

28showTransGraphRelationalOpP :: Parser TransGraphRelationalOperator

41showTransGraphRelationalOpP = do

29showTransGraphRelationalOpP = do

42 reservedOp ":showtransgraphexpr"

30 reservedOp ":showtransgraphexpr"

43− ShowTransGraphRelation <$> relExprP

31+ ShowTransGraphRelation <$> relExprP

44−

45−--used in projection

46−attributeListP :: Parser AttributeNames

47−attributeListP = do

48− but <- try (string "all but " <* spaceConsumer) <|> string ""

49− let constructor = if but == "" then AttributeNames else InvertedAttributeNames

50− attrs <- sepBy identifier comma

51− pure $ constructor (S.fromList attrs)

52−

53−makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

54−makeRelationP = do

55− reserved "relation"

56− attrExprs <- try (liftA Just makeAttributeExprsP) <|> pure Nothing

57− tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []

58− pure $ MakeRelationFromExprs attrExprs tupleExprs

59−

60−--used in relation creation

61−makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]

62−makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

63−

64−attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)

65−attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP

66−

67−--abstract data type parser- in this context, the type constructor must not include any type arguments

68−--Either Text Int

69−adTypeConstructorP :: Parser TypeConstructor

70−adTypeConstructorP = do

71− tConsName <- capitalizedIdentifier

72− tConsArgs <- many typeConstructorArgP

73− pure $ ADTypeConstructor tConsName tConsArgs

74−

75−tupleExprP :: RelationalMarkerExpr a => Parser (TupleExprBase a)

76−tupleExprP = do

77− reservedOp "tuple"

78− attrAssocs <- braces (sepBy tupleAtomExprP comma)

79− --detect duplicate attribute names

80− let dupAttrNames = dupes (sort (map fst attrAssocs))

81− if length dupAttrNames /= 0 then

82− fail ("Attribute names duplicated: " ++ show dupAttrNames)

83− else

84− pure (TupleExpr (M.fromList attrAssocs))

85−

86−tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)

87−tupleAtomExprP = do

88− attributeName <- identifier

89− atomExpr <- atomExprP

90− pure $ (attributeName, atomExpr)

91−

92−projectP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

93−projectP = do

94− attrs <- braces attributeListP

95− pure $ Project attrs

96−

97−renameClauseP :: Parser (T.Text, T.Text)

98−renameClauseP = do

99− oldAttr <- identifier

100− reservedOp "as"

101− newAttr <- identifier

102− pure $ (oldAttr, newAttr)

103−

104−renameP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

105−renameP = do

106− reservedOp "rename"

107− (oldAttr, newAttr) <- braces renameClauseP

108− return $ Rename oldAttr newAttr

109−

110−whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

111−whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)

112−

113−groupClauseP :: Parser (AttributeNames, T.Text)

114−groupClauseP = do

115− attrs <- braces attributeListP

116− reservedOp "as"

117− newAttrName <- identifier

118− return $ (attrs, newAttrName)

119−

120−groupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

121−groupP = do

122− reservedOp "group"

123− (groupAttrList, groupAttrName) <- parens groupClauseP

124− pure $ Group groupAttrList groupAttrName

125−

126−--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.

127−ungroupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

128−ungroupP = do

129− reservedOp "ungroup"

130− rvaAttrName <- identifier

131− pure $ Ungroup rvaAttrName

132−

133−extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

134−extendP = do

135− reservedOp ":"

136− tupleExpr <- braces extendTupleExpressionP

137− return $ Extend tupleExpr

138−

139−relOperators :: RelationalMarkerExpr a => [[Operator Parser (RelationalExprBase a)]]

140−relOperators = [

141− [Postfix projectP],

142− [Postfix renameP],

143− [Postfix whereClauseP],

144− [Postfix groupP],

145− [Postfix ungroupP],

146− [InfixL (reservedOp "join" >> return Join)],

147− [InfixL (reservedOp "union" >> return Union)],

148− [InfixL (reservedOp "minus" >> return Difference)],

149− [InfixN (reservedOp "=" >> return Equals)],

150− [Postfix extendP]

151− ]

152−

153−relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

154−relExprP = makeExprParser relTerm relOperators

155−

156−relVarP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

157−relVarP = RelationVariable <$> identifier <*> parseMarkerP

158−

159−relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

160−relTerm = parens relExprP

161− <|> makeRelationP

162− <|> relVarP

163−

164−restrictionPredicateP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

165−restrictionPredicateP = makeExprParser predicateTerm predicateOperators

166− where

167− predicateOperators = [

168− [Prefix (reservedOp "not" >> return NotPredicate)],

169− [InfixL (reservedOp "and" >> return AndPredicate)],

170− [InfixL (reservedOp "or" >> return OrPredicate)]

171− ]

172− predicateTerm = parens restrictionPredicateP

173− <|> try restrictionAtomExprP

174− <|> try restrictionAttributeEqualityP

175− <|> try relationalBooleanExprP

176−

177−

178−relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

179−relationalBooleanExprP = do

180− relexpr <- relExprP

181− return $ RelationalExprPredicate relexpr

182−

183−restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

184−restrictionAttributeEqualityP = do

185− attributeName <- identifier

186− reservedOp "="

187− atomexpr <- atomExprP

188− return $ AttributeEqualityPredicate attributeName atomexpr

189−

190−restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

191−restrictionAtomExprP = do

192− _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

193− AtomExprPredicate <$> atomExprP

194−

195−multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]

196−multiTupleExpressionP = sepBy extendTupleExpressionP comma

197−

198−extendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

199−extendTupleExpressionP = attributeExtendTupleExpressionP

200−

201−attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

202−attributeExtendTupleExpressionP = do

203− newAttr <- identifier

204− reservedOp ":="

205− atom <- atomExprP

206− return $ AttributeExtendTupleExpr newAttr atom

207−

208−atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

209−atomExprP = consumeAtomExprP True

210−

211−consumeAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

212−consumeAtomExprP consume = try functionAtomExprP <|>

213− try (parens (constructedAtomExprP True)) <|>

214− constructedAtomExprP consume <|>

215− attributeAtomExprP <|>

216− nakedAtomExprP <|>

217− relationalAtomExprP

218−

219−attributeAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

220−attributeAtomExprP = do

221− _ <- string "@"

222− attrName <- identifier

223− return $ AttributeAtomExpr attrName

224−

225−nakedAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

226−nakedAtomExprP = NakedAtomExpr <$> atomP

227−

228−constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

229−constructedAtomExprP consume = do

230− dConsName <- capitalizedIdentifier

231− dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []

232− marker <- parseMarkerP

233− pure $ ConstructedAtomExpr dConsName dConsArgs marker

234−

235−-- used only for primitive type parsing ?

236−atomP :: Parser Atom

237−atomP = stringAtomP <|>

238− doubleAtomP <|>

239− intAtomP <|>

240− boolAtomP

241−

242−functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

243−functionAtomExprP = do

244− funcName <- identifier

245− argList <- parens (sepBy atomExprP comma)

246− marker <- parseMarkerP

247− return $ FunctionAtomExpr funcName argList marker

248−

249−relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

250−relationalAtomExprP = RelationAtomExpr <$> relExprP

251−

252−stringAtomP :: Parser Atom

253−stringAtomP = liftA TextAtom quotedString

254−

255−doubleAtomP :: Parser Atom

256−doubleAtomP = DoubleAtom <$> (try float)

257−

258−intAtomP :: Parser Atom

259−intAtomP = do

260− i <- integer

261− return $ IntAtom (fromIntegral i)

262−

263−boolAtomP :: Parser Atom

264−boolAtomP = do

265− val <- char 't' <|> char 'f'

266− return $ BoolAtom (val == 't')

267−

268−relationAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

269−relationAtomExprP = RelationAtomExpr <$> makeRelationP

270

271evalTransGraphRelationalOp :: C.SessionId -> C.Connection -> TransGraphRelationalOperator -> IO TutorialDOperatorResult

33evalTransGraphRelationalOp :: C.SessionId -> C.Connection -> TransGraphRelationalOperator -> IO TutorialDOperatorResult

272evalTransGraphRelationalOp sessionId conn (ShowTransGraphRelation expr) = do

34evalTransGraphRelationalOp sessionId conn (ShowTransGraphRelation expr) = do