git.iko.soy/project-m36
on master help sign in
add order by muliple attributes and with ASC/DESC order.
commitad6ea6b1ca42dbb51347ea9a74f06a8ef72ef470 authorJohnny Liao <dycan0716@gmail.com> dateTue 19 Jun 2018, 22:18 (8 years ago) parenta3de6fd
3 files changed+61−100
compare with master
unifiedsplit
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+27−15 src/lib/ProjectM36/Base.hs+34−15 test/GMapAssoc.hs−70
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+27−15
@@ -28,7 +28,7 @@ data RODatabaseContextOperator where
2828 ShowRelationVariables :: RODatabaseContextOperator
2929 ShowAtomFunctions :: RODatabaseContextOperator
3030 ShowDatabaseContextFunctions :: RODatabaseContextOperator
31− ShowDataFrame :: RelationalExpr -> AttributeName -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator
31+ ShowDataFrame :: RelationalExpr -> [AttributeOrderExpr] -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator
3232 Quit :: RODatabaseContextOperator
3333 deriving (Show)
3434
@@ -152,19 +152,26 @@ 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 (ShowDataFrame expr attrName mbOffset mbLimit) = do
155+evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrOrdersExpr mbOffset mbLimit) = do
156156 res <- C.executeRelationalExpr sessionId conn expr
157157 case res of
158158 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
159159 Right rel -> do
160− let attrs = attributes rel
161− case attributeForName attrName attrs of
160+ let relAttrs = attributes rel
161+ attrName (AttributeOrderExpr name _) = name
162+ order (AttributeOrderExpr _ ord) = ord
163+ orders = map order attrOrdersExpr
164+ attributeForName' = flip attributeForName relAttrs
165+ attrNames = map attrName attrOrdersExpr
166+ verified = forM attrNames attributeForName'
167+ case verified of
162168 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
163− Right attr -> do
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''
169+ Right attrs -> do
170+ let attrOrders = map (\(attr',order')->AttributeOrder attr' order') (zip attrs orders)
171+ let dFrame = sortDataFrameBy attrOrders . toDataFrame $ rel
172+ let dFrame' = maybe dFrame (`drop'` dFrame) mbOffset
173+ let dFrame'' = maybe dFrame' (`take'` dFrame') mbLimit
174+ pure $ DisplayDataFrameResult $ dFrame''
168175
169176
170177evalRODatabaseContextOp _ _ Quit = pure QuitResult
@@ -178,15 +185,12 @@ showDataFrameP :: Parser RODatabaseContextOperator
178185showDataFrameP = do
179186 reservedOp ":showdataframe"
180187 relExpr <- relExprP
181− attriName <- orderByP
188+ reservedOp "orderby"
189+ attrOrdersExpr <- attrOrdersExprP
182190 mbOffset <- optional offsetP
183191 mbLimit <- optional limitP
184− pure $ ShowDataFrame relExpr attriName mbOffset mbLimit
192+ pure $ ShowDataFrame relExpr attrOrdersExpr mbOffset mbLimit
185193
186−orderByP :: Parser AttributeName
187−orderByP = do
188− reservedOp "orderby"
189− identifier
190194
191195offsetP :: Parser Integer
192196offsetP = do
@@ -198,3 +202,11 @@ limitP = do
198202 reservedOp "limit"
199203 integer
200204
205+attrOrdersExprP :: Parser [AttributeOrderExpr]
206+attrOrdersExprP = braces (sepBy attrOrderExprP comma)
207+
208+attrOrderExprP :: Parser AttributeOrderExpr
209+attrOrderExprP = AttributeOrderExpr <$> identifier <*> orderP
210+
211+orderP :: Parser Order
212+orderP = (try $ reservedOp "ASC" >> pure ASC) <|> (try $ reservedOp "DESC" >> pure DESC) <|> pure ASC
src/lib/ProjectM36/Base.hs+34−15
@@ -124,15 +124,18 @@ instance Eq RelationTupleSet where
124124
125125instance NFData RelationTupleSet where rnf = genericRnf
126126
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
132127
133−sortTupleSetBy :: (RelationTuple -> RelationTuple -> Ordering) -> RelationTupleSet -> RelationTupleSet
134−sortTupleSetBy compare' (RelationTupleSet tuples) =
135− RelationTupleSet $ L.sortBy compare' tuples
128+data AttributeOrderExpr = AttributeOrderExpr AttributeName Order deriving(Show)
129+data AttributeOrder = AttributeOrder Attribute Order deriving (Show)
130+data Order = ASC | DESC deriving (Eq,Show)
131+
132+sortDataFrameBy :: [AttributeOrder] -> DataFrame -> DataFrame
133+sortDataFrameBy attrOrders (DataFrame attrs tuples) =
134+ DataFrame attrs $ sortTuplesBy (compareRelationTupleByAttributeOrders attrOrders) tuples
135+
136+sortTuplesBy :: (RelationTuple -> RelationTuple -> Ordering) -> [RelationTuple] -> [RelationTuple]
137+sortTuplesBy compare' tuples =
138+ L.sortBy compare' tuples
136139
137140--the same hash must be generated for equal tuples so that the hashset equality works
138141instance Hashable RelationTuple where
@@ -168,8 +171,21 @@ instance NFData RelationTuple where rnf = genericRnf
168171
169172data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom) deriving (Eq, Show, Generic)
170173
171−compareRelationTupleBy :: Attribute -> RelationTuple -> RelationTuple -> Ordering
172−compareRelationTupleBy attr tuple1@(RelationTuple attrs1 tupVec1) tuple2@(RelationTuple attrs2 tupVec2) =
174+compareRelationTupleByAttributeOrders :: [AttributeOrder] -> RelationTuple -> RelationTuple -> Ordering
175+compareRelationTupleByAttributeOrders attributeOrders tup1 tup2 =
176+ let order_ (AttributeOrder _ ord) = ord
177+ attr_ (AttributeOrder attr _) = attr
178+ compare' (AttributeOrder attr order) = if order == DESC
179+ then compareRelationTupleByOneAttribute attr tup2 tup1
180+ else compareRelationTupleByOneAttribute attr tup1 tup2
181+ res = map compare' attributeOrders in
182+ case L.find (/=EQ) res of
183+ Nothing -> EQ
184+ Just order -> order
185+
186+
187+compareRelationTupleByOneAttribute :: Attribute -> RelationTuple -> RelationTuple -> Ordering
188+compareRelationTupleByOneAttribute attr tuple1@(RelationTuple attrs1 tupVec1) tuple2@(RelationTuple attrs2 tupVec2) =
173189 case attr `elem` attrs1 && attr `elem` attrs2 of
174190 True -> compare (atomForAttribute attr tuple1) (atomForAttribute attr tuple2)
175191 False -> error "Comparing two RelationTuples by an non-existent common attribute."
@@ -197,16 +213,19 @@ instance Hashable Relation where
197213
198214instance Binary Relation
199215
200−data DataFrame = DataFrame Attributes RelationTupleSet deriving (Show, Generic, Typeable)
216+data DataFrame = DataFrame Attributes [RelationTuple] deriving (Show, Generic, Typeable)
217+
218+take' :: Integer -> DataFrame -> DataFrame
219+take' n (DataFrame attrs tuples) = DataFrame attrs (take (fromInteger n) tuples)
201220
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)
221+drop' :: Integer -> DataFrame -> DataFrame
222+drop' n (DataFrame attrs tuples) = DataFrame attrs (drop (fromInteger n) tuples)
204223
205224toDataFrame :: Relation -> DataFrame
206−toDataFrame (Relation attrs tupSet) = DataFrame attrs tupSet
225+toDataFrame (Relation attrs (RelationTupleSet tuples)) = DataFrame attrs tuples
207226
208227fromDataFrame :: DataFrame -> Relation
209−fromDataFrame (DataFrame attrs tupSet) = Relation attrs tupSet
228+fromDataFrame (DataFrame attrs tuples) = Relation attrs (RelationTupleSet tuples)
210229
211230-- | Used to represent the number of tuples in a relation.
212231data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)
test/GMapAssoc.hsdeleted−70
@@ -1,70 +0,0 @@
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−