baaa5b2 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add DataFrame datatype. :showsorteddataframe <relExpr> <attrName>

baaa5b2Johnny Liao8 years ago

src/bin/TutorialD/Interpreter/Base.hs+3

compare with master

unifiedsplit

@@ -41,6 +41,8 @@ displayOpResult (DisplayParseErrorResult mPromptLength err) = do

41 pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"

42 maybe (pure ()) (TIO.putStrLn . pointyString) mPromptLength

43 TIO.putStr ("ERR:" <> errString)

44+displayOpResult (DisplayDataFrameResult dFrame) = do

45+ TIO.putStrLn (showRelation $ fromDataFrame dFrame)

45spaceConsumer :: Parser ()

47spaceConsumer :: Parser ()

46spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

48spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

@@ -127,6 +129,7 @@ data TutorialDOperatorResult = QuitResult |

127 DisplayResult StringType |

129 DisplayResult StringType |

128 DisplayIOResult (IO ()) |

130 DisplayIOResult (IO ()) |

129 DisplayRelationResult Relation |

131 DisplayRelationResult Relation |

132+ DisplayDataFrameResult DataFrame |

130 DisplayErrorResult StringType |

133 DisplayErrorResult StringType |

131 DisplayParseErrorResult (Maybe PromptLength) (ParseError Char Dec) | -- Int refers to length of prompt text

134 DisplayParseErrorResult (Maybe PromptLength) (ParseError Char Dec) | -- Int refers to length of prompt text

132 QuietSuccessResult

135 QuietSuccessResult

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+23−1

@@ -1,6 +1,8 @@

1{-# LANGUAGE GADTs #-}

2module TutorialD.Interpreter.RODatabaseContextOperator where

3import ProjectM36.Base

4+import ProjectM36.Attribute (attributeForName)

5+import ProjectM36.Relation (attributes)

4import ProjectM36.Error

6import ProjectM36.Error

5import ProjectM36.InclusionDependency

7import ProjectM36.InclusionDependency

6import qualified ProjectM36.Client as C

8import qualified ProjectM36.Client as C

@@ -26,6 +28,7 @@ data RODatabaseContextOperator where

26 ShowRelationVariables :: RODatabaseContextOperator

28 ShowRelationVariables :: RODatabaseContextOperator

27 ShowAtomFunctions :: RODatabaseContextOperator

29 ShowAtomFunctions :: RODatabaseContextOperator

28 ShowDatabaseContextFunctions :: RODatabaseContextOperator

30 ShowDatabaseContextFunctions :: RODatabaseContextOperator

31+ ShowSortedDataFrame :: RelationalExpr -> AttributeName -> RODatabaseContextOperator

29 Quit :: RODatabaseContextOperator

32 Quit :: RODatabaseContextOperator

30 deriving (Show)

33 deriving (Show)

@@ -81,6 +84,7 @@ roDatabaseContextOperatorP = typeP

81 <|> showTypesP

84 <|> showTypesP

82 <|> showAtomFunctionsP

85 <|> showAtomFunctionsP

83 <|> showDatabaseContextFunctionsP

86 <|> showDatabaseContextFunctionsP

87+ <|> showSortedDataFrameP

84 <|> quitP

88 <|> quitP

86--logically, these read-only operations could happen purely, but not if a remote call is required

90--logically, these read-only operations could happen purely, but not if a remote call is required

@@ -148,6 +152,18 @@ evalRODatabaseContextOp sessionId conn ShowDatabaseContextFunctions = do

148 Left err -> pure $ DisplayErrorResult (T.pack (show err))

152 Left err -> pure $ DisplayErrorResult (T.pack (show err))

149 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

153 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

150

154

155+evalRODatabaseContextOp sessionId conn (ShowSortedDataFrame expr attrName) = do

156+ res <- C.executeRelationalExpr sessionId conn expr

157+ case res of

158+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)

159+ Right rel -> do

160+ let attrs = attributes rel

161+ case attributeForName attrName attrs of

162+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)

163+ Right attr -> do

164+ pure $ DisplayDataFrameResult $ sortDataFrameBy attr . toDataFrame $ rel

165+

166+

151evalRODatabaseContextOp _ _ Quit = pure QuitResult

167evalRODatabaseContextOp _ _ Quit = pure QuitResult

152

168

153interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult

169interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult

@@ -155,4 +171,10 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo

155 Left err -> pure $ DisplayErrorResult (T.pack (show err))

171 Left err -> pure $ DisplayErrorResult (T.pack (show err))

156 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

172 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

157

173

158−

174+showSortedDataFrameP :: Parser RODatabaseContextOperator

175+showSortedDataFrameP = do

176+ reservedOp ":showsorteddataframe"

177+ ShowSortedDataFrame <$> relExprP <*> identifier

178+

179+

180+

src/lib/ProjectM36/Base.hs+43−6

@@ -37,7 +37,7 @@ data Atom = IntegerAtom Integer |

37 BoolAtom Bool |

38 RelationAtom Relation |

39 ConstructedAtom DataConstructorName AtomType [Atom]

40− deriving (Eq, Show, Binary, Typeable, NFData, Generic)

40+ deriving (Eq, Ord, Show, Binary, Typeable, NFData, Generic)

42instance Hashable Atom where

43 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms

@@ -77,7 +77,9 @@ data AtomType = IntAtomType |

77 TypeVariableType TypeVarName

78 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor

79 deriving (Eq, NFData, Generic, Binary, Show)

80−

80+

81+instance Ord AtomType where

82+ compare = undefined

81type TypeVarMap = M.Map TypeVarName AtomType

83type TypeVarMap = M.Map TypeVarName AtomType

83instance Hashable TypeVarMap where

85instance Hashable TypeVarMap where

@@ -122,6 +124,16 @@ instance Eq RelationTupleSet where

122

124

123instance NFData RelationTupleSet where rnf = genericRnf

125instance NFData RelationTupleSet where rnf = genericRnf

124

126

127+sortDataFrameBy :: Attribute -> DataFrame -> DataFrame

128+sortDataFrameBy attr (DataFrame attrs tupSet) =

129+ case attr `elem` attrs of

130+ True -> DataFrame attrs $ sortTupleSetBy (compareRelationTupleBy attr) tupSet

131+ False -> error $ "No such attribute: " ++ show attr

132+

133+sortTupleSetBy :: (RelationTuple -> RelationTuple -> Ordering) -> RelationTupleSet -> RelationTupleSet

134+sortTupleSetBy compare' (RelationTupleSet tuples) =

135+ RelationTupleSet $ L.sortBy compare' tuples

136+

125--the same hash must be generated for equal tuples so that the hashset equality works

137--the same hash must be generated for equal tuples so that the hashset equality works

126instance Hashable RelationTuple where

138instance Hashable RelationTuple where

127 --sanity check the tuple for attribute and tuple counts

139 --sanity check the tuple for attribute and tuple counts

@@ -145,15 +157,32 @@ instance Binary RelationTuple

145instance Eq RelationTuple where

157instance Eq RelationTuple where

146 (==) tuple1@(RelationTuple attrs1 _) tuple2@(RelationTuple attrs2 _) = attributesEqual attrs1 attrs2 && atomsEqual

158 (==) tuple1@(RelationTuple attrs1 _) tuple2@(RelationTuple attrs2 _) = attributesEqual attrs1 attrs2 && atomsEqual

147 where

159 where

148− atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) attrs of

149− Nothing -> Nothing

150− Just index -> tupVec V.!? index

151 atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) attrs1

160 atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) attrs1

152

161

162+atomForAttribute attr (RelationTuple attrs tupVec) =

163+ case V.findIndex (== attr) attrs of

164+ Nothing -> Nothing

165+ Just index -> tupVec V.!? index

166+

153instance NFData RelationTuple where rnf = genericRnf

167instance NFData RelationTuple where rnf = genericRnf

154

168

169+data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom) deriving (Eq, Show, Generic)

170+

171+compareRelationTupleBy :: Attribute -> RelationTuple -> RelationTuple -> Ordering

172+compareRelationTupleBy attr tuple1@(RelationTuple attrs1 tupVec1) tuple2@(RelationTuple attrs2 tupVec2) =

173+ case attr `elem` attrs1 && attr `elem` attrs2 of

174+ True -> compare (atomForAttribute attr tuple1) (atomForAttribute attr tuple2)

175+ False -> error "Comparing two RelationTuples by an non-existent common attribute."

176+

155data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

177data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

156

178

179+instance Ord Relation where

180+ compare (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = undefined

181+ (<) = undefined

182+ (<=) = undefined

183+ (>=) = undefined

184+ (>) = undefined

185+

157instance Eq Relation where

186instance Eq Relation where

158 Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2

187 Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2

159

188

@@ -167,7 +196,15 @@ instance Hashable Relation where

167 sortedAttrs = map snd (sortedAttributesIndices attrs)

196 sortedAttrs = map snd (sortedAttributesIndices attrs)

168

197

169instance Binary Relation

198instance Binary Relation

170−

199+

200+data DataFrame = DataFrame Attributes RelationTupleSet deriving (Show, Generic, Typeable)

201+

202+toDataFrame :: Relation -> DataFrame

203+toDataFrame (Relation attr tupSet) = DataFrame attr tupSet

204+

205+fromDataFrame :: DataFrame -> Relation

206+fromDataFrame (DataFrame attr tupSet) = Relation attr tupSet

207+

171-- | Used to represent the number of tuples in a relation.

208-- | Used to represent the number of tuples in a relation.

172data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)

209data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)

173

210