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>]
commita3de6fd60049c0448f0221e236a56087cb3c93bb authorJohnny Liao <dycan0716@gmail.com> dateTue 19 Jun 2018, 18:41 (8 years ago) parentbaaa5b2
3 files changed+105−12
compare with master
unifiedsplit
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+30−10 src/lib/ProjectM36/Base.hs+5−2 test/GMapAssoc.hs+70
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+30−10
@@ -28,7 +28,7 @@ data RODatabaseContextOperator where
2828 ShowRelationVariables :: RODatabaseContextOperator
2929 ShowAtomFunctions :: RODatabaseContextOperator
3030 ShowDatabaseContextFunctions :: RODatabaseContextOperator
31− ShowSortedDataFrame :: RelationalExpr -> AttributeName -> RODatabaseContextOperator
31+ ShowDataFrame :: RelationalExpr -> AttributeName -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator
3232 Quit :: RODatabaseContextOperator
3333 deriving (Show)
3434
@@ -84,7 +84,7 @@ roDatabaseContextOperatorP = typeP
8484 <|> showTypesP
8585 <|> showAtomFunctionsP
8686 <|> showDatabaseContextFunctionsP
87− <|> showSortedDataFrameP
87+ <|> showDataFrameP
8888 <|> quitP
8989
9090--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
152152 Left err -> pure $ DisplayErrorResult (T.pack (show err))
153153 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
154154
155−evalRODatabaseContextOp sessionId conn (ShowSortedDataFrame expr attrName) = do
155+evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrName mbOffset mbLimit) = do
156156 res <- C.executeRelationalExpr sessionId conn expr
157157 case res of
158158 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
@@ -161,7 +161,10 @@ evalRODatabaseContextOp sessionId conn (ShowSortedDataFrame expr attrName) = do
161161 case attributeForName attrName attrs of
162162 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
163163 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''
165168
166169
167170evalRODatabaseContextOp _ _ Quit = pure QuitResult
@@ -171,10 +174,27 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo
171174 Left err -> pure $ DisplayErrorResult (T.pack (show err))
172175 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
173176
174−showSortedDataFrameP :: Parser RODatabaseContextOperator
175−showSortedDataFrameP = do
176− reservedOp ":showsorteddataframe"
177− ShowSortedDataFrame <$> relExprP <*> identifier
178−
179−
177+showDataFrameP :: Parser RODatabaseContextOperator
178+showDataFrameP = do
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"
189+ identifier
190+
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
180200
src/lib/ProjectM36/Base.hs+5−2
@@ -199,11 +199,14 @@ instance Binary Relation
199199
200200data DataFrame = DataFrame Attributes RelationTupleSet deriving (Show, Generic, Typeable)
201201
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+
202205toDataFrame :: Relation -> DataFrame
203−toDataFrame (Relation attr tupSet) = DataFrame attr tupSet
206+toDataFrame (Relation attrs tupSet) = DataFrame attrs tupSet
204207
205208fromDataFrame :: DataFrame -> Relation
206−fromDataFrame (DataFrame attr tupSet) = Relation attr tupSet
209+fromDataFrame (DataFrame attrs tupSet) = Relation attrs tupSet
207210
208211-- | Used to represent the number of tuples in a relation.
209212data 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+