git.iko.soy/project-m36
on master help sign in
WIP: refactoring to allow for remote access in tutd

-add clear remote access points in Interpreter.hs and friends -delete direct access to transaction graph and disconnected transaction -import works -export broken

commit3a76afa2f4bb30cf63115d870fb050590cb91f45 authorAgentM <agentm@themactionfaction.com> dateSat 14 Nov 2015, 23:28 (11 years ago) parent6518e14
10 files changed+188−118
compare with master
unifiedsplit
ProjectM36/Client.hs+70−17 ProjectM36/TransactionGraph.hs+8−6 TutorialD/Interpreter.hs+40−33 TutorialD/Interpreter/Export/Base.hs+1−1 TutorialD/Interpreter/Import/Base.hs+13−8 TutorialD/Interpreter/Import/CSV.hs+11−16 TutorialD/Interpreter/Import/TutorialD.hs+4−4 TutorialD/Interpreter/RODatabaseContextOperator.hs+35−32 TutorialD/Interpreter/TransactionGraphOperator.hs+6 project-m36.cabal−1
ProjectM36/Client.hs+70−17
@@ -7,15 +7,20 @@ module ProjectM36.Client
77 DatabaseName,
88 ConnectionError,
99 connectProjectM36,
10−-- disconnectedTransaction,
11−-- transactionGraph,
1210 close,
1311 executeRelationalExpr,
1412 executeDatabaseContextExpr,
1513 executeGraphExpr,
1614 commit,
1715 rollback,
16+ typeForRelationalExpr,
17+ inclusionDependencies,
18+ planForDatabaseContextExpr,
19+ attributesForRelationalExpr,
1820 processPersistence,
21+ transactionGraphAsRelation,
22+ headName,
23+ headTransactionUUID,
1924 PersistenceStrategy(..),
2025 RelationalExpr(..),
2126 DatabaseExpr(..),
@@ -25,11 +30,14 @@ module ProjectM36.Client
2530 Atomable,
2631 Atom(..),
2732 AtomType(..)) where
28−import ProjectM36.Base
33+import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well
34+import qualified ProjectM36.Base as B
2935import ProjectM36.Error
36+import ProjectM36.Relation
37+import ProjectM36.StaticOptimizer
3038import Control.Monad.State
3139import ProjectM36.Transaction
32−import ProjectM36.RelationalExpression
40+import qualified ProjectM36.RelationalExpression as RE
3341import ProjectM36.TransactionGraph
3442import ProjectM36.TransactionGraph.Persist
3543import ProjectM36.Attribute
@@ -41,12 +49,14 @@ import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)
4149import Control.Distributed.Process.ManagedProcess.Client (call)
4250import Control.Distributed.Process (NodeId(..))
4351
52+import Data.UUID (UUID)
4453import Data.UUID.V4 (nextRandom)
4554import Control.Concurrent.STM
4655import Data.Word
4756import Control.Distributed.Process (ProcessId)
4857import Control.Exception (IOException)
4958import Control.Concurrent.MVar
59+import qualified Data.Map as M
5060
5161type Hostname = StringType
5262
@@ -81,7 +91,7 @@ connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
8191--create a new in-memory database/transaction graph
8292connectProjectM36 (InProcessConnectionInfo strat) = do
8393 freshUUID <- nextRandom
84− let bootstrapContext = basicDatabaseContext
94+ let bootstrapContext = RE.basicDatabaseContext
8595 freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext
8696 freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext
8797 case strat of
@@ -129,15 +139,6 @@ connectPersistentProjectM36 strat sync dbdir freshDiscon freshGraph = do
129139 tvar <- newTVarIO (freshDiscon, graph')
130140 return $ Right $ InProcessConnection strat tvar
131141
132−{-
133−-- if these are operated remotely, they are too expensive- keep the working space (discon) on the server
134−disconnectedTransaction :: Connection -> IO (DisconnectedTransaction)
135−disconnectedTransaction (InProcessConnection _ tvar) = liftM fst (readTVarIO tvar)
136−
137−transactionGraph :: Connection -> IO (TransactionGraph)
138−transactionGraph (InProcessConnection _ tvar) = liftM snd (readTVarIO tvar)
139−-}
140−
141142close :: Connection -> IO ()
142143close (InProcessConnection _ _) = pure ()
143144close (RemoteProcessConnection serverProcessId) = do
@@ -152,12 +153,12 @@ close (RemoteProcessConnection serverProcessId) = do
152153executeRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
153154executeRelationalExpr (InProcessConnection _ tvar) expr = atomically $ do
154155 ((DisconnectedTransaction _ context), _) <- readTVar tvar
155− return $ evalState (evalRelationalExpr expr) context
156+ return $ evalState (RE.evalRelationalExpr expr) context
156157
157158executeDatabaseContextExpr :: Connection -> DatabaseExpr -> IO (Maybe RelationalError)
158159executeDatabaseContextExpr (InProcessConnection _ tvar) expr = atomically $ do
159160 ((DisconnectedTransaction parentUUID context), graph) <- readTVar tvar
160− case runState (evalContextExpr expr) context of
161+ case runState (RE.evalContextExpr expr) context of
161162 (Just err,_) -> return $ Just err
162163 (Nothing, context') -> do
163164 let newDiscon = DisconnectedTransaction parentUUID context'
@@ -191,4 +192,56 @@ rollback conn = executeGraphExpr conn Rollback
191192processPersistence :: PersistenceStrategy -> TransactionGraph -> IO ()
192193processPersistence NoPersistence _ = return ()
193194processPersistence (MinimalPersistence dbdir) graph = transactionGraphPersist NoDiskSync dbdir graph
194−processPersistence (CrashSafePersistence dbdir) graph = transactionGraphPersist FsyncDiskSync dbdir graph
195+processPersistence (CrashSafePersistence dbdir) graph = transactionGraphPersist FsyncDiskSync dbdir graph
196+
197+typeForRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
198+typeForRelationalExpr conn@(InProcessConnection _ _) relExpr = atomically $ typeForRelationalExprSTM conn relExpr
199+
200+typeForRelationalExprSTM :: Connection -> RelationalExpr -> STM (Either RelationalError Relation)
201+typeForRelationalExprSTM (InProcessConnection _ tvar) relExpr = do
202+ (DisconnectedTransaction _ context, _) <- readTVar tvar
203+ pure $ evalState (RE.typeForRelationalExpr relExpr) context
204+
205+inclusionDependencies :: Connection -> IO (M.Map IncDepName InclusionDependency)
206+inclusionDependencies (InProcessConnection _ tvar) = do
207+ atomically $ do
208+ ((DisconnectedTransaction _ context), _) <- readTVar tvar
209+ pure (B.inclusionDependencies context)
210+
211+planForDatabaseContextExpr :: Connection -> DatabaseExpr -> IO (Either RelationalError DatabaseExpr)
212+planForDatabaseContextExpr (InProcessConnection _ tvar) dbExpr = do
213+ atomically $ do
214+ ((DisconnectedTransaction _ context), _) <- readTVar tvar
215+ pure $ evalState (applyStaticDatabaseOptimization dbExpr) context
216+
217+transactionGraphAsRelation :: Connection -> IO (Either RelationalError Relation)
218+transactionGraphAsRelation (InProcessConnection _ tvar) = do
219+ atomically $ do
220+ (discon, graph) <- readTVar tvar
221+ pure $ graphAsRelation discon graph
222+
223+attributesForRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Attributes)
224+attributesForRelationalExpr conn relExpr = atomically $ do
225+ eRelType <- typeForRelationalExprSTM conn relExpr
226+ pure $ case eRelType of
227+ Left err -> Left err
228+ Right relType -> Right $ attributes relType
229+
230+-- | Returns the UUID for the connection's disconnected transaction committed parent transaction.
231+headTransactionUUID :: Connection -> IO (UUID)
232+headTransactionUUID (InProcessConnection _ tvar) = do
233+ atomically $ do
234+ (DisconnectedTransaction parentUUID _, _) <- readTVar tvar
235+ pure parentUUID
236+
237+-- | Returns Just the name of the head of the current disconnected transaction or Nothing.
238+headName :: Connection -> IO (Maybe HeadName)
239+headName (InProcessConnection _ tvar) = do
240+ atomically $ do
241+ (DisconnectedTransaction parentUUID _, graph) <- readTVar tvar
242+ pure $ case transactionForUUID parentUUID graph of
243+ Left _ -> Nothing
244+ Right parentTrans -> headNameForTransaction parentTrans graph
245+
246+
247+
ProjectM36/TransactionGraph.hs+8−6
@@ -204,12 +204,6 @@ evalGraphOp _ (DisconnectedTransaction parentUUID _) graph Rollback = case trans
204204 where
205205 newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)
206206
207−--display transaction graph as relation
208−evalROGraphOp :: DisconnectedTransaction -> TransactionGraph -> ROTransactionGraphOperator -> Either RelationalError Relation
209−evalROGraphOp discon graph ShowGraph = do
210− graphRel <- graphAsRelation discon graph
211− return graphRel
212−
213207--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction
214208graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation
215209graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _ transSet) = do
@@ -242,3 +236,11 @@ transactionParentsRelation trans graph = do
242236 where
243237 attrs = A.attributesFromList [Attribute "id" stringAtomType]
244238 trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (Atom (T.pack (show $ transactionUUID trans2)))
239+
240+{-
241+--display transaction graph as relation
242+evalROGraphOp :: DisconnectedTransaction -> TransactionGraph -> ROTransactionGraphOperator -> Either RelationalError Relation
243+evalROGraphOp discon graph ShowGraph = do
244+ graphRel <- graphAsRelation discon graph
245+ return graphRel
246+-}
TutorialD/Interpreter.hs+40−33
@@ -15,14 +15,14 @@ import TutorialD.Interpreter.Export.Base
1515import ProjectM36.Base
1616import ProjectM36.Relation.Show.Term
1717import ProjectM36.TransactionGraph
18−import ProjectM36.Client
18+import qualified ProjectM36.Client as C
1919import Text.Parsec
2020import Text.Parsec.String
2121import Control.Monad.State
2222import System.Console.Haskeline
2323import System.Directory (getHomeDirectory)
2424import qualified Data.Text as T
25−import Data.UUID (UUID)
25+import Data.Maybe (fromMaybe)
2626
2727{-
2828context ops are read-only operations which only operate on the database context (relvars and constraints)
@@ -33,7 +33,8 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
3333 DatabaseExprOp DatabaseExpr |
3434 GraphOp TransactionGraphOperator |
3535 ROGraphOp ROTransactionGraphOperator |
36− ImportOp DataImportOperator |
36+ ImportRelVarOp RelVarDataImportOperator |
37+ ImportDBContextOp DatabaseContextDataImportOperator |
3738 ExportOp DataExportOperator
3839
3940interpreterParserP :: Parser ParsedOperation
@@ -41,63 +42,70 @@ interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eo
4142 liftM GraphOp (transactionGraphOpP <* eof) <|>
4243 liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
4344 liftM DatabaseExprOp (databaseExprOpP <* eof) <|>
44− liftM ImportOp ((importCSVP <|> tutdImportP) <* eof) <|>
45+ liftM ImportRelVarOp (importCSVP <* eof) <|>
46+ liftM ImportDBContextOp (tutdImportP <* eof) <|>
4547 liftM ExportOp (exportCSVP <* eof)
4648
47−promptText :: UUID -> TransactionGraph -> StringType
48−promptText parentUUID graph = "TutorialD (" `T.append` transInfo `T.append` "): "
49+promptText :: Maybe HeadName -> StringType
50+promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
4951 where
50− transInfo = case transactionForUUID parentUUID graph of
51− Left _ -> "unknown"
52− Right parentTrans -> case headNameForTransaction parentTrans graph of
53− Nothing -> T.pack (show $ transactionUUID parentTrans)
54− Just headName -> headName
52+ transInfo = fromMaybe "<unknown>" mHeadName
5553
56−parseTutorialD :: Connection -> String -> Either ParseError ParsedOperation
57−parseTutorialD (InProcessConnection _ _) inputString = parse interpreterParserP "" inputString
54+parseTutorialD :: String -> Either ParseError ParsedOperation
55+parseTutorialD inputString = parse interpreterParserP "" inputString
5856
5957--execute the operation and display result
60−evalTutorialD :: Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
58+evalTutorialD :: C.Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
6159evalTutorialD conn expr = case expr of
6260
6361 --this does not pass through the ProjectM36.Client library because the operations
6462 --are specific to the interpreter, though some operations may be of general use in the future
6563 (RODatabaseContextOp execOp) -> do
66− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
67− return $ evalRODatabaseContextOp context execOp
64+ evalRODatabaseContextOp conn execOp
6865
6966 (DatabaseExprOp execOp) -> do
70− maybeErr <- executeDatabaseContextExpr conn execOp
67+ maybeErr <- C.executeDatabaseContextExpr conn execOp
7168 case maybeErr of
7269 Just err -> barf err
7370 Nothing -> return QuietSuccessResult
7471
7572 (GraphOp execOp) -> do
76− maybeErr <- executeGraphExpr conn execOp
73+ maybeErr <- C.executeGraphExpr conn execOp
7774 case maybeErr of
7875 Just err -> barf err
7976 Nothing -> return QuietSuccessResult
8077
8178 (ROGraphOp execOp) -> do
82− discon <- disconnectedTransaction conn -- !
83− graph <- transactionGraph conn
84− case evalROGraphOp discon graph execOp of
79+ opResult <- evalROGraphOp conn execOp
80+ case opResult of
8581 Left err -> barf err
8682 Right rel -> return $ DisplayResult $ showRelation rel
8783
88− (ImportOp execOp) -> do
89− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
90− exprErr <- evalDataImportOperator execOp context
91− case exprErr of
84+ (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) -> do
85+ -- collect attributes from relvar name
86+ -- is there a race condition here? The attributes of the relvar may have since changed, no?
87+ eImportAttributes <- C.attributesForRelationalExpr conn (RelationVariable relVarName)
88+ case eImportAttributes of
89+ Left err -> barf err
90+ Right importAttributes -> do
91+ exprErr <- evalRelVarDataImportOperator execOp importAttributes
92+ case exprErr of
93+ Left err -> barf err
94+ Right dbexpr -> evalTutorialD conn (DatabaseExprOp dbexpr)
95+
96+ (ImportDBContextOp execOp) -> do
97+ mDbexprs <- evalDatabaseContextDataImportOperator execOp
98+ case mDbexprs of
9299 Left err -> barf err
93− Right dbexpr -> evalTutorialD conn (DatabaseExprOp dbexpr)
100+ Right dbexprs -> evalTutorialD conn (DatabaseExprOp dbexprs)
94101
95102 (ExportOp execOp) -> do
96− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
103+ evalDataExportOperator execOp
104+{- (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
97105 exprErr <- evalDataExportOperator execOp context
98106 case exprErr of
99107 Just err -> barf err
100− Nothing -> return QuietSuccessResult
108+ Nothing -> return QuietSuccessResult-}
101109
102110 where
103111 barf err = return $ DisplayErrorResult (T.pack (show err))
@@ -106,17 +114,16 @@ data InterpreterConfig = InterpreterConfig {
106114 persistenceStrategy :: PersistenceStrategy
107115 }
108116
109−reprLoop :: InterpreterConfig -> Connection -> IO ()
117+reprLoop :: InterpreterConfig -> C.Connection -> IO ()
110118reprLoop config conn = do
111119 homeDirectory <- getHomeDirectory
112120 let settings = defaultSettings {historyFile = Just (homeDirectory ++ "/.tutd_history")}
113− (DisconnectedTransaction parentUUID _) <- disconnectedTransaction conn
114− graph <- transactionGraph conn
115− maybeLine <- runInputT settings $ getInputLine (T.unpack (promptText parentUUID graph))
121+ mHeadName <- C.headName conn
122+ maybeLine <- runInputT settings $ getInputLine (T.unpack (promptText mHeadName))
116123 case maybeLine of
117124 Nothing -> return ()
118125 Just line -> do
119− case parseTutorialD conn line of
126+ case parseTutorialD line of
120127 Left err -> do
121128 displayOpResult $ DisplayErrorResult (T.pack (show err))
122129 Right parsed -> do
TutorialD/Interpreter/Export/Base.hs+1−1
@@ -2,7 +2,7 @@ module TutorialD.Interpreter.Export.Base where
22import ProjectM36.Base
33import ProjectM36.Error
44
5−data DataExportOperator = DataExportOperator (DatabaseContext -> FilePath -> IO (Maybe RelationalError)) FilePath
5+data RelVarDataExportOperator = RelVarDataExportOperator (RelationalExpr -> FilePath -> IO (Maybe RelationalError)) FilePath
66
77evalDataExportOperator :: DataExportOperator -> DatabaseContext -> IO (Maybe RelationalError)
88evalDataExportOperator (DataExportOperator exportFunc pathOut) context = exportFunc context pathOut
TutorialD/Interpreter/Import/Base.hs+13−8
@@ -2,11 +2,16 @@ module TutorialD.Interpreter.Import.Base where
22import ProjectM36.Base
33import ProjectM36.Error
44
5−data DataImportOperator = DataImportOperator FilePath (FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr))
6−
7−evalDataImportOperator :: DataImportOperator -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
8−evalDataImportOperator (DataImportOperator path importFunc) context = do
9− imported <- importFunc path context
10− case imported of
11− Left err -> return $ Left err
12− Right dbexprs -> return $ Right dbexprs
5+-- | import data into a relation variable
6+data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr))
7+
8+-- | import data into a database context
9+data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseExpr))
10+
11+-- perhaps create a structure to import a whole transaction graph section in the future
12+
13+evalRelVarDataImportOperator :: RelVarDataImportOperator -> Attributes -> IO (Either RelationalError DatabaseExpr)
14+evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) attrs = importFunc relVarName attrs path
15+
16+evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseExpr)
17+evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator path importFunc) = importFunc path
TutorialD/Interpreter/Import/CSV.hs+11−16
@@ -2,33 +2,28 @@ module TutorialD.Interpreter.Import.CSV where
22import TutorialD.Interpreter.Import.Base
33import ProjectM36.Base
44import ProjectM36.Error
5−import ProjectM36.Relation
65import ProjectM36.Relation.Parse.CSV
76import qualified Data.ByteString.Lazy as BS
8−import qualified Data.Map as M
97import qualified Data.Text as T
108import Text.Parsec.String
119import TutorialD.Interpreter.Base
1210import Control.Exception
1311
14−importCSVRelation :: RelVarName -> FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
15−importCSVRelation relVarName pathIn context = do
16− case M.lookup relVarName (relationVariables context) of
17− Nothing -> return $ Left (RelVarNotDefinedError relVarName)
18− Just targetRel -> do
19− --TODO: handle filesystem errors
20− csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
21− case csvData of
22− Left err -> return $ Left (ImportError $ T.pack (show err))
23− Right csvData' -> case csvAsRelation csvData' (attributes targetRel) of
24− Left err -> return $ Left (ParseError $ T.pack (show err))
25− Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))
12+importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr)
13+importCSVRelation relVarName attrs pathIn = do
14+ --TODO: handle filesystem errors
15+ csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
16+ case csvData of
17+ Left err -> return $ Left (ImportError $ T.pack (show err))
18+ Right csvData' -> case csvAsRelation csvData' attrs of
19+ Left err -> return $ Left (ParseError $ T.pack (show err))
20+ Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))
2621
27−importCSVP :: Parser DataImportOperator
22+importCSVP :: Parser RelVarDataImportOperator
2823importCSVP = do
2924 reserved ":importcsv"
3025 path <- quotedString
3126 whiteSpace
3227 relVarName <- identifier
33− return $ DataImportOperator path (importCSVRelation (T.pack relVarName))
28+ return $ RelVarDataImportOperator (T.pack relVarName) path importCSVRelation
3429
TutorialD/Interpreter/Import/TutorialD.hs+4−4
@@ -11,8 +11,8 @@ import qualified Data.Text as T
1111import Control.Exception
1212--import a file containing TutorialD database context expressions
1313
14−importTutorialD :: FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
15−importTutorialD pathIn _ = do
14+importTutorialD :: FilePath -> IO (Either RelationalError DatabaseExpr)
15+importTutorialD pathIn = do
1616 tutdData <- try (readFile pathIn) :: IO (Either IOError String)
1717 case tutdData of
1818 Left err -> return $ Left (ImportError $ T.pack (show err))
@@ -23,9 +23,9 @@ importTutorialD pathIn _ = do
2323 err2:_ -> return $ Left (ParseError (T.pack (show err2)))
2424 [] -> return $ Right (MultipleExpr (rights dbexprsErr))
2525
26−tutdImportP :: Parser DataImportOperator
26+tutdImportP :: Parser DatabaseContextDataImportOperator
2727tutdImportP = do
2828 reserved ":importtutd"
2929 path <- quotedString
3030 whiteSpace
31− return $ DataImportOperator path importTutorialD
31+ return $ DatabaseContextDataImportOperator path importTutorialD
TutorialD/Interpreter/RODatabaseContextOperator.hs+35−32
@@ -1,9 +1,7 @@
11{-# LANGUAGE GADTs,OverloadedStrings #-}
22module TutorialD.Interpreter.RODatabaseContextOperator where
33import ProjectM36.Base
4−import ProjectM36.Relation
5−import ProjectM36.RelationalExpression
6−import ProjectM36.StaticOptimizer
4+import qualified ProjectM36.Client as C
75import Text.Parsec
86import Text.Parsec.String
97import TutorialD.Interpreter.Base
@@ -69,42 +67,47 @@ roDatabaseContextOperatorP = typeP
6967 <|> showPlanP
7068 <|> quitP
7169
72−evalRODatabaseContextOp :: DatabaseContext -> RODatabaseContextOperator -> TutorialDOperatorResult
73−evalRODatabaseContextOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of
74− (Right rel, _) -> DisplayResult $ showRelationAttributes (attributes rel)
75− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
70+--logically, these read-only operations could happen purely, but not if a remote call is required
71+evalRODatabaseContextOp :: C.Connection -> RODatabaseContextOperator -> IO TutorialDOperatorResult
72+evalRODatabaseContextOp conn (ShowRelationType expr) = do
73+ res <- C.typeForRelationalExpr conn expr
74+ case res of
75+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)
76+ Right rel -> pure $ DisplayResult $ showRelation rel
7677
77−evalRODatabaseContextOp context (ShowRelation expr) = do
78− case runState (evalRelationalExpr expr) context of
79− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
80− (Right rel, _) -> DisplayResult $ showRelation rel
78+evalRODatabaseContextOp conn (ShowRelation expr) = do
79+ res <- C.executeRelationalExpr conn expr
80+ case res of
81+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)
82+ Right rel -> pure $ DisplayResult $ showRelation rel
8183
82−evalRODatabaseContextOp context (PlotRelation expr) = case runState (evalRelationalExpr expr) context of
83− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
84−--(Right rel, _) -> DisplayIOResult $ showPlottedRelation rel
85− (Right rel, _) -> DisplayIOResult $ do
86− err <- plotRelation rel
87− when (isJust err) $ putStrLn (show err)
84+evalRODatabaseContextOp conn (PlotRelation expr) = do
85+ res <- C.executeRelationalExpr conn expr
86+ pure $ case res of
87+ Left err -> DisplayErrorResult $ T.pack (show err)
88+ Right rel -> DisplayIOResult $ do
89+ err <- plotRelation rel
90+ when (isJust err) $ putStrLn (show err)
8891
89−evalRODatabaseContextOp context (ShowConstraint name) =
90− case name of
91− "" -> DisplayResult $ T.pack (show deps)
92− depName -> case M.lookup depName deps of
92+evalRODatabaseContextOp conn (ShowConstraint name) = do
93+ incDeps <- C.inclusionDependencies conn
94+ pure $ case name of
95+ "" -> DisplayResult $ T.pack (show incDeps)
96+ depName -> case M.lookup depName incDeps of
9397 Nothing -> DisplayErrorResult "No such constraint."
9498 Just dep -> DisplayResult $ T.pack (show dep)
95− where
96− deps = inclusionDependencies context
9799
98−evalRODatabaseContextOp context (ShowPlan dbExpr) = do
99− DisplayResult $ T.pack (show plan)
100− where
101− plan = evalState (applyStaticDatabaseOptimization dbExpr) context
100+evalRODatabaseContextOp conn (ShowPlan dbExpr) = do
101+ plan <- C.planForDatabaseContextExpr conn dbExpr
102+ pure $ case plan of
103+ Left err -> DisplayErrorResult (T.pack (show err))
104+ Right optDbExpr -> DisplayResult $ T.pack (show optDbExpr)
102105
103−evalRODatabaseContextOp _ (Quit) = QuitResult
106+evalRODatabaseContextOp _ (Quit) = pure QuitResult
104107
105−interpretRODatabaseContextOp :: DatabaseContext -> String -> TutorialDOperatorResult
106−interpretRODatabaseContextOp context tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
107− Left err -> DisplayErrorResult (T.pack (show err))
108− Right parsed -> evalRODatabaseContextOp context parsed
108+interpretRODatabaseContextOp :: C.Connection -> String -> IO TutorialDOperatorResult
109+interpretRODatabaseContextOp conn tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
110+ Left err -> pure $ DisplayErrorResult (T.pack (show err))
111+ Right parsed -> evalRODatabaseContextOp conn parsed
109112
110113
TutorialD/Interpreter/TransactionGraphOperator.hs+6
@@ -6,6 +6,9 @@ import Text.Parsec.String
66import qualified Data.UUID as U
77import qualified Data.Text as T
88import ProjectM36.TransactionGraph
9+import ProjectM36.Client
10+import ProjectM36.Error
11+import ProjectM36.Base
912
1013jumpToHeadP :: Parser TransactionGraphOperator
1114jumpToHeadP = do
@@ -70,3 +73,6 @@ interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instri
7073 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
7174 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
7275-}
76+
77+evalROGraphOp :: Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
78+evalROGraphOp conn ShowGraph = transactionGraphAsRelation conn
project-m36.cabal−1
@@ -92,7 +92,6 @@ Library
9292
9393Executable tutd
9494 Build-Depends: base >=4.8 && <4.9,
95− project-m36,
9695 containers,
9796 unordered-containers,
9897 hashable,