git.iko.soy/project-m36
on 62_python_dbapi help sign in
project-m36/src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs
96 lines 3.3 kB history raw
1{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter.TransactionGraphOperator where
3import TutorialD.Interpreter.Base
4import Text.Megaparsec.Text
5import Text.Megaparsec
6import ProjectM36.TransactionGraph
7import ProjectM36.Client
8import ProjectM36.Error
9import ProjectM36.Base
11jumpToHeadP :: Parser TransactionGraphOperator
12jumpToHeadP = do
13 reservedOp ":jumphead"
14 headid <- identifier
15 return $ JumpToHead headid
17jumpToTransactionP :: Parser TransactionGraphOperator
18jumpToTransactionP = do
19 reservedOp ":jump"
20 uuid <- uuidP
21 return $ JumpToTransaction uuid
23branchTransactionP :: Parser TransactionGraphOperator
24branchTransactionP = do
25 reservedOp ":branch"
26 branchName <- identifier
27 return $ Branch branchName
29deleteBranchP :: Parser TransactionGraphOperator
30deleteBranchP = do
31 reserved ":deletebranch"
32 DeleteBranch <$> identifier
34commitTransactionP :: Parser TransactionGraphOperator
35commitTransactionP = do
36 reservedOp ":commit"
37 return $ Commit
39rollbackTransactionP :: Parser TransactionGraphOperator
40rollbackTransactionP = do
41 reservedOp ":rollback"
42 return $ Rollback
44showGraphP :: Parser ROTransactionGraphOperator
45showGraphP = do
46 reservedOp ":showgraph"
47 return $ ShowGraph
49mergeTransactionStrategyP :: Parser MergeStrategy
50mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>
51 (do
52 reserved "selectedbranch"
53 branch <- identifier
54 pure (SelectedBranchMergeStrategy branch)) <|>
55 (do
56 reserved "unionpreferbranch"
57 branch <- identifier
58 pure (UnionPreferMergeStrategy branch))
60mergeTransactionsP :: Parser TransactionGraphOperator
61mergeTransactionsP = do
62 reservedOp ":mergetrans"
63 strategy <- mergeTransactionStrategyP
64 headA <- identifier
65 headB <- identifier
66 pure (MergeTransactions strategy headA headB)
68transactionGraphOpP :: Parser TransactionGraphOperator
69transactionGraphOpP = do
70 jumpToHeadP
71 <|> jumpToTransactionP
72 <|> branchTransactionP
73 <|> deleteBranchP
74 <|> commitTransactionP
75 <|> rollbackTransactionP
76 <|> mergeTransactionsP
78roTransactionGraphOpP :: Parser ROTransactionGraphOperator
79roTransactionGraphOpP = showGraphP
83{-
84-- for interpreter-specific operations
85interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)
86interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of
87 Left _ -> (trans, transGraph, NoActionResult)
88 Right ops -> case ops of
89 Left contextOp -> (trans, transGraph, (evalContextOp context contextOp))
90 Right graphOp -> case evalGraphOp newUUID trans transGraph graphOp of
91 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
92 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
93-}
95evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
96evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn