git.iko.soy/project-m36
on e7e0776 help sign in
project-m36/src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs
90 lines 3.1 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
29commitTransactionP :: Parser TransactionGraphOperator
30commitTransactionP = do
31 reservedOp ":commit"
32 return $ Commit
34rollbackTransactionP :: Parser TransactionGraphOperator
35rollbackTransactionP = do
36 reservedOp ":rollback"
37 return $ Rollback
39showGraphP :: Parser ROTransactionGraphOperator
40showGraphP = do
41 reservedOp ":showgraph"
42 return $ ShowGraph
44mergeTransactionStrategyP :: Parser MergeStrategy
45mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>
46 (do
47 reserved "selectedbranch"
48 branch <- identifier
49 pure (SelectedBranchMergeStrategy branch)) <|>
50 (do
51 reserved "unionpreferbranch"
52 branch <- identifier
53 pure (UnionPreferMergeStrategy branch))
55mergeTransactionsP :: Parser TransactionGraphOperator
56mergeTransactionsP = do
57 reservedOp ":mergetrans"
58 strategy <- mergeTransactionStrategyP
59 headA <- identifier
60 headB <- identifier
61 pure (MergeTransactions strategy headA headB)
63transactionGraphOpP :: Parser TransactionGraphOperator
64transactionGraphOpP = do
65 jumpToHeadP
66 <|> jumpToTransactionP
67 <|> branchTransactionP
68 <|> commitTransactionP
69 <|> rollbackTransactionP
70 <|> mergeTransactionsP
72roTransactionGraphOpP :: Parser ROTransactionGraphOperator
73roTransactionGraphOpP = showGraphP
77{-
78-- for interpreter-specific operations
79interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)
80interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of
81 Left _ -> (trans, transGraph, NoActionResult)
82 Right ops -> case ops of
83 Left contextOp -> (trans, transGraph, (evalContextOp context contextOp))
84 Right graphOp -> case evalGraphOp newUUID trans transGraph graphOp of
85 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
86 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
87-}
89evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
90evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn