git.iko.soy/project-m36
on 2d313ac help sign in
project-m36/src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs
108 lines 3.9 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 hiding (autoMergeToHead)
7import ProjectM36.Client
8import ProjectM36.Base
9import Data.Functor
11data ConvenienceTransactionGraphOperator = AutoMergeToHead MergeStrategy HeadName
12 deriving (Show)
14convenienceTransactionGraphOpP :: Parser ConvenienceTransactionGraphOperator
15convenienceTransactionGraphOpP = autoMergeToHeadP
17autoMergeToHeadP :: Parser ConvenienceTransactionGraphOperator
18autoMergeToHeadP = do
19 reserved ":automergetohead"
20 AutoMergeToHead <$> mergeTransactionStrategyP <*> identifier
22jumpToHeadP :: Parser TransactionGraphOperator
23jumpToHeadP = do
24 reservedOp ":jumphead"
25 JumpToHead <$> identifier
27jumpToTransactionP :: Parser TransactionGraphOperator
28jumpToTransactionP = do
29 reservedOp ":jump"
30 JumpToTransaction <$> uuidP
32walkBackToTimeP :: Parser TransactionGraphOperator
33walkBackToTimeP = do
34 reservedOp ":walkbacktotime"
35 WalkBackToTime <$> utcTimeP
37branchTransactionP :: Parser TransactionGraphOperator
38branchTransactionP = do
39 reservedOp ":branch"
40 Branch <$> identifier
42deleteBranchP :: Parser TransactionGraphOperator
43deleteBranchP = do
44 reserved ":deletebranch"
45 DeleteBranch <$> identifier
47commitTransactionP :: Parser TransactionGraphOperator
48commitTransactionP = do
49 reservedOp ":commit"
50 pure Commit
52rollbackTransactionP :: Parser TransactionGraphOperator
53rollbackTransactionP = do
54 reservedOp ":rollback"
55 return Rollback
57showGraphP :: Parser ROTransactionGraphOperator
58showGraphP = do
59 reservedOp ":showgraph"
60 return ShowGraph
62mergeTransactionStrategyP :: Parser MergeStrategy
63mergeTransactionStrategyP = (reserved "union" $> UnionMergeStrategy) <|>
64 (do
65 reserved "selectedbranch"
66 SelectedBranchMergeStrategy <$> identifier) <|>
67 (do
68 reserved "unionpreferbranch"
69 UnionPreferMergeStrategy <$> identifier)
71mergeTransactionsP :: Parser TransactionGraphOperator
72mergeTransactionsP = do
73 reservedOp ":mergetrans"
74 MergeTransactions <$> mergeTransactionStrategyP <*> identifier <*> identifier
76transactionGraphOpP :: Parser TransactionGraphOperator
77transactionGraphOpP =
78 jumpToHeadP
79 <|> jumpToTransactionP
80 <|> walkBackToTimeP
81 <|> branchTransactionP
82 <|> deleteBranchP
83 <|> commitTransactionP
84 <|> rollbackTransactionP
85 <|> mergeTransactionsP
87roTransactionGraphOpP :: Parser ROTransactionGraphOperator
88roTransactionGraphOpP = showGraphP
92{-
93-- for interpreter-specific operations
94interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)
95interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of
96 Left _ -> (trans, transGraph, NoActionResult)
97 Right ops -> case ops of
98 Left contextOp -> (trans, transGraph, (evalContextOp context contextOp))
99 Right graphOp -> case evalGraphOp newUUID trans transGraph graphOp of
100 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
101 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
102-}
104evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
105evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn
107evalConvenienceGraphOp :: SessionId -> Connection -> ConvenienceTransactionGraphOperator -> IO (Either RelationalError ())
108evalConvenienceGraphOp sessionId conn (AutoMergeToHead strat head') = autoMergeToHead sessionId conn strat head'