git.iko.soy/project-m36
on e0e000c help sign in
project-m36/src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs
97 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 qualified Data.UUID as U
7import ProjectM36.TransactionGraph
8import ProjectM36.Client
9import ProjectM36.Error
10import ProjectM36.Base
12jumpToHeadP :: Parser TransactionGraphOperator
13jumpToHeadP = do
14 reservedOp ":jumphead"
15 headid <- identifier
16 return $ JumpToHead headid
18jumpToTransactionP :: Parser TransactionGraphOperator
19jumpToTransactionP = do
20 reservedOp ":jump"
21 uuid <- uuidP
22 return $ JumpToTransaction uuid
24branchTransactionP :: Parser TransactionGraphOperator
25branchTransactionP = do
26 reservedOp ":branch"
27 branchName <- identifier
28 return $ Branch branchName
30commitTransactionP :: Parser TransactionGraphOperator
31commitTransactionP = do
32 reservedOp ":commit"
33 return $ Commit
35rollbackTransactionP :: Parser TransactionGraphOperator
36rollbackTransactionP = do
37 reservedOp ":rollback"
38 return $ Rollback
40showGraphP :: Parser ROTransactionGraphOperator
41showGraphP = do
42 reservedOp ":showgraph"
43 return $ ShowGraph
45mergeTransactionStrategyP :: Parser MergeStrategy
46mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>
47 (do
48 reserved "selectedbranch"
49 branch <- identifier
50 pure (SelectedBranchMergeStrategy branch)) <|>
51 (do
52 reserved "unionpreferbranch"
53 branch <- identifier
54 pure (UnionPreferMergeStrategy branch))
56mergeTransactionsP :: Parser TransactionGraphOperator
57mergeTransactionsP = do
58 reservedOp ":mergetrans"
59 strategy <- mergeTransactionStrategyP
60 headA <- identifier
61 headB <- identifier
62 pure (MergeTransactions strategy headA headB)
64transactionGraphOpP :: Parser TransactionGraphOperator
65transactionGraphOpP = do
66 jumpToHeadP
67 <|> jumpToTransactionP
68 <|> branchTransactionP
69 <|> commitTransactionP
70 <|> rollbackTransactionP
71 <|> mergeTransactionsP
73roTransactionGraphOpP :: Parser ROTransactionGraphOperator
74roTransactionGraphOpP = showGraphP
76uuidP :: Parser U.UUID
77uuidP = do
78 uuidStr <- many (alphaNumChar <|> char '-')
79 case U.fromString uuidStr of
80 Nothing -> fail "Invalid uuid string"
81 Just uuid -> return uuid
84{-
85-- for interpreter-specific operations
86interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)
87interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of
88 Left _ -> (trans, transGraph, NoActionResult)
89 Right ops -> case ops of
90 Left contextOp -> (trans, transGraph, (evalContextOp context contextOp))
91 Right graphOp -> case evalGraphOp newUUID trans transGraph graphOp of
92 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
93 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
94-}
96evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
97evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn