git.iko.soy/project-m36
on f7fc888 help sign in
project-m36/src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs
46 lines 2.1 kB history raw
1{-# LANGUAGE FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module TutorialD.Interpreter.TransGraphRelationalOperator where
4import ProjectM36.TransGraphRelationalExpression
5import ProjectM36.TransactionGraph
6import TutorialD.Interpreter.Types
7import qualified ProjectM36.Client as C
9import TutorialD.Interpreter.Base
10import TutorialD.Interpreter.RelationalExpr
12import qualified Data.Text as T
14instance RelationalMarkerExpr TransactionIdLookup where
15 parseMarkerP = string "@" *> transactionIdLookupP
17newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr
18 deriving Show
20transactionIdLookupP :: Parser TransactionIdLookup
21transactionIdLookupP = (TransactionIdLookup <$> uuidP) <|>
22 (TransactionIdHeadNameLookup <$> identifier <*> many transactionIdHeadBacktrackP)
24transactionIdHeadBacktrackP :: Parser TransactionIdHeadBacktrack
25transactionIdHeadBacktrackP = (string "~" *> (TransactionIdHeadParentBacktrack <$> backtrackP)) <|>
26 (string "^" *> (TransactionIdHeadBranchBacktrack <$> backtrackP)) <|>
27 (string "@" *> (TransactionStampHeadBacktrack <$> utcTimeP))
29backtrackP :: Parser Int
30backtrackP = fromIntegral <$> integer <|> pure 1
32transGraphRelationalOpP :: Parser TransGraphRelationalOperator
33transGraphRelationalOpP = showTransGraphRelationalOpP
35showTransGraphRelationalOpP :: Parser TransGraphRelationalOperator
36showTransGraphRelationalOpP = do
37 reservedOp ":showtransgraphexpr"
38 ShowTransGraphRelation <$> relExprP
40evalTransGraphRelationalOp :: C.SessionId -> C.Connection -> TransGraphRelationalOperator -> IO TutorialDOperatorResult
41evalTransGraphRelationalOp sessionId conn (ShowTransGraphRelation expr) = do
42 res <- C.executeTransGraphRelationalExpr sessionId conn expr
43 case res of
44 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
45 Right rel -> pure $ DisplayRelationResult rel