git.iko.soy/project-m36
on runtime_constructors help sign in
project-m36/TutorialD/Interpreter/TransactionGraphOperator.hs
78 lines 2.5 kB history raw
1{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter.TransactionGraphOperator where
3import TutorialD.Interpreter.Base
4import Text.Parsec
5import Text.Parsec.String
6import qualified Data.UUID as U
7import qualified Data.Text as T
8import ProjectM36.TransactionGraph
9import ProjectM36.Client
10import ProjectM36.Error
11import ProjectM36.Base
13jumpToHeadP :: Parser TransactionGraphOperator
14jumpToHeadP = do
15 reservedOp ":jumphead"
16 headid <- identifier
17 return $ JumpToHead (T.pack headid)
19jumpToTransactionP :: Parser TransactionGraphOperator
20jumpToTransactionP = do
21 reservedOp ":jump"
22 uuid <- uuidP
23 return $ JumpToTransaction uuid
25branchTransactionP :: Parser TransactionGraphOperator
26branchTransactionP = do
27 reservedOp ":branch"
28 branchName <- identifier
29 return $ Branch (T.pack branchName)
31commitTransactionP :: Parser TransactionGraphOperator
32commitTransactionP = do
33 reservedOp ":commit"
34 return $ Commit
36rollbackTransactionP :: Parser TransactionGraphOperator
37rollbackTransactionP = do
38 reservedOp ":rollback"
39 return $ Rollback
41showGraphP :: Parser ROTransactionGraphOperator
42showGraphP = do
43 reservedOp ":showgraph"
44 return $ ShowGraph
46transactionGraphOpP :: Parser TransactionGraphOperator
47transactionGraphOpP = do
48 jumpToHeadP
49 <|> jumpToTransactionP
50 <|> branchTransactionP
51 <|> commitTransactionP
52 <|> rollbackTransactionP
54roTransactionGraphOpP :: Parser ROTransactionGraphOperator
55roTransactionGraphOpP = showGraphP
57uuidP :: Parser U.UUID
58uuidP = do
59 uuidStr <- many (alphaNum <|> char '-')
60 case U.fromString uuidStr of
61 Nothing -> fail "Invalid uuid string"
62 Just uuid -> return uuid
65{-
66-- for interpreter-specific operations
67interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)
68interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of
69 Left _ -> (trans, transGraph, NoActionResult)
70 Right ops -> case ops of
71 Left contextOp -> (trans, transGraph, (evalContextOp context contextOp))
72 Right graphOp -> case evalGraphOp newUUID trans transGraph graphOp of
73 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
74 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
75-}
77evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
78evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn