ad6ea6b · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add order by muliple attributes and with ASC/DESC order.

ad6ea6bJohnny Liao8 years ago

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+27−15

compare with master

unifiedsplit

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

28 ShowRelationVariables :: RODatabaseContextOperator

29 ShowAtomFunctions :: RODatabaseContextOperator

30 ShowDatabaseContextFunctions :: RODatabaseContextOperator

31− ShowDataFrame :: RelationalExpr -> AttributeName -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator

31+ ShowDataFrame :: RelationalExpr -> [AttributeOrderExpr] -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator

32 Quit :: RODatabaseContextOperator

33 deriving (Show)

@@ -152,19 +152,26 @@ evalRODatabaseContextOp sessionId conn ShowDatabaseContextFunctions = do

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

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

154

155−evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrName mbOffset mbLimit) = do

155+evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrOrdersExpr mbOffset mbLimit) = 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

160+ let relAttrs = attributes rel

161− case attributeForName attrName attrs of

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

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

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

163− Right attr -> do

169+ Right attrs -> do

170+ let attrOrders = map (\(attr',order')->AttributeOrder attr' order') (zip attrs orders)

164− let dFrame = sortDataFrameBy attr . toDataFrame $ rel

171+ let dFrame = sortDataFrameBy attrOrders . toDataFrame $ rel

165− let dFrame' = maybe dFrame (`drop'` dFrame) mbOffset

172+ let dFrame' = maybe dFrame (`drop'` dFrame) mbOffset

166− let dFrame'' = maybe dFrame' (`take'` dFrame') mbLimit

173+ let dFrame'' = maybe dFrame' (`take'` dFrame') mbLimit

167− pure $ DisplayDataFrameResult $ dFrame''

174+ pure $ DisplayDataFrameResult $ dFrame''

168

175

169

176

170evalRODatabaseContextOp _ _ Quit = pure QuitResult

177evalRODatabaseContextOp _ _ Quit = pure QuitResult

@@ -178,15 +185,12 @@ showDataFrameP :: Parser RODatabaseContextOperator

178showDataFrameP = do

185showDataFrameP = do

179 reservedOp ":showdataframe"

186 reservedOp ":showdataframe"

180 relExpr <- relExprP

187 relExpr <- relExprP

181− attriName <- orderByP

188+ reservedOp "orderby"

189+ attrOrdersExpr <- attrOrdersExprP

182 mbOffset <- optional offsetP

190 mbOffset <- optional offsetP

183 mbLimit <- optional limitP

191 mbLimit <- optional limitP

184− pure $ ShowDataFrame relExpr attriName mbOffset mbLimit

192+ pure $ ShowDataFrame relExpr attrOrdersExpr mbOffset mbLimit

185

193

186−orderByP :: Parser AttributeName

187−orderByP = do

188− reservedOp "orderby"

189− identifier

190

194

191offsetP :: Parser Integer

195offsetP :: Parser Integer

192offsetP = do

196offsetP = do

@@ -198,3 +202,11 @@ limitP = do

198 reservedOp "limit"

202 reservedOp "limit"

199 integer

203 integer

200

204

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

124

125instance NFData RelationTupleSet where rnf = genericRnf

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

127

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+

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

136+sortTuplesBy :: (RelationTuple -> RelationTuple -> Ordering) -> [RelationTuple] -> [RelationTuple]

134−sortTupleSetBy compare' (RelationTupleSet tuples) =

137+sortTuplesBy compare' tuples =

135− RelationTupleSet $ L.sortBy compare' tuples

138+ L.sortBy compare' tuples

136

139

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

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

138instance Hashable RelationTuple where

141instance Hashable RelationTuple where

@@ -168,8 +171,21 @@ instance NFData RelationTuple where rnf = genericRnf

168

171

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

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

170

173

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+

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

187+compareRelationTupleByOneAttribute :: Attribute -> RelationTuple -> RelationTuple -> Ordering

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

188+compareRelationTupleByOneAttribute attr tuple1@(RelationTuple attrs1 tupVec1) tuple2@(RelationTuple attrs2 tupVec2) =

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

189 case attr `elem` attrs1 && attr `elem` attrs2 of

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

190 True -> compare (atomForAttribute attr tuple1) (atomForAttribute attr tuple2)

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

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

@@ -197,16 +213,19 @@ instance Hashable Relation where

197

213

198instance Binary Relation

214instance Binary Relation

199

215

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)

201

220

202−take' n (DataFrame attrs (RelationTupleSet xs)) = DataFrame attrs (RelationTupleSet $ take (fromInteger n) xs)

221+drop' :: Integer -> DataFrame -> DataFrame

203−drop' n (DataFrame attrs (RelationTupleSet xs)) = DataFrame attrs (RelationTupleSet $ drop (fromInteger n) xs)

222+drop' n (DataFrame attrs tuples) = DataFrame attrs (drop (fromInteger n) tuples)

204

223

205toDataFrame :: Relation -> DataFrame

224toDataFrame :: Relation -> DataFrame

206−toDataFrame (Relation attrs tupSet) = DataFrame attrs tupSet

225+toDataFrame (Relation attrs (RelationTupleSet tuples)) = DataFrame attrs tuples

207

226

208fromDataFrame :: DataFrame -> Relation

227fromDataFrame :: DataFrame -> Relation

209−fromDataFrame (DataFrame attrs tupSet) = Relation attrs tupSet

228+fromDataFrame (DataFrame attrs tuples) = Relation attrs (RelationTupleSet tuples)

210

229

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

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

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

231data 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−