2d0842b · project-m36 · git.iko.soy

git.iko.soy/project-m36

refactor project file hierarchy and clean up some warnings

commit2d0842b96d2ee0f6ea41c4be61b7205de1e13d2a authorAgentM <agentm@themactionfaction.com> dateTue 21 Apr 2015, 15:45 (12 years ago) parent694fd44

21 files changed+257−221

compare with master

unifiedsplit

ProjectM36/Atom.hs+4 RelationAttribute.hs → ProjectM36/Attribute.hs+5−5 RelationType.hs → ProjectM36/Base.hs+1−1 RelationalError.hs → ProjectM36/Error.hs+2−4 Relation.hs → ProjectM36/Relation.hs+43−30 RelationHTML.hs → ProjectM36/Relation/Show/HTML.hs+7−7 RelationTerm.hs → ProjectM36/Relation/Show/Term.hs+9−8 RelationExpr.hs → ProjectM36/RelationalExpression.hs+53−50 RelationStaticOptimizer.hs → ProjectM36/StaticOptimizer.hs+21−22 RelationalTransaction.hs → ProjectM36/Transaction.hs+12−11 RelationalTransactionShow.hs → ProjectM36/Transaction/Show.hs+12−12 RelationTuple.hs → ProjectM36/Tuple.hs+6−5 RelationTupleSet.hs → ProjectM36/TupleSet.hs+8−5 RelationAtom.hs−4 RelationalInclusionDependency.hs−5 TutorialDInterpreter.hs → TutorialD/Interpreter.hs+24−24 tutd.hs → TutorialD/tutd.hs+4−4 project-m36.cabal+30−7 RelationTest.hs → test/Relation/Basic.hs+5−6 RelationStaticOptimizerTest.hs → test/Relation/StaticOptimizer.hs+5−5 TutorialDInterpreterTest.hs → test/TutorialD/Interpreter.hs+6−6

ProjectM36/Atom.hsnew file+4

@@ -0,0 +1,4 @@

1+module ProjectM36.Atom where

2+--import ProjectM36.Base

3+--import ProjectM36.Attribute

RelationAttribute.hs → ProjectM36/Attribute.hsrenamed+5−5

@@ -1,12 +1,11 @@

1−module RelationAttribute where

2−import RelationType

1+module ProjectM36.Attribute where

2+import ProjectM36.Base

33import qualified Data.Map as M

44import qualified Data.Set as S

55import qualified Data.List as L

6−import Debug.Trace

87renameAttribute :: AttributeName -> Attribute -> Attribute

9−renameAttribute newAttrName (Attribute oldAttrName typeo) = Attribute newAttrName typeo

8+renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo

109

1110remapWithAttributes :: S.Set AttributeName -> M.Map AttributeName Atom -> M.Map AttributeName Atom

1211remapWithAttributes attrs m = M.intersection m hollowMap

@@ -32,12 +31,13 @@ matchingAttributeNameSet = S.intersection

3231

3332

3433-- this is sorted so the tuples know in which order to output- the ordering is arbitrary

34+sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]

3535sortedAttributeNameList attrNameSet= L.sort $ S.toList attrNameSet

3636

3737-- take two attribute sets and return an attribute set with the attributes which do not match

3838-- bug: missing attributes don't show up (?)

3939attributesDifference :: Attributes -> Attributes -> Attributes

40−attributesDifference attrA attrB = trace (show attrA ++ "\n" ++ show attrB) (M.union mismatchA missingB)

40+attributesDifference attrA attrB = M.union mismatchA missingB

4141 where

4242 mismatchA = M.foldrWithKey folder M.empty attrA

4343 missingB = M.difference attrA attrB

RelationType.hs → ProjectM36/Base.hsrenamed+1−1

@@ -1,5 +1,5 @@

11{-# LANGUAGE GADTs #-}

2−module RelationType where

2+module ProjectM36.Base where

33import qualified Data.Map as M

44import qualified Data.HashSet as HS

55import qualified Data.Hashable as Hash

RelationalError.hs → ProjectM36/Error.hsrenamed+2−4

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

1−module RelationalError where

2−import RelationType

1+module ProjectM36.Error where

2+import ProjectM36.Base

33import qualified Data.UUID as U

4−import qualified Data.Set as S

5−

75data RelationalError = NoSuchAttributeNameError String

86 | TupleAttributeCountMismatchError Int --attribute name

Relation.hs → ProjectM36/Relation.hsrenamed+43−30

@@ -1,16 +1,16 @@

11-- this is an implementation of the Relation typeclass which creates a GADT DSL

22{-# LANGUAGE GADTs,ExistentialQuantification,NoImplicitPrelude #-}

3−module Relation where

3+module ProjectM36.Relation where

44import qualified Data.Map as M

55import qualified Data.Set as S

66import qualified Data.HashSet as HS

77import Control.Monad

9−import RelationType

10−import RelationTuple

11−import RelationAttribute

12−import RelationTupleSet

13−import RelationalError

9+import ProjectM36.Base

10+import ProjectM36.Tuple

11+import ProjectM36.Attribute

12+import ProjectM36.TupleSet

13+import ProjectM36.Error

1414import Prelude hiding (join)

1515

1616attributes :: Relation -> Attributes

@@ -47,10 +47,16 @@ mkRelation attrs tupleSet = do

4747 Left err -> Left err

4848 Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

4949

50+relationTrue :: Relation

5051relationTrue = Relation M.empty $ HS.singleton (RelationTuple M.empty)

52+

53+relationFalse :: Relation

5154relationFalse = Relation M.empty emptyTupleSet

5255

56+madeTrue :: Either RelationalError Relation

5357madeTrue = mkRelation M.empty (HS.fromList [])

58+

59+madeFalse :: Either RelationalError Relation

5460madeFalse = mkRelation M.empty emptyTupleSet

5561

5662--used for predicate filtering- instead of allowing for tuple types to be floating around in Tutorial D, just created a "singleton value" relation with cardinality and arity 1 for tuple atom comparison purposes

@@ -64,7 +70,7 @@ singletonValueFromRelation rel@(Relation _ tupSet) = if cardinality rel /= Count

6470 where

6571 value = snd $ head $ M.toList tupMap

6672 tupMap = tup2Map $ head (HS.toList tupSet)

67− tup2Map (RelationTuple tupMap) = tupMap

73+ tup2Map (RelationTuple tupmap) = tupmap

6874

6975union :: Relation -> Relation -> Either RelationalError Relation

7076union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

@@ -76,7 +82,7 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

7682 newtuples = HS.union tupSet1 tupSet2

7783

7884project :: S.Set AttributeName -> Relation -> Either RelationalError Relation

79−project projectionAttrNames rel@(Relation oldattrs rtuples) =

85+project projectionAttrNames rel =

8086 if not $ attributeNamesContained projectionAttrNames (attributeNames rel)

8187 then Left $ AttributeNameMismatchError ""

8288 else

@@ -86,10 +92,10 @@ project projectionAttrNames rel@(Relation oldattrs rtuples) =

8692 folder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

8793 folder tupleToProject acc = case acc of

8894 Left err -> Left err

89− Right acc -> union acc (Relation newAttrs (HS.singleton (tupleProject projectionAttrNames tupleToProject)))

95+ Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject projectionAttrNames tupleToProject)))

9096

9197tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple

92−tupleProject projectAttrs tupleIn@(RelationTuple tupleInMap) = RelationTuple $ M.filterWithKey attrFilter tupleInMap

98+tupleProject projectAttrs (RelationTuple tupleInMap) = RelationTuple $ M.filterWithKey attrFilter tupleInMap

9399 where

94100 attrFilter key _ = S.member key projectAttrs

95101

@@ -141,7 +147,7 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

141147

142148--algorithm: self-join with image relation

143149group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

144−group groupAttrNames newAttrName rel@(Relation attrs tupleSet) = do

150+group groupAttrNames newAttrName rel = do

145151 nonGroupProjection <- project nonGroupAttrNames rel

146152 relFold folder (Right $ Relation newAttrs emptyTupleSet) nonGroupProjection

147153 where

@@ -150,18 +156,18 @@ group groupAttrNames newAttrName rel@(Relation attrs tupleSet) = do

150156 nonGroupAttrNames = nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)

151157 folder tupleIn acc = case acc of

152158 Left err -> Left err

153− Right acc -> union acc (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))

159+ Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))

154160 matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of

155− Right rel -> RelationTuple $ M.singleton newAttrName (RelationAtom rel)

161+ Right rel2 -> RelationTuple $ M.singleton newAttrName (RelationAtom rel2)

156162 Left _ -> undefined

157163

158164--help restriction function

159165--returns a subrelation of

160166restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation

161−restrictEq (RelationTuple tupMap) rel = restrict filter rel

167+restrictEq (RelationTuple tupMap) rel = restrict rfilter rel

162168 where

163− filter :: RelationTuple -> Bool

164− filter (RelationTuple tupMap2) = M.isSubmapOf tupMap tupMap2

169+ rfilter :: RelationTuple -> Bool

170+ rfilter (RelationTuple tupMap2) = M.isSubmapOf tupMap tupMap2

165171

166172-- unwrap relation-valued attribute

167173-- return error if relval attrs and nongroup attrs overlap

@@ -199,12 +205,12 @@ tupleUngroup relvalAttrName newAttrs tuple@(RelationTuple tupMap) = case (tupMap

199205

200206--this is a hack needed because the relation attributes are untyped so we must dig into the relval to get the attribute names

201207attributesForRelval :: AttributeName -> Relation -> Attributes

202−attributesForRelval relvalAttrName relIn@(Relation attrs tupleSet) = attributes relvalRelation

208+attributesForRelval relvalAttrName (Relation _ tupleSet) = attributes relvalRelation

203209 where

204210 --this is only temporarily needed until the Relation stores the types of the columns as data- hack alert

205211 --find a tuple with attributes to steal to ungroup

206212 oneTuple :: RelationTupleSet -> RelationTuple

207− oneTuple tupleSet = head $ HS.toList $ HS.filter (\tup@(RelationTuple tupMap) -> M.size tupMap > 0) tupleSet

213+ oneTuple tupSet = head $ HS.toList $ HS.filter (\(RelationTuple tupMap) -> M.size tupMap > 0) tupSet

208214 relvalRelation = unsafeRelValFromAtom $ tupleAtomForAttribute (oneTuple tupleSet) relvalAttrName

209215 where

210216 unsafeRelValFromAtom :: Atom -> Relation

@@ -213,7 +219,7 @@ attributesForRelval relvalAttrName relIn@(Relation attrs tupleSet) = attributes

213219 unsafeRelValFromAtom (IntAtom _) = undefined

214220

215221restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relation

216−restrict filter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter filter tupset

222+restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

217223

218224--joins on columns with the same name- use rename to avoid this- base case: cartesian product

219225--after changing from string atoms, there needs to be a type-checking step!

@@ -243,17 +249,18 @@ relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Eith

243249relMogrify mapper newAttributes (Relation _ tupSet) = mkRelation newAttributes (HS.map mapper tupSet)

244250

245251relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

246−relFold folder acc (Relation attrs tupleSet) = HS.foldr folder acc tupleSet

252+relFold folder acc (Relation _ tupleSet) = HS.foldr folder acc tupleSet

247253

248254--image relation as defined by CJ Date

249255--given tupleA and relationB, return restricted relation where tuple attributes are not the attribues in tupleA but are attributes in relationB and match the tuple's value

250256

251257--check that matching attribute names have the same types

252258imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

253−imageRelationFor matchTuple rel@(Relation attrs _) = do

259+imageRelationFor matchTuple rel = do

254260 restricted <- restrictEq matchTuple rel --restrict across matching tuples

255261 project (nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)) restricted --project across attributes not in rel

256262

263+imageRelationTest :: Either RelationalError Relation

257264imageRelationTest = imageRelationFor tup s

258265 where

259266 tup = mkRelationTuple (S.fromList ["SNAME", "CITY", "S#"]) (M.fromList [("SNAME", StringAtom "Smith"), ("S#", StringAtom "S1"), ("CITY", StringAtom "London")])

@@ -273,42 +280,48 @@ imageRelationJoin rel1@(Relation attrNameSet1 tupSet1) rel2@(Relation attrNameSe

273280

274281{- C.J. Date's canonical example relvars -}

275282

276−relvarS = mkRelation attributes tupleSet

283+relvarS :: Either RelationalError Relation

284+relvarS = mkRelation attributeSet tupleSet

277285 where

278− attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

286+ attributeSet = M.fromList [("S#", Attribute "S#" StringAtomType),

279287 ("SNAME", Attribute "SNAME" StringAtomType),

280288 ("STATUS", Attribute "STATUS" IntAtomType),

281289 ("CITY", Attribute "CITY" StringAtomType)]

282− tupleSet = HS.fromList $ mkRelationTuples attributes [

290+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

283291 M.fromList [("S#", StringAtom "S1") , ("SNAME", StringAtom "Smith"), ("STATUS", IntAtom 20) , ("CITY", StringAtom "London")],

284292 M.fromList [("S#", StringAtom "S2"), ("SNAME", StringAtom "Jones"), ("STATUS", IntAtom 10), ("CITY", StringAtom "Paris")],

285293 M.fromList [("S#", StringAtom "S3"), ("SNAME", StringAtom "Blake"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Paris")],

286294 M.fromList [("S#", StringAtom "S4"), ("SNAME", StringAtom "Clark"), ("STATUS", IntAtom 20), ("CITY", StringAtom "London")],

287295 M.fromList [("S#", StringAtom "S5"), ("SNAME", StringAtom "Adams"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Athens")]]

288296

297+s :: Relation

289298s = case relvarS of { Right r -> r }

290299

291−relvarP = mkRelation attributes tupleSet

300+relvarP :: Either RelationalError Relation

301+relvarP = mkRelation attributeSet tupleSet

292302 where

293− attributes = M.fromList [("P#", Attribute "P#" StringAtomType),

303+ attributeSet = M.fromList [("P#", Attribute "P#" StringAtomType),

294304 ("PNAME", Attribute "PNAME" StringAtomType),

295305 ("COLOR", Attribute "COLOR" StringAtomType),

296306 ("WEIGHT", Attribute "WEIGHT" StringAtomType),

297307 ("CITY", Attribute "CITY" StringAtomType)]

298− tupleSet = HS.fromList $ mkRelationTuples attributes [

308+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

299309 M.fromList [("P#", StringAtom "P1"), ("PNAME", StringAtom "Nut"), ("COLOR", StringAtom "Red"), ("WEIGHT", IntAtom 12), ("CITY", StringAtom "London")]

300310 ]

311+p :: Relation

301312p = case relvarP of { Right r -> r }

302313

303−relvarSP = mkRelation attributes tupleSet

314+relvarSP :: Either RelationalError Relation

315+relvarSP = mkRelation attributeSet tupleSet

304316 where

305− attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

317+ attributeSet = M.fromList [("S#", Attribute "S#" StringAtomType),

306318 ("P#", Attribute "P#" StringAtomType),

307319 ("QTY", Attribute "QTY" StringAtomType)]

308− tupleSet = HS.fromList $ mkRelationTuples attributes [

320+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

309321 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P1"), ("QTY", IntAtom 300)]

310322 ]

311323

324+sp :: Relation

312325sp = case relvarSP of { Right r -> r }

313326

314327

RelationHTML.hs → ProjectM36/Relation/Show/HTML.hsrenamed+7−7

@@ -1,10 +1,10 @@

1−module RelationHTML where

2−import RelationType

3−import Relation

4−import RelationTuple

1+module ProjectM36.Relation.Show.HTML where

2+import ProjectM36.Base

3+import ProjectM36.Relation

4+import ProjectM36.Tuple

55import qualified Data.HashSet as HS

66import qualified Data.List as L

7−import RelationAttribute

7+import ProjectM36.Attribute

99attributesAsHTML :: Attributes -> String

1010attributesAsHTML attrs = "<tr>" ++ (foldr folder "" attrNameList) ++ "</tr>"

@@ -24,8 +24,8 @@ writeRel :: Relation -> IO ()

2424writeRel = writeHTML . relationAsHTML

2525

2626atomAsHTML :: Atom -> String

27−atomAsHTML (StringAtom s) = s

28−atomAsHTML (IntAtom i) = show i

27+atomAsHTML (StringAtom atom) = atom

28+atomAsHTML (IntAtom int) = show int

2929atomAsHTML (RelationAtom rel) = relationAsHTML rel

3030

3131tupleAsHTML :: RelationTuple -> String

RelationTerm.hs → ProjectM36/Relation/Show/Term.hsrenamed+9−8

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

11--writes Relation to a String suitable for terminal output

2−module RelationTerm where

3−import RelationType

4−import RelationTuple

5−import Relation

2+module ProjectM36.Relation.Show.Term where

3+import ProjectM36.Base

4+import ProjectM36.Tuple

5+import ProjectM36.Relation

66import qualified Data.Set as S

77import qualified Data.Map as M

88import qualified Data.HashSet as HS

@@ -61,7 +61,7 @@ cellSizes (header, body) = map (\row -> (map maxRowWidth row, map (length . brea

6161 allRows = [header] ++ body

6262

6363relationAsTable :: Relation -> Table

64−relationAsTable rel@(Relation attributes tupleSet) = (header, body)

64+relationAsTable rel@(Relation _ tupleSet) = (header, body)

6565 where

6666 oAttrs = orderedAttributeNames rel

6767 header = oAttrs

@@ -70,8 +70,8 @@ relationAsTable rel@(Relation attributes tupleSet) = (header, body)

7070 tupleFolder acc (RelationTuple tupMap) = acc ++ [map (\n -> showAtom (tupMap M.! n)) oAttrs]

7171

7272showAtom :: Atom -> String

73−showAtom (StringAtom s) = s

74−showAtom (IntAtom i) = show i

73+showAtom (StringAtom atom) = atom

74+showAtom (IntAtom atom) = show atom

7575showAtom (RelationAtom rel) = renderTable $ relationAsTable rel

7676

7777renderTable :: Table -> String

@@ -122,9 +122,10 @@ showRelation rel

122122 | otherwise = renderTable (relationAsTable rel)

123123

124124

125−simpleExample = s

125+groupedExample :: Relation

126126groupedExample = case group (S.fromList ["CITY"]) "CITYREL" s of {Right rel -> rel}

127127

128+emptyStringExample :: Relation

128129emptyStringExample = case mkRelation attributes tupleSet of

129130 Right x -> x

130131 _ -> undefined

RelationExpr.hs → ProjectM36/RelationalExpression.hsrenamed+53−50

@@ -1,9 +1,9 @@

1−module RelationExpr where

2−import Relation

3−import RelationTuple

4−import RelationTupleSet

5−import RelationType

6−import RelationalError

1+module ProjectM36.RelationalExpression where

2+import ProjectM36.Relation

3+import ProjectM36.Tuple

4+import ProjectM36.TupleSet

5+import ProjectM36.Base

6+import ProjectM36.Error

77import qualified Data.Map as M

88import qualified Data.HashSet as HS

99import Control.Monad.State hiding (join)

@@ -20,7 +20,7 @@ evalRelationalExpr (RelationVariable name) = do

2020evalRelationalExpr (Project attrNameSet expr) = do

2121 rel <- evalRelationalExpr expr

2222 case rel of

23− Right rel -> return $ project attrNameSet rel

23+ Right rel2 -> return $ project attrNameSet rel2

2424 Left err -> return $ Left err

2525

2626evalRelationalExpr (Union exprA exprB) = do

@@ -28,21 +28,21 @@ evalRelationalExpr (Union exprA exprB) = do

2828 relB <- evalRelationalExpr exprB

2929 case relA of

3030 Left err -> return $ Left err

31− Right relA -> case relB of

31+ Right relA2 -> case relB of

3232 Left err -> return $ Left err

33− Right relB -> return $ union relA relB

33+ Right relB2 -> return $ union relA2 relB2

3434

3535evalRelationalExpr (Join exprA exprB) = do

3636 relA <- evalRelationalExpr exprA

3737 relB <- evalRelationalExpr exprB

3838 case relA of

3939 Left err -> return $ Left err

40− Right relA -> case relB of

40+ Right relA2 -> case relB of

4141 Left err -> return $ Left err

42− Right relB -> return $ join relA relB

42+ Right relB2 -> return $ join relA2 relB2

4343

44−evalRelationalExpr (MakeStaticRelation attributes tupleSet) = do

45− case mkRelation attributes tupleSet of

44+evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) = do

45+ case mkRelation attributeSet tupleSet of

4646 Right rel -> return $ Right rel

4747 Left err -> return $ Left err

4848

@@ -102,31 +102,33 @@ dateExamples = DatabaseContext { inclusionDependencies = HS.empty, -- add foreig

102102 products = productsRel

103103 supplierProducts = supplierProductsRel

104104

105−suppliersRel = case mkRelation attributes tupleSet of

106− Left err -> undefined

105+suppliersRel :: Relation

106+suppliersRel = case mkRelation attributeSet tupleSet of

107+ Left _ -> undefined

107108 Right rel -> rel

108109 where

109− attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

110+ attributeSet = M.fromList [("S#", Attribute "S#" StringAtomType),

110111 ("SNAME", Attribute "SNAME" StringAtomType),

111112 ("STATUS", Attribute "STATUS" IntAtomType),

112113 ("CITY", Attribute "CITY" StringAtomType)]

113− tupleSet = HS.fromList $ mkRelationTuples attributes [

114+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

114115 M.fromList [("S#", StringAtom "S1") , ("SNAME", StringAtom "Smith"), ("STATUS", IntAtom 20) , ("CITY", StringAtom "London")],

115116 M.fromList [("S#", StringAtom "S2"), ("SNAME", StringAtom "Jones"), ("STATUS", IntAtom 10), ("CITY", StringAtom "Paris")],

116117 M.fromList [("S#", StringAtom "S3"), ("SNAME", StringAtom "Blake"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Paris")],

117118 M.fromList [("S#", StringAtom "S4"), ("SNAME", StringAtom "Clark"), ("STATUS", IntAtom 20), ("CITY", StringAtom "London")],

118119 M.fromList [("S#", StringAtom "S5"), ("SNAME", StringAtom "Adams"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Athens")]]

119120

120−productsRel = case mkRelation attributes tupleSet of

121− Left err -> undefined

121+productsRel :: Relation

122+productsRel = case mkRelation attributeSet tupleSet of

123+ Left _ -> undefined

122124 Right rel -> rel

123125 where

124− attributes = M.fromList [("P#", Attribute "P#" StringAtomType),

126+ attributeSet = M.fromList [("P#", Attribute "P#" StringAtomType),

125127 ("PNAME", Attribute "PNAME" StringAtomType),

126128 ("COLOR", Attribute "COLOR" StringAtomType),

127129 ("WEIGHT", Attribute "WEIGHT" IntAtomType),

128130 ("CITY", Attribute "CITY" StringAtomType)]

129− tupleSet = HS.fromList $ mkRelationTuples attributes [

131+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

130132 M.fromList [("P#", StringAtom "P1"), ("PNAME", StringAtom "Nut"), ("COLOR", StringAtom "Red"), ("WEIGHT", IntAtom 12), ("CITY", StringAtom "London")],

131133 M.fromList [("P#", StringAtom "P2"), ("PNAME", StringAtom "Bolt"), ("COLOR", StringAtom "Green"), ("WEIGHT", IntAtom 17), ("CITY", StringAtom "Paris")],

132134 M.fromList [("P#", StringAtom "P3"), ("PNAME", StringAtom "Screw"), ("COLOR", StringAtom "Blue"), ("WEIGHT", IntAtom 17), ("CITY", StringAtom "Oslo")],

@@ -135,15 +137,16 @@ productsRel = case mkRelation attributes tupleSet of

135137 M.fromList [("P#", StringAtom "P6"), ("PNAME", StringAtom "Cog"), ("COLOR", StringAtom "Red"), ("WEIGHT", IntAtom 19), ("CITY", StringAtom "London")]

136138

137139 ]

138−

139−supplierProductsRel = case mkRelation attributes tupleSet of

140− Left err -> undefined

140+

141+supplierProductsRel :: Relation

142+supplierProductsRel = case mkRelation attributeSet tupleSet of

143+ Left _ -> undefined

141144 Right rel -> rel

142145 where

143− attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

146+ attributeSet = M.fromList [("S#", Attribute "S#" StringAtomType),

144147 ("P#", Attribute "P#" StringAtomType),

145148 ("QTY", Attribute "QTY" IntAtomType)]

146− tupleSet = HS.fromList $ mkRelationTuples attributes [

149+ tupleSet = HS.fromList $ mkRelationTuples attributeSet [

147150 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P1"), ("QTY", IntAtom 300)],

148151 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P2"), ("QTY", IntAtom 200)],

149152 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P3"), ("QTY", IntAtom 400)],

@@ -164,20 +167,20 @@ supplierProductsRel = case mkRelation attributes tupleSet of

164167--helper function to process relation variable creation/assignment

165168setRelVar :: String -> Relation -> DatabaseState (Maybe RelationalError)

166169setRelVar relVarName rel = do

167− state <- get

168− let newRelVars = M.insert relVarName rel $ relationVariables state

169− case checkConstraints state of

170+ currstate <- get

171+ let newRelVars = M.insert relVarName rel $ relationVariables currstate

172+ case checkConstraints currstate of

170173 Just err -> return $ Just err

171174 Nothing -> do

172− put $ DatabaseContext (inclusionDependencies state) newRelVars

175+ put $ DatabaseContext (inclusionDependencies currstate) newRelVars

173176 return Nothing

174177

175178-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation

176179deleteRelVar :: String -> DatabaseState (Maybe RelationalError)

177180deleteRelVar relVarName = do

178− state <- get

179− let newRelVars = M.delete relVarName (relationVariables state)

180− put $ DatabaseContext (inclusionDependencies state) newRelVars

181+ currstate <- get

182+ let newRelVars = M.delete relVarName (relationVariables currstate)

183+ put $ DatabaseContext (inclusionDependencies currstate) newRelVars

181184 return Nothing

182185

183186evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)

@@ -217,9 +220,9 @@ evalContextExpr (Delete relVarName predicate) = do

217220

218221--union of restricted+updated portion and the unrestricted+unupdated portion

219222evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = do

220− state <- get

221− let relVarTable = relationVariables state

222− case predicateRestrictionFilter state restrictionPredicateExpr of

223+ currstate <- get

224+ let relVarTable = relationVariables currstate

225+ case predicateRestrictionFilter currstate restrictionPredicateExpr of

223226 Left err -> return $ Just err

224227 Right predicateFunc -> do

225228 case M.lookup relVarName relVarTable of

@@ -228,18 +231,18 @@ evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = d

228231 Left err -> return $ Just err

229232 Right updatedRel -> setRelVar relVarName updatedRel

230233 where

231− makeUpdatedRel rel = do

232− restrictedPortion <- restrict predicateFunc rel

233− unrestrictedPortion <- restrict (not . predicateFunc) rel

234+ makeUpdatedRel relin = do

235+ restrictedPortion <- restrict predicateFunc relin

236+ unrestrictedPortion <- restrict (not . predicateFunc) relin

234237 updatedPortion <- relMap tupleUpdater restrictedPortion

235238 union updatedPortion unrestrictedPortion

236239 tupleUpdater = \(RelationTuple tupMap) -> RelationTuple $ M.union attrAssignments tupMap

237240

238241

239242evalContextExpr (AddInclusionDependency dep) = do

240− state <- get

241− let newDeps = HS.insert dep (inclusionDependencies state)

242− put $ DatabaseContext newDeps (relationVariables state)

243+ currstate <- get

244+ let newDeps = HS.insert dep (inclusionDependencies currstate)

245+ put $ DatabaseContext newDeps (relationVariables currstate)

243246 return Nothing

244247

245248evalContextExpr (MultipleExpr exprs) = do

@@ -248,7 +251,7 @@ evalContextExpr (MultipleExpr exprs) = do

248251 --some lifting magic needed here

249252 case catMaybes evald of

250253 [] -> return $ Nothing

251− err:l -> return $ Just err

254+ err:_ -> return $ Just err

252255

253256-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples

254257--evalRelVarExpr (Update relVarName updateMap) = do

@@ -257,7 +260,7 @@ evalContextExpr (MultipleExpr exprs) = do

257260checkConstraints :: DatabaseContext -> Maybe RelationalError

258261checkConstraints context = case failures of

259262 [] -> Nothing

260− l:ls -> Just l

263+ l:_ -> Just l

261264 where

262265 failures = catMaybes $ map checkIncDep (HS.toList deps)

263266 deps = inclusionDependencies context

@@ -292,9 +295,9 @@ checkConstraint (InclusionDependency name subDep superDep) = do

292295

293296typeForRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

294297typeForRelationalExpr expr = do

295− state <- get

298+ currstate <- get

296299 --replace the relationVariables context element with a cloned set of relation devoid of tuples

297− put $ contextWithEmptyTupleSets state

300+ put $ contextWithEmptyTupleSets currstate

298301 evalRelationalExpr expr

299302

300303--returns a database context with all tuples removed

@@ -315,7 +318,7 @@ predicateRestrictionFilter context (OrPredicate expr1 expr2) = do

315318 expr2v <- predicateRestrictionFilter context expr2

316319 return $ \x -> expr1v x || expr2v x

317320

318−predicateRestrictionFilter context TruePredicate = Right $ \x -> True

321+predicateRestrictionFilter _ TruePredicate = Right $ \_ -> True

319322

320323predicateRestrictionFilter context (NotPredicate expr) = do

321324 exprv <- predicateRestrictionFilter context expr

@@ -324,13 +327,13 @@ predicateRestrictionFilter context (NotPredicate expr) = do

324327predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runState (evalRelationalExpr relExpr) context of

325328 (Left err, _) -> Left err

326329 (Right rel, _) -> if rel == relationTrue then

327− Right $ \x -> True

330+ Right $ \_ -> True

328331 else if rel == relationFalse then

329− Right $ \x -> False

332+ Right $ \_ -> False

330333 else

331334 Left $ PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'"

332335

333−predicateRestrictionFilter context (AttributeEqualityPredicate attrName atom) = Right $ \(RelationTuple tupMap) -> tupValue tupMap == atom

336+predicateRestrictionFilter _ (AttributeEqualityPredicate attrName atom) = Right $ \(RelationTuple tupMap) -> tupValue tupMap == atom

334337 where

335338 tupValue tupMap = tupMap M.! attrName

336339

RelationStaticOptimizer.hs → ProjectM36/StaticOptimizer.hsrenamed+21−22

@@ -1,9 +1,9 @@

1−module RelationStaticOptimizer where

2−import RelationType

3−import RelationExpr

4−import Relation

5−import RelationalError

6−import RelationTupleSet

1+module ProjectM36.StaticOptimizer where

2+import ProjectM36.Base

3+import ProjectM36.RelationalExpression

4+import ProjectM36.Relation

5+import ProjectM36.Error

6+import ProjectM36.TupleSet

77import Control.Monad.State hiding (join)

88import Data.Either (rights, lefts)

@@ -21,7 +21,7 @@ applyStaticRelationalOptimization (Project attrNameSet expr) = do

2121 relType <- typeForRelationalExpr expr

2222 case relType of

2323 Left err -> return $ Left err

24− Right relType -> if attributeNames relType == attrNameSet then

24+ Right relType2 -> if attributeNames relType2 == attrNameSet then

2525 applyStaticRelationalOptimization expr

2626 else do

2727 optimizedSubExpression <- applyStaticRelationalOptimization expr

@@ -44,12 +44,11 @@ applyStaticRelationalOptimization (Union exprA exprB) = do

4444applyStaticRelationalOptimization (Join exprA exprB) = do

4545 typeA <- typeForRelationalExpr exprA

4646 typeB <- typeForRelationalExpr exprB

47− context <- get

4847 case typeA of

4948 Left err -> return $ Left err

50− Right typeA -> case typeB of

49+ Right typeA2 -> case typeB of

5150 Left err -> return $ Left err

52− Right typeB -> if typeA == typeB then --no new attributes to add

51+ Right typeB2 -> if typeA2 == typeB2 then --no new attributes to add

5352 return $ Right exprA

5453 else do

5554 optExprA <- applyStaticRelationalOptimization exprA

@@ -57,9 +56,9 @@ applyStaticRelationalOptimization (Join exprA exprB) = do

5756

5857 case optExprA of

5958 Left err -> return $ Left err

60− Right optExprA -> case optExprB of

59+ Right optExprA2 -> case optExprB of

6160 Left err -> return $ Left err

62− Right optExprB -> return $ Right (Join optExprA optExprB)

61+ Right optExprB2 -> return $ Right (Join optExprA2 optExprB2)

6362

6463applyStaticRelationalOptimization e@(Rename _ _ _) = return $ Right e

6564

@@ -74,9 +73,9 @@ applyStaticRelationalOptimization (Restrict predicate expr) = do

7473 optimizedPredicate <- applyStaticPredicateOptimization predicate

7574 case optimizedPredicate of

7675 Left err -> return $ Left err

77− Right optimizedPredicate -> if optimizedPredicate == TruePredicate then

76+ Right optimizedPredicate2 -> if optimizedPredicate2 == TruePredicate then

7877 applyStaticRelationalOptimization expr

79− else if optimizedPredicate == NotPredicate TruePredicate then do

78+ else if optimizedPredicate2 == NotPredicate TruePredicate then do

8079 attributesRel <- typeForRelationalExpr expr

8180 case attributesRel of

8281 Left err -> return $ Left err

@@ -85,7 +84,7 @@ applyStaticRelationalOptimization (Restrict predicate expr) = do

8584 optimizedSubExpression <- applyStaticRelationalOptimization expr

8685 case optimizedSubExpression of

8786 Left err -> return $ Left err

88− Right optSubExpr -> return $ Right $ Restrict optimizedPredicate optSubExpr

87+ Right optSubExpr -> return $ Right $ Restrict optimizedPredicate2 optSubExpr

8988

9089applyStaticRelationalOptimization (Equals exprA exprB) = do

9190 return $ Right $ Equals exprA exprB

@@ -99,25 +98,25 @@ applyStaticDatabaseOptimization (Assign name expr) = do

9998 optimizedExpr <- applyStaticRelationalOptimization expr

10099 case optimizedExpr of

101100 Left err -> return $ Left err

102− Right optimizedExpr -> return $ Right (Assign name optimizedExpr)

101+ Right optimizedExpr2 -> return $ Right (Assign name optimizedExpr2)

103102

104103applyStaticDatabaseOptimization (Insert name expr) = do

105104 optimizedExpr <- applyStaticRelationalOptimization expr

106105 case optimizedExpr of

107106 Left err -> return $ Left err

108− Right optimizedExpr -> return $ Right (Insert name optimizedExpr)

107+ Right optimizedExpr2 -> return $ Right (Insert name optimizedExpr2)

109108

110109applyStaticDatabaseOptimization (Delete name predicate) = do

111110 optimizedPredicate <- applyStaticPredicateOptimization predicate

112111 case optimizedPredicate of

113112 Left err -> return $ Left err

114− Right optimizedPredicate -> return $ Right (Delete name optimizedPredicate)

113+ Right optimizedPredicate2 -> return $ Right (Delete name optimizedPredicate2)

115114

116−applyStaticDatabaseOptimization (Update name map predicate) = do

115+applyStaticDatabaseOptimization (Update name upmap predicate) = do

117116 optimizedPredicate <- applyStaticPredicateOptimization predicate

118117 case optimizedPredicate of

119118 Left err -> return $ Left err

120− Right optimizedPredicate -> return $ Right (Update name map optimizedPredicate)

119+ Right optimizedPredicate2 -> return $ Right (Update name upmap optimizedPredicate2)

121120

122121applyStaticDatabaseOptimization (AddInclusionDependency dep) = return $ Right (AddInclusionDependency dep)

123122

@@ -136,8 +135,8 @@ applyStaticDatabaseOptimization (MultipleExpr exprs) = do

136135 where

137136 substateRunner = forM exprs $ \expr -> do

138137 --a previous expression could create a relvar, we don't want to miss it, so we clear the tuples and execute the expression to get an empty relation in the relvar

139− evalContextExpr expr

140− applyStaticDatabaseOptimization expr

138+ _ <- evalContextExpr expr

139+ applyStaticDatabaseOptimization expr

141140 --this error handling could be improved with some lifting presumably

142141 --restore original context

143142

RelationalTransaction.hs → ProjectM36/Transaction.hsrenamed+12−11

@@ -1,7 +1,7 @@

1−module RelationalTransaction where

1+module ProjectM36.Transaction where

22import qualified Data.UUID as U

3−import RelationType

4−import RelationalError

3+import ProjectM36.Base

4+import ProjectM36.Error

55import qualified Data.Set as S

66import qualified Data.Map as M

77import Control.Applicative ((<$>))

@@ -39,7 +39,8 @@ transactionsForUUIDs uuidSet graph = do

3939 return (S.fromList transList)

4040

4141isRootTransaction :: Transaction -> TransactionGraph -> Bool

42−isRootTransaction (Transaction _ (TransactionInfo pUUID _) _) graph = U.null pUUID

42+isRootTransaction (Transaction _ (TransactionInfo pUUID _) _) _ = U.null pUUID

43+isRootTransaction (Transaction _ (MergeTransactionInfo _ _ _) _) _ = False

4344

4445-- the first transaction has no parent - all other do have parents- merges have two parents

4546parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

@@ -69,17 +70,17 @@ addBranch newBranchName branchPoint graph@(TransactionGraph heads transSet) = if

6970-- create a new commit and add it to the heads

7071-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

7172addBranch :: U.UUID -> HeadName -> Transaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

72−addBranch newUUID newBranchName branchPoint graph@(TransactionGraph heads transSet) = addTransactionToGraph newBranchName branchPoint newUUID (transactionContext branchPoint) graph

73+addBranch newUUID newBranchName branchPoint graph = addTransactionToGraph newBranchName branchPoint newUUID (transactionContext branchPoint) graph

7374

7475--adds a disconnected transaction to a transaction graph at some head

7576addDisconnectedTransaction :: U.UUID -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

76−addDisconnectedTransaction newUUID headName dTrans@(DisconnectedTransaction parentUUID context) graph = do

77+addDisconnectedTransaction newUUID headName (DisconnectedTransaction parentUUID context) graph = do

7778 parentTrans <- transactionForUUID parentUUID graph

7879 addTransactionToGraph headName parentTrans newUUID context graph

7980

8081-- create a new transaction on "newHeadName" with the branchPointTrans

8182addTransactionToGraph :: HeadName -> Transaction -> U.UUID -> DatabaseContext -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

82−addTransactionToGraph newHeadName branchPointTrans@(Transaction parentUUID _ parentInfo) newUUID newContext graph@(TransactionGraph heads transSet) = do

83+addTransactionToGraph newHeadName branchPointTrans newUUID newContext (TransactionGraph heads transSet) = do

8384 let freshTransaction = Transaction newUUID (TransactionInfo (transactionUUID branchPointTrans) S.empty) newContext

8485 -- there are two parents for MergeTransactions! not implemented

8586 --update parentTransaction to add child

@@ -89,12 +90,12 @@ addTransactionToGraph newHeadName branchPointTrans@(Transaction parentUUID _ par

8990 return (freshTransaction, updatedGraph)

9091

9192validateGraph :: TransactionGraph -> Maybe [RelationalError]

92−validateGraph graph@(TransactionGraph heads transSet) = do

93+validateGraph graph@(TransactionGraph _ transSet) = do

9394 --check that all UUIDs are unique in the graph

9495 --uuids = map transactionUUID transSet

9596 --check that all heads appear in the transSet

9697 --check that all forward and backward links are in place

97− errors <- mapM (walkParentTransactions S.empty graph) (S.toList transSet)

98+ _ <- mapM (walkParentTransactions S.empty graph) (S.toList transSet)

9899 mapM (walkChildTransactions S.empty graph) (S.toList transSet)

99100

100101--verify that all parent links exist and that all children exist

@@ -113,7 +114,7 @@ walkParentTransactions seenTransSet graph trans =

113114 Right parentTransSet -> do

114115 walk <- mapM (walkParentTransactions (S.insert transUUID seenTransSet) graph) (S.toList parentTransSet)

115116 case walk of

116− err:xs -> Just err

117+ err:_ -> Just err

117118 _ -> Nothing

118119

119120--refactor: needless duplication in these two functions

@@ -131,6 +132,6 @@ walkChildTransactions seenTransSet graph trans =

131132 Right childTransSet -> do

132133 walk <- mapM (walkChildTransactions (S.insert transUUID seenTransSet) graph) (S.toList childTransSet)

133134 case walk of

134− err:xs -> Just err

135+ err:_ -> Just err

135136 _ -> Nothing

136137

RelationalTransactionShow.hs → ProjectM36/Transaction/Show.hsrenamed+12−12

@@ -1,10 +1,10 @@

1−module RelationalTransactionShow where

2−import RelationType

3−import Relation

4−import RelationTuple

5−import RelationTupleSet

6−import RelationalError

7−import RelationalTransaction

1+module ProjectM36.Transaction.Show where

2+import ProjectM36.Base

3+import ProjectM36.Relation

4+import ProjectM36.Tuple

5+import ProjectM36.TupleSet

6+import ProjectM36.Error

7+import ProjectM36.Transaction

88import qualified Data.Map as M

99import qualified Data.HashSet as HS

1010import qualified Data.Set as S

@@ -18,17 +18,17 @@ showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionUUID

1818 Right parentTransSet -> concat $ S.toList $ S.map (show . transactionUUID) parentTransSet

1919

2020showGraphStructure :: TransactionGraph -> String

21−showGraphStructure graph@(TransactionGraph heads transSet) = S.foldr folder "" transSet

21+showGraphStructure graph@(TransactionGraph _ transSet) = S.foldr folder "" transSet

2222 where

2323 folder trans acc = acc ++ showTransactionStructure trans graph ++ "\n"

2424

2525--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction

2626graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation

27−graphAsRelation discon@(DisconnectedTransaction parentUUID _) graph@(TransactionGraph heads transSet) = do

27+graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _ transSet) = do

2828 tupleSet <- mapM tupleGenerator (S.toList transSet)

29− mkRelation attributes (HS.fromList tupleSet)

29+ mkRelation attributeSet (HS.fromList tupleSet)

3030 where

31− attributes = M.fromList [("id", Attribute "id" StringAtomType),

31+ attributeSet = M.fromList [("id", Attribute "id" StringAtomType),

3232 ("parents", Attribute "parents" (RelationAtomType parentAttributes)),

3333 ("current", Attribute "current" IntAtomType),

3434 ("head", Attribute "head" StringAtomType)

@@ -56,7 +56,7 @@ transactionParentsRelation trans graph = do

5656 mkRelation attributes tupleSet

5757 where

5858 attributes = M.fromList [("id", Attribute "id" StringAtomType)]

59− trans2tuple trans = mkRelationTuple (S.fromList ["id"]) $ M.singleton "id" (StringAtom (show $ transactionUUID trans))

59+ trans2tuple trans2 = mkRelationTuple (S.fromList ["id"]) $ M.singleton "id" (StringAtom (show $ transactionUUID trans2))

6060

6161

6262

RelationTuple.hs → ProjectM36/Tuple.hsrenamed+6−5

@@ -1,6 +1,7 @@

1−module RelationTuple where

2−import RelationType

3−import RelationAttribute

1+module ProjectM36.Tuple where

2+import ProjectM36.Base

3+import ProjectM36.Attribute

45import qualified Data.Map as M

56import qualified Data.Set as S

67import qualified Data.List as L

@@ -37,11 +38,11 @@ tupleRenameAttribute oldattr newattr old@(RelationTuple tmap) =

3738

3839--in case the map does not contain the attributes, filter them out

3940mkRelationTuple :: S.Set AttributeName-> M.Map AttributeName Atom -> RelationTuple

40−mkRelationTuple attrs map = RelationTuple newMap

41+mkRelationTuple attrs attrmap = RelationTuple newMap

4142 where

4243 --make sure only attributes in the name set are in the tuple

4344 --check that Atoms are all of the same type- change to Either return value

44− newMap = remapWithAttributes attrs map

45+ newMap = remapWithAttributes attrs attrmap

4546

4647mkRelationTuples :: Attributes -> [M.Map AttributeName Atom] -> [RelationTuple]

4748mkRelationTuples attrs maplist = map mapper maplist

RelationTupleSet.hs → ProjectM36/TupleSet.hsrenamed+8−5

@@ -1,13 +1,16 @@

1−module RelationTupleSet where

2−import RelationType

3−import RelationTuple

4−import RelationAttribute

5−import RelationalError

1+module ProjectM36.TupleSet where

2+import ProjectM36.Base

3+import ProjectM36.Tuple

4+import ProjectM36.Attribute

5+import ProjectM36.Error

66import qualified Data.Map as M

77import qualified Data.HashSet as HS

88import Control.Monad

10+emptyTupleSet :: RelationTupleSet

1011emptyTupleSet = HS.empty

12+

13+emptyAttributeSet :: Attributes

1114emptyAttributeSet = M.empty

1215

1316--ensure that all maps have the same keys and key count

RelationAtom.hsdeleted−4

@@ -1,4 +0,0 @@

1−module RelationAtom where

2−import RelationType

3−import RelationAttribute

4−

RelationalInclusionDependency.hsdeleted−5

@@ -1,5 +0,0 @@

1−module RelationalInclusionDependency where

2−import RelationalError

3−import RelationType

4−import Data.Maybe

5−

TutorialDInterpreter.hs → TutorialD/Interpreter.hsrenamed+24−24

@@ -1,15 +1,15 @@

11{-# LANGUAGE GADTs #-}

2−module TutorialDInterpreter where

3−import Relation

4−import RelationType

5−import RelationTuple

6−import RelationTupleSet

7−import RelationalError

8−import RelationExpr

9−import RelationTerm

10−import RelationStaticOptimizer

11−import RelationalTransaction

12−import RelationalTransactionShow

2+module TutorialD.Interpreter where

3+import ProjectM36.Base

4+import ProjectM36.Relation

5+import ProjectM36.Tuple

6+import ProjectM36.TupleSet

7+import ProjectM36.Error

8+import ProjectM36.RelationalExpression

9+import ProjectM36.Relation.Show.Term

10+import ProjectM36.StaticOptimizer

11+import ProjectM36.Transaction

12+import ProjectM36.Transaction.Show

1313import Text.Parsec

1414import Text.Parsec.String

1515import Text.Parsec.Expr

@@ -225,8 +225,8 @@ defineP = do

225225 relVarName <- identifier

226226 reservedOp "::"

227227 return relVarName

228− attributes <- makeAttributes

229− return $ Define relVarName attributes

228+ attributeSet <- makeAttributes

229+ return $ Define relVarName attributeSet

230230

231231undefineP :: Parser DatabaseExpr

232232undefineP = do

@@ -320,8 +320,8 @@ showConstraintsP = do

320320jumpToHeadP :: Parser GraphOperator

321321jumpToHeadP = do

322322 reservedOp ":jumphead"

323− head <- identifier

324− return $ JumpToHead head

323+ headid <- identifier

324+ return $ JumpToHead headid

325325

326326jumpToTransactionP :: Parser GraphOperator

327327jumpToTransactionP = do

@@ -350,6 +350,7 @@ showGraphP = do

350350 reservedOp ":showgraph"

351351 return $ ShowGraph

352352

353+transactionGraphOps :: Parser GraphOperator

353354transactionGraphOps = do

354355 jumpToHeadP

355356 <|> jumpToTransactionP

@@ -399,21 +400,21 @@ evalContextOp context (ShowConstraint name) = do

399400 deps = inclusionDependencies context

400401 filteredDeps = case name of

401402 "" -> deps

402− name -> HS.filter (\(InclusionDependency n _ _) -> n == name) deps

403+ name2 -> HS.filter (\(InclusionDependency n _ _) -> n == name2) deps

403404

404405evalContextOp context (ShowPlan dbExpr) = do

405406 DisplayResult $ show plan

406407 where

407408 plan = evalState (applyStaticDatabaseOptimization dbExpr) context

408409

409−evalContextOp context (Quit) = QuitResult

410+evalContextOp _ (Quit) = QuitResult

410411

411412-- returns the new "current" transaction, updated graph, and tutorial d result

412413-- the current transaction is not part of the transaction graph until it is committed

413414evalGraphOp :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> GraphOperator -> Either RelationalError (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)

414415

415416--affects only disconncted transaction

416−evalGraphOp newUUID trans graph (JumpToTransaction jumpUUID) = case transactionForUUID jumpUUID graph of

417+evalGraphOp _ _ graph (JumpToTransaction jumpUUID) = case transactionForUUID jumpUUID graph of

417418 Left err -> Left err

418419 Right parentTrans -> Right (newTrans, graph, QuietSuccessResult)

419420 where

@@ -421,7 +422,7 @@ evalGraphOp newUUID trans graph (JumpToTransaction jumpUUID) = case transactionF

421422

422423-- switch from one head to another

423424-- affects only disconnectedtransaction

424−evalGraphOp newUUID currentTransaction graph (JumpToHead headName) =

425+evalGraphOp _ _ graph (JumpToHead headName) =

425426 case transactionForHead headName graph of

426427 Just newHeadTransaction -> let disconnectedTrans = newDisconnectedTransaction (transactionUUID newHeadTransaction) (transactionContext newHeadTransaction) in

427428 Right (disconnectedTrans, graph, QuietSuccessResult)

@@ -441,11 +442,11 @@ evalGraphOp newUUID discon@(DisconnectedTransaction parentUUID disconContext) gr

441442

442443-- create a new commit and add it to the heads

443444-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

444−evalGraphOp newUUID discon@(DisconnectedTransaction parentUUID disconContext) graph (Branch newBranchName) = case transactionForUUID parentUUID graph of

445+evalGraphOp newUUID (DisconnectedTransaction parentUUID disconContext) graph (Branch newBranchName) = case transactionForUUID parentUUID graph of

445446 Left err -> Left err

446447 Right parentTrans -> case addBranch newUUID newBranchName parentTrans graph of

447448 Left err -> Left err

448− Right (newTrans, newGraph) -> Right (newDiscon, newGraph, QuietSuccessResult)

449+ Right (_, newGraph) -> Right (newDiscon, newGraph, QuietSuccessResult)

449450 where

450451 newDiscon = DisconnectedTransaction newUUID disconContext

451452

@@ -463,7 +464,7 @@ evalGraphOp newTransUUID discon@(DisconnectedTransaction parentUUID context) gra

463464 maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph

464465

465466-- refresh the disconnected transaction, return the same graph

466−evalGraphOp _ discon@(DisconnectedTransaction parentUUID _) graph Rollback = case transactionForUUID parentUUID graph of

467+evalGraphOp _ (DisconnectedTransaction parentUUID _) graph Rollback = case transactionForUUID parentUUID graph of

467468 Left err -> Left err

468469 Right parentTransaction -> Right (newDiscon, graph, QuietSuccessResult)

469470 where

@@ -481,7 +482,6 @@ interpret context tutdstring = case parseString tutdstring of

481482 Right parsed -> runState (evaluator parsed) context

482483 where

483484 evaluator expr = do

484− context <- get

485485 optExpr <- applyStaticDatabaseOptimization expr

486486 --case optExpr of

487487 case optExpr of

@@ -580,5 +580,5 @@ intAtomP = do

580580

581581--used by :dumpGraph

582582displayTransactionGraph :: TransactionGraph -> String

583−displayTransactionGraph (TransactionGraph heads transSet) = L.intercalate "\n" $ S.foldr (\(Transaction tUUID pUUID _ ) acc -> acc ++ [show tUUID ++ " " ++ show pUUID]) [] transSet

583+displayTransactionGraph (TransactionGraph _ transSet) = L.intercalate "\n" $ S.foldr (\(Transaction tUUID pUUID _ ) acc -> acc ++ [show tUUID ++ " " ++ show pUUID]) [] transSet

584584

tutd.hs → TutorialD/tutd.hsrenamed+4−4

@@ -1,7 +1,7 @@

1−import TutorialDInterpreter

2−import RelationExpr

3−import RelationalTransaction

4−import RelationType

1+import TutorialD.Interpreter

2+import ProjectM36.RelationalExpression

3+import ProjectM36.Transaction

4+import ProjectM36.Base

55import Data.UUID.V4 (nextRandom)

77main = do

project-m36.cabal+30−7

@@ -6,22 +6,45 @@ Homepage: https://github.com/agentm/project-m36

66Category: Relational Algebra

77Cabal-Version: >= 1.2

9−Executable tutd

9+Library

1010 Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid

11− main-is: tutd.hs

12− GHC-Options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns

11+ Exposed-Modules: ProjectM36.Error,

12+ ProjectM36.Transaction,

13+ ProjectM36.Transaction.Show,

14+ ProjectM36.Base,

15+ ProjectM36.Attribute,

16+ ProjectM36.Tuple,

17+ ProjectM36.TupleSet,

18+ ProjectM36.Atom,

19+ ProjectM36.RelationalExpression,

20+ ProjectM36.Relation.Show.HTML,

21+ ProjectM36.StaticOptimizer,

22+ ProjectM36.Relation.Show.Term

23+ GHC-Options: -Wall

24+

25+Executable tutd

26+ Build-Depends: base

27+ Other-Modules: ProjectM36.Error,

28+ ProjectM36.Base,

29+ ProjectM36.RelationalExpression,

30+ ProjectM36.Transaction

31+ main-is: TutorialD/tutd.hs

32+ GHC-Options: -Wall

1333

1434Test-Suite test-tutoriald

1535 type: exitcode-stdio-1.0

16− main-is: TutorialDInterpreterTest.hs

36+ main-is: test/TutorialD/Interpreter.hs

1737 Build-Depends: base,HUnit,Cabal

38+ GHC-Options: -Wall

1839

1940Test-Suite test-relation

2041 type: exitcode-stdio-1.0

21− main-is: RelationTest.hs

42+ main-is: test/Relation/Basic.hs

2243 Build-Depends: base,HUnit,Cabal

44+ GHC-Options: -Wall

2345

2446Test-Suite test-static-optimizer

2547 type: exitcode-stdio-1.0

26− main-is: RelationStaticOptimizerTest.hs

27− Build-Depends: base,HUnit,Cabal

48+ main-is: test/Relation/StaticOptimizer.hs

49+ Build-Depends: base,HUnit,Cabal

50+ GHC-Options: -Wall

RelationTest.hs → test/Relation/Basic.hsrenamed+5−6

@@ -1,16 +1,15 @@

11import Test.HUnit

2−import RelationType

3−import Relation

4−import RelationalError

5−import RelationTuple

6−import RelationTupleSet

2+import ProjectM36.Base

3+import ProjectM36.Relation

4+import ProjectM36.Error

5+import ProjectM36.Tuple

6+import ProjectM36.TupleSet

77import qualified Data.Set as S

88import qualified Data.Map as M

99import qualified Data.HashSet as HS

1010import System.Exit

1111import Control.Monad

1212

13−

1413testList = TestList [testRelation relationTrue, testRelation relationFalse,

1514 testRename1, testRename2]

1615main = do

RelationStaticOptimizerTest.hs → test/Relation/StaticOptimizer.hsrenamed+5−5

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

1−import RelationType

2−import Relation

3−import RelationExpr

4−import RelationTupleSet

5−import RelationStaticOptimizer

1+import ProjectM36.Base

2+import ProjectM36.Relation

3+import ProjectM36.RelationalExpression

4+import ProjectM36.TupleSet

5+import ProjectM36.StaticOptimizer

66import System.Exit

77import Control.Monad.State

88import Test.HUnit

TutorialDInterpreterTest.hs → test/TutorialD/Interpreter.hsrenamed+6−6

@@ -1,10 +1,10 @@

1−import TutorialDInterpreter

1+import TutorialD.Interpreter

22import Test.HUnit

3−import RelationExpr

4−import Relation

5−import RelationalError

6−import RelationType

7−import RelationalTransaction

3+import ProjectM36.RelationalExpression

4+import ProjectM36.Relation

5+import ProjectM36.Error

6+import ProjectM36.Base

7+import ProjectM36.Transaction

88import qualified Data.HashSet as HS

99import qualified Data.Map as M

1010import qualified Data.Set as S