ef96224 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add some more info to :showGraph

ef96224AgentM12 years ago

RelationAttribute.hs+3−1

compare with master

unifiedsplit

@@ -3,6 +3,7 @@ import RelationType

3import qualified Data.Map as M

4import qualified Data.Set as S

5import qualified Data.List as L

6+import Debug.Trace

7renameAttribute :: AttributeName -> Attribute -> Attribute

8renameAttribute :: AttributeName -> Attribute -> Attribute

8renameAttribute newAttrName (Attribute oldAttrName typeo) = Attribute newAttrName typeo

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

@@ -34,8 +35,9 @@ matchingAttributeNameSet = S.intersection

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

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

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

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

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

37attributesDifference :: Attributes -> Attributes -> Attributes

39attributesDifference :: Attributes -> Attributes -> Attributes

38−attributesDifference attrA attrB = M.union mismatchA missingB

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

39 where

41 where

40 mismatchA = M.foldrWithKey folder M.empty attrA

42 mismatchA = M.foldrWithKey folder M.empty attrA

41 missingB = M.difference attrA attrB

43 missingB = M.difference attrA attrB

RelationalTransactionShow.hs+8−3

@@ -30,16 +30,21 @@ graphAsRelation discon@(DisconnectedTransaction parentUUID _) graph@(Transaction

30 where

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

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

33− ("current", Attribute "current" IntAtomType)

33+ ("current", Attribute "current" IntAtomType),

34+ ("head", Attribute "head" StringAtomType)

34 ]

35 ]

35 parentAttributes = M.fromList [("id", Attribute "id" StringAtomType)]

36 parentAttributes = M.fromList [("id", Attribute "id" StringAtomType)]

36 tupleGenerator transaction = case transactionParentsRelation transaction graph of

37 tupleGenerator transaction = case transactionParentsRelation transaction graph of

37 Left err -> Left err

38 Left err -> Left err

38− Right parentTransRel -> Right $ mkRelationTuple (S.fromList ["id", "parents", "current"]) $

39+ Right parentTransRel -> Right $ mkRelationTuple (S.fromList ["id", "parents", "current", "head"]) $

39 (M.fromList

40 (M.fromList

40 [("id", StringAtom $ show (transactionUUID transaction)),

41 [("id", StringAtom $ show (transactionUUID transaction)),

41 ("parents", RelationAtom parentTransRel),

42 ("parents", RelationAtom parentTransRel),

42− ("current", IntAtom $ if parentUUID == transactionUUID transaction then 1 else 0)])

43+ ("current", IntAtom $ if parentUUID == transactionUUID transaction then 1 else 0),

44+ ("head", StringAtom $ case headNameForTransaction transaction graph of

45+ Just headName -> headName

46+ Nothing -> "_")

47+ ])

44transactionParentsRelation :: Transaction -> TransactionGraph -> Either RelationalError Relation

49transactionParentsRelation :: Transaction -> TransactionGraph -> Either RelationalError Relation

45transactionParentsRelation trans graph = do

50transactionParentsRelation trans graph = do

TutorialDInterpreter.hs+1−1

@@ -395,7 +395,7 @@ evalGraphOp :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> GraphOpe

395--affects only disconncted transaction

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

397 Left err -> Left err

398− Right parentTrans -> Right (newTrans, graph, NoActionResult)

398+ Right parentTrans -> Right (newTrans, graph, QuietSuccessResult)

399 where

400 newTrans = DisconnectedTransaction jumpUUID (transactionContext parentTrans)

401