git.iko.soy/project-m36
on d64cdeb help sign in
project-m36/src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs
141 lines 5.3 kB history raw
1{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter.RODatabaseContextOperator where
3import ProjectM36.Base
4import ProjectM36.Error
5import ProjectM36.InclusionDependency
6import qualified ProjectM36.Client as C
7import Text.Megaparsec
8import Text.Megaparsec.Text
9import TutorialD.Interpreter.Base
10import TutorialD.Interpreter.RelationalExpr
11import TutorialD.Interpreter.DatabaseContextExpr
12import Control.Monad.State
13import qualified Data.Text as T
14import ProjectM36.Relation.Show.Gnuplot
15import qualified Data.Map as M
16import Data.Maybe
18--operators which only rely on database context reading
19data RODatabaseContextOperator where
20 ShowRelation :: RelationalExpr -> RODatabaseContextOperator
21 PlotRelation :: RelationalExpr -> RODatabaseContextOperator
22 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator
23 ShowConstraint :: StringType -> RODatabaseContextOperator
24 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator
25 ShowTypes :: RODatabaseContextOperator
26 ShowRelationVariables :: RODatabaseContextOperator
27 Quit :: RODatabaseContextOperator
28 deriving (Show)
30typeP :: Parser RODatabaseContextOperator
31typeP = do
32 reservedOp ":type"
33 expr <- relExprP
34 return $ ShowRelationType expr
36showRelP :: Parser RODatabaseContextOperator
37showRelP = do
38 reservedOp ":showexpr"
39 expr <- relExprP
40 return $ ShowRelation expr
42showPlanP :: Parser RODatabaseContextOperator
43showPlanP = do
44 reservedOp ":showplan"
45 expr <- databaseContextExprP
46 return $ ShowPlan expr
48showTypesP :: Parser RODatabaseContextOperator
49showTypesP = reserved ":showtypes" >> pure ShowTypes
51showRelationVariables :: Parser RODatabaseContextOperator
52showRelationVariables = reserved ":showrelvars" >> pure ShowRelationVariables
54quitP :: Parser RODatabaseContextOperator
55quitP = do
56 reservedOp ":quit"
57 return Quit
59showConstraintsP :: Parser RODatabaseContextOperator
60showConstraintsP = do
61 reservedOp ":constraints"
62 constraintName <- option "" identifier
63 return $ ShowConstraint constraintName
65plotRelExprP :: Parser RODatabaseContextOperator
66plotRelExprP = do
67 reserved ":plotexpr"
68 expr <- relExprP
69 return $ PlotRelation expr
71roDatabaseContextOperatorP :: Parser RODatabaseContextOperator
72roDatabaseContextOperatorP = typeP
73 <|> showRelP
74 <|> showRelationVariables
75 <|> plotRelExprP
76 <|> showConstraintsP
77 <|> showPlanP
78 <|> showTypesP
79 <|> quitP
81--logically, these read-only operations could happen purely, but not if a remote call is required
82evalRODatabaseContextOp :: C.SessionId -> C.Connection -> RODatabaseContextOperator -> IO TutorialDOperatorResult
83evalRODatabaseContextOp sessionId conn (ShowRelationType expr) = do
84 res <- C.typeForRelationalExpr sessionId conn expr
85 case res of
86 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
87 Right rel -> pure $ DisplayRelationResult rel
89evalRODatabaseContextOp sessionId conn (ShowRelation expr) = do
90 res <- C.executeRelationalExpr sessionId conn expr
91 case res of
92 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
93 Right rel -> pure $ DisplayRelationResult rel
95evalRODatabaseContextOp sessionId conn (PlotRelation expr) = do
96 res <- C.executeRelationalExpr sessionId conn expr
97 pure $ case res of
98 Left err -> DisplayErrorResult $ T.pack (show err)
99 Right rel -> DisplayIOResult $ do
100 err <- plotRelation rel
101 when (isJust err) $ print err
103evalRODatabaseContextOp sessionId conn (ShowConstraint name) = do
104 eIncDeps <- C.inclusionDependencies sessionId conn
105 let val = case eIncDeps of
106 Left err -> Left err
107 Right incDeps -> case name of
108 "" -> inclusionDependenciesAsRelation incDeps
109 depName -> case M.lookup depName incDeps of
110 Nothing -> Left (InclusionDependencyNameNotInUseError depName)
111 Just dep -> inclusionDependenciesAsRelation (M.singleton depName dep)
112 pure $ case val of
113 Left err -> DisplayErrorResult (T.pack (show err))
114 Right rel -> DisplayRelationResult rel
116evalRODatabaseContextOp sessionId conn (ShowPlan dbExpr) = do
117 plan <- C.planForDatabaseContextExpr sessionId conn dbExpr
118 pure $ case plan of
119 Left err -> DisplayErrorResult (T.pack (show err))
120 Right optDbExpr -> DisplayResult $ T.pack (show optDbExpr)
122evalRODatabaseContextOp sessionId conn ShowTypes = do
123 eRel <- C.atomTypesAsRelation sessionId conn
124 case eRel of
125 Left err -> pure $ DisplayErrorResult (T.pack (show err))
126 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
128evalRODatabaseContextOp sessionId conn ShowRelationVariables = do
129 eRel <- C.relationVariablesAsRelation sessionId conn
130 case eRel of
131 Left err -> pure $ DisplayErrorResult (T.pack (show err))
132 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
134evalRODatabaseContextOp _ _ Quit = pure QuitResult
136interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult
137interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
138 Left err -> pure $ DisplayErrorResult (T.pack (show err))
139 Right parsed -> evalRODatabaseContextOp sessionId conn parsed