git.iko.soy/project-m36
on master help sign in
command name changed. Add limit and offset. Now the usage is :showdataframe <relExpr> orderby <attributeName> [offset <integer>] [limit <integer>]
a3de6fdJohnny Liao
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+30−10
compare with master
unifiedsplit
@@ -28,7 +28,7 @@ data RODatabaseContextOperator where
28 ShowRelationVariables :: RODatabaseContextOperator
28 ShowRelationVariables :: RODatabaseContextOperator
29 ShowAtomFunctions :: RODatabaseContextOperator
29 ShowAtomFunctions :: RODatabaseContextOperator
30 ShowDatabaseContextFunctions :: RODatabaseContextOperator
30 ShowDatabaseContextFunctions :: RODatabaseContextOperator
31− ShowSortedDataFrame :: RelationalExpr -> AttributeName -> RODatabaseContextOperator
31+ ShowDataFrame :: RelationalExpr -> AttributeName -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator
32 Quit :: RODatabaseContextOperator
32 Quit :: RODatabaseContextOperator
33 deriving (Show)
33 deriving (Show)
34
34
@@ -84,7 +84,7 @@ roDatabaseContextOperatorP = typeP
84 <|> showTypesP
84 <|> showTypesP
85 <|> showAtomFunctionsP
85 <|> showAtomFunctionsP
86 <|> showDatabaseContextFunctionsP
86 <|> showDatabaseContextFunctionsP
87− <|> showSortedDataFrameP
87+ <|> showDataFrameP
88 <|> quitP
88 <|> quitP
89
89
90--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
@@ -152,7 +152,7 @@ evalRODatabaseContextOp sessionId conn ShowDatabaseContextFunctions = do
152 Left err -> pure $ DisplayErrorResult (T.pack (show err))
152 Left err -> pure $ DisplayErrorResult (T.pack (show err))
153 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
153 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
154
154
155−evalRODatabaseContextOp sessionId conn (ShowSortedDataFrame expr attrName) = do
155+evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrName mbOffset mbLimit) = do
156 res <- C.executeRelationalExpr sessionId conn expr
156 res <- C.executeRelationalExpr sessionId conn expr
157 case res of
157 case res of
158 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
158 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
@@ -161,7 +161,10 @@ evalRODatabaseContextOp sessionId conn (ShowSortedDataFrame expr attrName) = do
161 case attributeForName attrName attrs of
161 case attributeForName attrName attrs of
162 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
162 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
163 Right attr -> do
163 Right attr -> do
164− pure $ DisplayDataFrameResult $ sortDataFrameBy attr . toDataFrame $ rel
164+ let dFrame = sortDataFrameBy attr . toDataFrame $ rel
165+ let dFrame' = maybe dFrame (`drop'` dFrame) mbOffset
166+ let dFrame'' = maybe dFrame' (`take'` dFrame') mbLimit
167+ pure $ DisplayDataFrameResult $ dFrame''
165
168
166
169
167evalRODatabaseContextOp _ _ Quit = pure QuitResult
170evalRODatabaseContextOp _ _ Quit = pure QuitResult
@@ -171,10 +174,27 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo
171 Left err -> pure $ DisplayErrorResult (T.pack (show err))
174 Left err -> pure $ DisplayErrorResult (T.pack (show err))
172 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
175 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
173
176
174−showSortedDataFrameP :: Parser RODatabaseContextOperator
177+showDataFrameP :: Parser RODatabaseContextOperator
175−showSortedDataFrameP = do
178+showDataFrameP = do
176− reservedOp ":showsorteddataframe"
179+ reservedOp ":showdataframe"
180+ relExpr <- relExprP
181+ attriName <- orderByP
182+ mbOffset <- optional offsetP
183+ mbLimit <- optional limitP
184+ pure $ ShowDataFrame relExpr attriName mbOffset mbLimit
185+
186+orderByP :: Parser AttributeName
187+orderByP = do
188+ reservedOp "orderby"
177− ShowSortedDataFrame <$> relExprP <*> identifier
189+ identifier
178−
190+
179−
191+offsetP :: Parser Integer
192+offsetP = do
193+ reservedOp "offset"
194+ integer
195+
196+limitP :: Parser Integer
197+limitP = do
198+ reservedOp "limit"
199+ integer
180
200
src/lib/ProjectM36/Base.hs+5−2
@@ -199,11 +199,14 @@ instance Binary Relation
199
199
200data DataFrame = DataFrame Attributes RelationTupleSet deriving (Show, Generic, Typeable)
200data DataFrame = DataFrame Attributes RelationTupleSet deriving (Show, Generic, Typeable)
201
201
202+take' n (DataFrame attrs (RelationTupleSet xs)) = DataFrame attrs (RelationTupleSet $ take (fromInteger n) xs)
203+drop' n (DataFrame attrs (RelationTupleSet xs)) = DataFrame attrs (RelationTupleSet $ drop (fromInteger n) xs)
204+
202toDataFrame :: Relation -> DataFrame
205toDataFrame :: Relation -> DataFrame
203−toDataFrame (Relation attr tupSet) = DataFrame attr tupSet
206+toDataFrame (Relation attrs tupSet) = DataFrame attrs tupSet
204
207
205fromDataFrame :: DataFrame -> Relation
208fromDataFrame :: DataFrame -> Relation
206−fromDataFrame (DataFrame attr tupSet) = Relation attr tupSet
209+fromDataFrame (DataFrame attrs tupSet) = Relation attrs tupSet
207
210
208-- | Used to represent the number of tuples in a relation.
211-- | Used to represent the number of tuples in a relation.
209data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)
212data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)
test/GMapAssoc.hsnew file+70
@@ -0,0 +1,70 @@
1+{-# LANGUAGE TypeFamilies #-}
2+
3+module Main where
4+
5+import Prelude hiding (lookup)
6+import Data.Char (ord)
7+import qualified Data.Map as Map
8+
9+
10+-- Generic maps as ATs
11+-- -------------------
12+
13+class GMapKey k where
14+ data GMap k :: * -> *
15+ empty :: GMap k v
16+ lookup :: k -> GMap k v -> Maybe v
17+ insert :: k -> v -> GMap k v -> GMap k v
18+
19+instance GMapKey Int where
20+ data GMap Int v = GMapInt (Map.Map Int v)
21+ empty = GMapInt Map.empty
22+ lookup k (GMapInt m) = Map.lookup k m
23+ insert k v (GMapInt m) = GMapInt (Map.insert k v m)
24+
25+instance GMapKey Char where
26+ data GMap Char v = GMapChar (GMap Int v)
27+ empty = GMapChar empty
28+ lookup k (GMapChar m) = lookup (ord k) m
29+ insert k v (GMapChar m) = GMapChar (insert (ord k) v m)
30+
31+instance GMapKey () where
32+ data GMap () v = GMapUnit (Maybe v)
33+ empty = GMapUnit Nothing
34+ lookup () (GMapUnit v) = v
35+ insert () v (GMapUnit _) = GMapUnit $ Just v
36+
37+instance (GMapKey a, GMapKey b) => GMapKey (a, b) where
38+ data GMap (a, b) v = GMapPair (GMap a (GMap b v))
39+ empty = GMapPair empty
40+ lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b
41+ insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of
42+ Nothing -> insert a (insert b v empty) gm
43+ Just gm2 -> insert a (insert b v gm2 ) gm
44+
45+instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where
46+ data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v)
47+ empty = GMapEither empty empty
48+ lookup (Left a) (GMapEither gm1 _gm2) = lookup a gm1
49+ lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2
50+ insert (Left a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2
51+ insert (Right a) v (GMapEither gm1 gm2) = GMapEither gm1 (insert a v gm2)
52+
53+-- Test code
54+-- ---------
55+
56+nonsence :: GMap Bool String
57+nonsence = undefined
58+
59+-- a combinator!! cool!
60+--
61+myGMap :: GMap (Int, Either Char ()) String
62+myGMap = insert (5, Left 'c') "(5, Left 'c')" $
63+ insert (4, Right ()) "(4, Right ())" $
64+ insert (5, Right ()) "This is the one!" $
65+ insert (5, Right ()) "This is the two!" $
66+ insert (6, Right ()) "(6, Right ())" $
67+ insert (5, Left 'a') "(5, Left 'a')" $
68+ empty
69+main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap
70+