git.iko.soy/project-m36
on master help sign in
WIP: refactoring to allow for remote access in tutd
3a76afaAgentM
ProjectM36/Client.hs+70−17
compare with master
unifiedsplit
@@ -7,15 +7,20 @@ module ProjectM36.Client
7 DatabaseName,
7 DatabaseName,
8 ConnectionError,
8 ConnectionError,
9 connectProjectM36,
9 connectProjectM36,
10−-- disconnectedTransaction,
11−-- transactionGraph,
12 close,
10 close,
13 executeRelationalExpr,
11 executeRelationalExpr,
14 executeDatabaseContextExpr,
12 executeDatabaseContextExpr,
15 executeGraphExpr,
13 executeGraphExpr,
16 commit,
14 commit,
17 rollback,
15 rollback,
16+ typeForRelationalExpr,
17+ inclusionDependencies,
18+ planForDatabaseContextExpr,
19+ attributesForRelationalExpr,
18 processPersistence,
20 processPersistence,
21+ transactionGraphAsRelation,
22+ headName,
23+ headTransactionUUID,
19 PersistenceStrategy(..),
24 PersistenceStrategy(..),
20 RelationalExpr(..),
25 RelationalExpr(..),
21 DatabaseExpr(..),
26 DatabaseExpr(..),
@@ -25,11 +30,14 @@ module ProjectM36.Client
25 Atomable,
30 Atomable,
26 Atom(..),
31 Atom(..),
27 AtomType(..)) where
32 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
29import ProjectM36.Error
35import ProjectM36.Error
36+import ProjectM36.Relation
37+import ProjectM36.StaticOptimizer
30import Control.Monad.State
38import Control.Monad.State
31import ProjectM36.Transaction
39import ProjectM36.Transaction
32−import ProjectM36.RelationalExpression
40+import qualified ProjectM36.RelationalExpression as RE
33import ProjectM36.TransactionGraph
41import ProjectM36.TransactionGraph
34import ProjectM36.TransactionGraph.Persist
42import ProjectM36.TransactionGraph.Persist
35import ProjectM36.Attribute
43import ProjectM36.Attribute
@@ -41,12 +49,14 @@ import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)
41import Control.Distributed.Process.ManagedProcess.Client (call)
49import Control.Distributed.Process.ManagedProcess.Client (call)
42import Control.Distributed.Process (NodeId(..))
50import Control.Distributed.Process (NodeId(..))
43
51
52+import Data.UUID (UUID)
44import Data.UUID.V4 (nextRandom)
53import Data.UUID.V4 (nextRandom)
45import Control.Concurrent.STM
54import Control.Concurrent.STM
46import Data.Word
55import Data.Word
47import Control.Distributed.Process (ProcessId)
56import Control.Distributed.Process (ProcessId)
48import Control.Exception (IOException)
57import Control.Exception (IOException)
49import Control.Concurrent.MVar
58import Control.Concurrent.MVar
59+import qualified Data.Map as M
50
60
51type Hostname = StringType
61type Hostname = StringType
52
62
@@ -81,7 +91,7 @@ connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
81--create a new in-memory database/transaction graph
91--create a new in-memory database/transaction graph
82connectProjectM36 (InProcessConnectionInfo strat) = do
92connectProjectM36 (InProcessConnectionInfo strat) = do
83 freshUUID <- nextRandom
93 freshUUID <- nextRandom
84− let bootstrapContext = basicDatabaseContext
94+ let bootstrapContext = RE.basicDatabaseContext
85 freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext
95 freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext
86 freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext
96 freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext
87 case strat of
97 case strat of
@@ -129,15 +139,6 @@ connectPersistentProjectM36 strat sync dbdir freshDiscon freshGraph = do
129 tvar <- newTVarIO (freshDiscon, graph')
139 tvar <- newTVarIO (freshDiscon, graph')
130 return $ Right $ InProcessConnection strat tvar
140 return $ Right $ InProcessConnection strat tvar
131
141
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−
141close :: Connection -> IO ()
142close :: Connection -> IO ()
142close (InProcessConnection _ _) = pure ()
143close (InProcessConnection _ _) = pure ()
143close (RemoteProcessConnection serverProcessId) = do
144close (RemoteProcessConnection serverProcessId) = do
@@ -152,12 +153,12 @@ close (RemoteProcessConnection serverProcessId) = do
152executeRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
153executeRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
153executeRelationalExpr (InProcessConnection _ tvar) expr = atomically $ do
154executeRelationalExpr (InProcessConnection _ tvar) expr = atomically $ do
154 ((DisconnectedTransaction _ context), _) <- readTVar tvar
155 ((DisconnectedTransaction _ context), _) <- readTVar tvar
155− return $ evalState (evalRelationalExpr expr) context
156+ return $ evalState (RE.evalRelationalExpr expr) context
156
157
157executeDatabaseContextExpr :: Connection -> DatabaseExpr -> IO (Maybe RelationalError)
158executeDatabaseContextExpr :: Connection -> DatabaseExpr -> IO (Maybe RelationalError)
158executeDatabaseContextExpr (InProcessConnection _ tvar) expr = atomically $ do
159executeDatabaseContextExpr (InProcessConnection _ tvar) expr = atomically $ do
159 ((DisconnectedTransaction parentUUID context), graph) <- readTVar tvar
160 ((DisconnectedTransaction parentUUID context), graph) <- readTVar tvar
160− case runState (evalContextExpr expr) context of
161+ case runState (RE.evalContextExpr expr) context of
161 (Just err,_) -> return $ Just err
162 (Just err,_) -> return $ Just err
162 (Nothing, context') -> do
163 (Nothing, context') -> do
163 let newDiscon = DisconnectedTransaction parentUUID context'
164 let newDiscon = DisconnectedTransaction parentUUID context'
@@ -191,4 +192,56 @@ rollback conn = executeGraphExpr conn Rollback
191processPersistence :: PersistenceStrategy -> TransactionGraph -> IO ()
192processPersistence :: PersistenceStrategy -> TransactionGraph -> IO ()
192processPersistence NoPersistence _ = return ()
193processPersistence NoPersistence _ = return ()
193processPersistence (MinimalPersistence dbdir) graph = transactionGraphPersist NoDiskSync dbdir graph
194processPersistence (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
204 where
204 where
205 newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)
205 newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)
206
206
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−
213--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction
207--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction
214graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation
208graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation
215graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _ transSet) = do
209graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _ transSet) = do
@@ -242,3 +236,11 @@ transactionParentsRelation trans graph = do
242 where
236 where
243 attrs = A.attributesFromList [Attribute "id" stringAtomType]
237 attrs = A.attributesFromList [Attribute "id" stringAtomType]
244 trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (Atom (T.pack (show $ transactionUUID trans2)))
238 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
15import ProjectM36.Base
15import ProjectM36.Base
16import ProjectM36.Relation.Show.Term
16import ProjectM36.Relation.Show.Term
17import ProjectM36.TransactionGraph
17import ProjectM36.TransactionGraph
18−import ProjectM36.Client
18+import qualified ProjectM36.Client as C
19import Text.Parsec
19import Text.Parsec
20import Text.Parsec.String
20import Text.Parsec.String
21import Control.Monad.State
21import Control.Monad.State
22import System.Console.Haskeline
22import System.Console.Haskeline
23import System.Directory (getHomeDirectory)
23import System.Directory (getHomeDirectory)
24import qualified Data.Text as T
24import qualified Data.Text as T
25−import Data.UUID (UUID)
25+import Data.Maybe (fromMaybe)
26
26
27{-
27{-
28context ops are read-only operations which only operate on the database context (relvars and constraints)
28context ops are read-only operations which only operate on the database context (relvars and constraints)
@@ -33,7 +33,8 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
33 DatabaseExprOp DatabaseExpr |
33 DatabaseExprOp DatabaseExpr |
34 GraphOp TransactionGraphOperator |
34 GraphOp TransactionGraphOperator |
35 ROGraphOp ROTransactionGraphOperator |
35 ROGraphOp ROTransactionGraphOperator |
36− ImportOp DataImportOperator |
36+ ImportRelVarOp RelVarDataImportOperator |
37+ ImportDBContextOp DatabaseContextDataImportOperator |
37 ExportOp DataExportOperator
38 ExportOp DataExportOperator
38
39
39interpreterParserP :: Parser ParsedOperation
40interpreterParserP :: Parser ParsedOperation
@@ -41,63 +42,70 @@ interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eo
41 liftM GraphOp (transactionGraphOpP <* eof) <|>
42 liftM GraphOp (transactionGraphOpP <* eof) <|>
42 liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
43 liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
43 liftM DatabaseExprOp (databaseExprOpP <* eof) <|>
44 liftM DatabaseExprOp (databaseExprOpP <* eof) <|>
44− liftM ImportOp ((importCSVP <|> tutdImportP) <* eof) <|>
45+ liftM ImportRelVarOp (importCSVP <* eof) <|>
46+ liftM ImportDBContextOp (tutdImportP <* eof) <|>
45 liftM ExportOp (exportCSVP <* eof)
47 liftM ExportOp (exportCSVP <* eof)
46
48
47−promptText :: UUID -> TransactionGraph -> StringType
49+promptText :: Maybe HeadName -> StringType
48−promptText parentUUID graph = "TutorialD (" `T.append` transInfo `T.append` "): "
50+promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
49 where
51 where
50− transInfo = case transactionForUUID parentUUID graph of
52+ transInfo = fromMaybe "<unknown>" mHeadName
51− Left _ -> "unknown"
52− Right parentTrans -> case headNameForTransaction parentTrans graph of
53− Nothing -> T.pack (show $ transactionUUID parentTrans)
54− Just headName -> headName
55
53
56−parseTutorialD :: Connection -> String -> Either ParseError ParsedOperation
54+parseTutorialD :: String -> Either ParseError ParsedOperation
57−parseTutorialD (InProcessConnection _ _) inputString = parse interpreterParserP "" inputString
55+parseTutorialD inputString = parse interpreterParserP "" inputString
58
56
59--execute the operation and display result
57--execute the operation and display result
60−evalTutorialD :: Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
58+evalTutorialD :: C.Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
61evalTutorialD conn expr = case expr of
59evalTutorialD conn expr = case expr of
62
60
63 --this does not pass through the ProjectM36.Client library because the operations
61 --this does not pass through the ProjectM36.Client library because the operations
64 --are specific to the interpreter, though some operations may be of general use in the future
62 --are specific to the interpreter, though some operations may be of general use in the future
65 (RODatabaseContextOp execOp) -> do
63 (RODatabaseContextOp execOp) -> do
66− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
64+ evalRODatabaseContextOp conn execOp
67− return $ evalRODatabaseContextOp context execOp
68
65
69 (DatabaseExprOp execOp) -> do
66 (DatabaseExprOp execOp) -> do
70− maybeErr <- executeDatabaseContextExpr conn execOp
67+ maybeErr <- C.executeDatabaseContextExpr conn execOp
71 case maybeErr of
68 case maybeErr of
72 Just err -> barf err
69 Just err -> barf err
73 Nothing -> return QuietSuccessResult
70 Nothing -> return QuietSuccessResult
74
71
75 (GraphOp execOp) -> do
72 (GraphOp execOp) -> do
76− maybeErr <- executeGraphExpr conn execOp
73+ maybeErr <- C.executeGraphExpr conn execOp
77 case maybeErr of
74 case maybeErr of
78 Just err -> barf err
75 Just err -> barf err
79 Nothing -> return QuietSuccessResult
76 Nothing -> return QuietSuccessResult
80
77
81 (ROGraphOp execOp) -> do
78 (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
85 Left err -> barf err
81 Left err -> barf err
86 Right rel -> return $ DisplayResult $ showRelation rel
82 Right rel -> return $ DisplayResult $ showRelation rel
87
83
88− (ImportOp execOp) -> do
84+ (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) -> do
89− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
85+ -- collect attributes from relvar name
90− exprErr <- evalDataImportOperator execOp context
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
91− case exprErr of
98+ case mDbexprs of
92 Left err -> barf err
99 Left err -> barf err
93− Right dbexpr -> evalTutorialD conn (DatabaseExprOp dbexpr)
100+ Right dbexprs -> evalTutorialD conn (DatabaseExprOp dbexprs)
94
101
95 (ExportOp execOp) -> do
102 (ExportOp execOp) -> do
103+ evalDataExportOperator execOp
96− (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
104+{- (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
97 exprErr <- evalDataExportOperator execOp context
105 exprErr <- evalDataExportOperator execOp context
98 case exprErr of
106 case exprErr of
99 Just err -> barf err
107 Just err -> barf err
100− Nothing -> return QuietSuccessResult
108+ Nothing -> return QuietSuccessResult-}
101
109
102 where
110 where
103 barf err = return $ DisplayErrorResult (T.pack (show err))
111 barf err = return $ DisplayErrorResult (T.pack (show err))
@@ -106,17 +114,16 @@ data InterpreterConfig = InterpreterConfig {
106 persistenceStrategy :: PersistenceStrategy
114 persistenceStrategy :: PersistenceStrategy
107 }
115 }
108
116
109−reprLoop :: InterpreterConfig -> Connection -> IO ()
117+reprLoop :: InterpreterConfig -> C.Connection -> IO ()
110reprLoop config conn = do
118reprLoop config conn = do
111 homeDirectory <- getHomeDirectory
119 homeDirectory <- getHomeDirectory
112 let settings = defaultSettings {historyFile = Just (homeDirectory ++ "/.tutd_history")}
120 let settings = defaultSettings {historyFile = Just (homeDirectory ++ "/.tutd_history")}
113− (DisconnectedTransaction parentUUID _) <- disconnectedTransaction conn
121+ mHeadName <- C.headName conn
114− graph <- transactionGraph conn
115− maybeLine <- runInputT settings $ getInputLine (T.unpack (promptText parentUUID graph))
122+ maybeLine <- runInputT settings $ getInputLine (T.unpack (promptText mHeadName))
116 case maybeLine of
123 case maybeLine of
117 Nothing -> return ()
124 Nothing -> return ()
118 Just line -> do
125 Just line -> do
119− case parseTutorialD conn line of
126+ case parseTutorialD line of
120 Left err -> do
127 Left err -> do
121 displayOpResult $ DisplayErrorResult (T.pack (show err))
128 displayOpResult $ DisplayErrorResult (T.pack (show err))
122 Right parsed -> do
129 Right parsed -> do
TutorialD/Interpreter/Export/Base.hs+1−1
@@ -2,7 +2,7 @@ module TutorialD.Interpreter.Export.Base where
2import ProjectM36.Base
2import ProjectM36.Base
3import ProjectM36.Error
3import ProjectM36.Error
4
4
5−data DataExportOperator = DataExportOperator (DatabaseContext -> FilePath -> IO (Maybe RelationalError)) FilePath
5+data RelVarDataExportOperator = RelVarDataExportOperator (RelationalExpr -> FilePath -> IO (Maybe RelationalError)) FilePath
6
6
7evalDataExportOperator :: DataExportOperator -> DatabaseContext -> IO (Maybe RelationalError)
7evalDataExportOperator :: DataExportOperator -> DatabaseContext -> IO (Maybe RelationalError)
8evalDataExportOperator (DataExportOperator exportFunc pathOut) context = exportFunc context pathOut
8evalDataExportOperator (DataExportOperator exportFunc pathOut) context = exportFunc context pathOut
TutorialD/Interpreter/Import/Base.hs+13−8
@@ -2,11 +2,16 @@ module TutorialD.Interpreter.Import.Base where
2import ProjectM36.Base
2import ProjectM36.Base
3import ProjectM36.Error
3import ProjectM36.Error
4
4
5−data DataImportOperator = DataImportOperator FilePath (FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr))
5+-- | import data into a relation variable
6−
6+data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr))
7−evalDataImportOperator :: DataImportOperator -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
7+
8−evalDataImportOperator (DataImportOperator path importFunc) context = do
8+-- | import data into a database context
9− imported <- importFunc path context
9+data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseExpr))
10− case imported of
10+
11− Left err -> return $ Left err
11+-- perhaps create a structure to import a whole transaction graph section in the future
12− Right dbexprs -> return $ Right dbexprs
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
2import TutorialD.Interpreter.Import.Base
2import TutorialD.Interpreter.Import.Base
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.Error
4import ProjectM36.Error
5−import ProjectM36.Relation
6import ProjectM36.Relation.Parse.CSV
5import ProjectM36.Relation.Parse.CSV
7import qualified Data.ByteString.Lazy as BS
6import qualified Data.ByteString.Lazy as BS
8−import qualified Data.Map as M
9import qualified Data.Text as T
7import qualified Data.Text as T
10import Text.Parsec.String
8import Text.Parsec.String
11import TutorialD.Interpreter.Base
9import TutorialD.Interpreter.Base
12import Control.Exception
10import Control.Exception
13
11
14−importCSVRelation :: RelVarName -> FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
12+importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr)
15−importCSVRelation relVarName pathIn context = do
13+importCSVRelation relVarName attrs pathIn = do
16− case M.lookup relVarName (relationVariables context) of
17− Nothing -> return $ Left (RelVarNotDefinedError relVarName)
18− Just targetRel -> do
19− --TODO: handle filesystem errors
14+ --TODO: handle filesystem errors
20− csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
15+ csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
21− case csvData of
16+ case csvData of
22− Left err -> return $ Left (ImportError $ T.pack (show err))
17+ Left err -> return $ Left (ImportError $ T.pack (show err))
23− Right csvData' -> case csvAsRelation csvData' (attributes targetRel) of
18+ Right csvData' -> case csvAsRelation csvData' attrs of
24− Left err -> return $ Left (ParseError $ T.pack (show err))
19+ Left err -> return $ Left (ParseError $ T.pack (show err))
25− Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))
20+ Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))
26
21
27−importCSVP :: Parser DataImportOperator
22+importCSVP :: Parser RelVarDataImportOperator
28importCSVP = do
23importCSVP = do
29 reserved ":importcsv"
24 reserved ":importcsv"
30 path <- quotedString
25 path <- quotedString
31 whiteSpace
26 whiteSpace
32 relVarName <- identifier
27 relVarName <- identifier
33− return $ DataImportOperator path (importCSVRelation (T.pack relVarName))
28+ return $ RelVarDataImportOperator (T.pack relVarName) path importCSVRelation
34
29
TutorialD/Interpreter/Import/TutorialD.hs+4−4
@@ -11,8 +11,8 @@ import qualified Data.Text as T
11import Control.Exception
11import Control.Exception
12--import a file containing TutorialD database context expressions
12--import a file containing TutorialD database context expressions
13
13
14−importTutorialD :: FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr)
14+importTutorialD :: FilePath -> IO (Either RelationalError DatabaseExpr)
15−importTutorialD pathIn _ = do
15+importTutorialD pathIn = do
16 tutdData <- try (readFile pathIn) :: IO (Either IOError String)
16 tutdData <- try (readFile pathIn) :: IO (Either IOError String)
17 case tutdData of
17 case tutdData of
18 Left err -> return $ Left (ImportError $ T.pack (show err))
18 Left err -> return $ Left (ImportError $ T.pack (show err))
@@ -23,9 +23,9 @@ importTutorialD pathIn _ = do
23 err2:_ -> return $ Left (ParseError (T.pack (show err2)))
23 err2:_ -> return $ Left (ParseError (T.pack (show err2)))
24 [] -> return $ Right (MultipleExpr (rights dbexprsErr))
24 [] -> return $ Right (MultipleExpr (rights dbexprsErr))
25
25
26−tutdImportP :: Parser DataImportOperator
26+tutdImportP :: Parser DatabaseContextDataImportOperator
27tutdImportP = do
27tutdImportP = do
28 reserved ":importtutd"
28 reserved ":importtutd"
29 path <- quotedString
29 path <- quotedString
30 whiteSpace
30 whiteSpace
31− return $ DataImportOperator path importTutorialD
31+ return $ DatabaseContextDataImportOperator path importTutorialD
TutorialD/Interpreter/RODatabaseContextOperator.hs+35−32
@@ -1,9 +1,7 @@
1{-# LANGUAGE GADTs,OverloadedStrings #-}
1{-# LANGUAGE GADTs,OverloadedStrings #-}
2module TutorialD.Interpreter.RODatabaseContextOperator where
2module TutorialD.Interpreter.RODatabaseContextOperator where
3import ProjectM36.Base
3import ProjectM36.Base
4−import ProjectM36.Relation
4+import qualified ProjectM36.Client as C
5−import ProjectM36.RelationalExpression
6−import ProjectM36.StaticOptimizer
7import Text.Parsec
5import Text.Parsec
8import Text.Parsec.String
6import Text.Parsec.String
9import TutorialD.Interpreter.Base
7import TutorialD.Interpreter.Base
@@ -69,42 +67,47 @@ roDatabaseContextOperatorP = typeP
69 <|> showPlanP
67 <|> showPlanP
70 <|> quitP
68 <|> quitP
71
69
70+--logically, these read-only operations could happen purely, but not if a remote call is required
72−evalRODatabaseContextOp :: DatabaseContext -> RODatabaseContextOperator -> TutorialDOperatorResult
71+evalRODatabaseContextOp :: C.Connection -> RODatabaseContextOperator -> IO TutorialDOperatorResult
73−evalRODatabaseContextOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of
72+evalRODatabaseContextOp conn (ShowRelationType expr) = do
74− (Right rel, _) -> DisplayResult $ showRelationAttributes (attributes rel)
73+ res <- C.typeForRelationalExpr conn expr
74+ case res of
75− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
75+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)
76+ Right rel -> pure $ DisplayResult $ showRelation rel
76
77
77−evalRODatabaseContextOp context (ShowRelation expr) = do
78+evalRODatabaseContextOp conn (ShowRelation expr) = do
78− case runState (evalRelationalExpr expr) context of
79+ res <- C.executeRelationalExpr conn expr
80+ case res of
79− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
81+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)
80− (Right rel, _) -> DisplayResult $ showRelation rel
82+ Right rel -> pure $ DisplayResult $ showRelation rel
81
83
82−evalRODatabaseContextOp context (PlotRelation expr) = case runState (evalRelationalExpr expr) context of
84+evalRODatabaseContextOp conn (PlotRelation expr) = do
85+ res <- C.executeRelationalExpr conn expr
86+ pure $ case res of
83− (Left err, _) -> DisplayErrorResult $ T.pack (show err)
87+ Left err -> DisplayErrorResult $ T.pack (show err)
84−--(Right rel, _) -> DisplayIOResult $ showPlottedRelation rel
85− (Right rel, _) -> DisplayIOResult $ do
88+ Right rel -> DisplayIOResult $ do
86− err <- plotRelation rel
89+ err <- plotRelation rel
87− when (isJust err) $ putStrLn (show err)
90+ when (isJust err) $ putStrLn (show err)
88
91
89−evalRODatabaseContextOp context (ShowConstraint name) =
92+evalRODatabaseContextOp conn (ShowConstraint name) = do
93+ incDeps <- C.inclusionDependencies conn
90− case name of
94+ pure $ case name of
91− "" -> DisplayResult $ T.pack (show deps)
95+ "" -> DisplayResult $ T.pack (show incDeps)
92− depName -> case M.lookup depName deps of
96+ depName -> case M.lookup depName incDeps of
93 Nothing -> DisplayErrorResult "No such constraint."
97 Nothing -> DisplayErrorResult "No such constraint."
94 Just dep -> DisplayResult $ T.pack (show dep)
98 Just dep -> DisplayResult $ T.pack (show dep)
95− where
96− deps = inclusionDependencies context
97
99
98−evalRODatabaseContextOp context (ShowPlan dbExpr) = do
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))
99− DisplayResult $ T.pack (show plan)
104+ Right optDbExpr -> DisplayResult $ T.pack (show optDbExpr)
100− where
101− plan = evalState (applyStaticDatabaseOptimization dbExpr) context
102
105
103−evalRODatabaseContextOp _ (Quit) = QuitResult
106+evalRODatabaseContextOp _ (Quit) = pure QuitResult
104
107
105−interpretRODatabaseContextOp :: DatabaseContext -> String -> TutorialDOperatorResult
108+interpretRODatabaseContextOp :: C.Connection -> String -> IO TutorialDOperatorResult
106−interpretRODatabaseContextOp context tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
109+interpretRODatabaseContextOp conn tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
107− Left err -> DisplayErrorResult (T.pack (show err))
110+ Left err -> pure $ DisplayErrorResult (T.pack (show err))
108− Right parsed -> evalRODatabaseContextOp context parsed
111+ Right parsed -> evalRODatabaseContextOp conn parsed
109
112
110
113
TutorialD/Interpreter/TransactionGraphOperator.hs+6
@@ -6,6 +6,9 @@ import Text.Parsec.String
6import qualified Data.UUID as U
6import qualified Data.UUID as U
7import qualified Data.Text as T
7import qualified Data.Text as T
8import ProjectM36.TransactionGraph
8import ProjectM36.TransactionGraph
9+import ProjectM36.Client
10+import ProjectM36.Error
11+import ProjectM36.Base
9
12
10jumpToHeadP :: Parser TransactionGraphOperator
13jumpToHeadP :: Parser TransactionGraphOperator
11jumpToHeadP = do
14jumpToHeadP = do
@@ -70,3 +73,6 @@ interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instri
70 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
73 Left err -> (trans, transGraph, DisplayErrorResult $ T.pack (show err))
71 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
74 Right (newDiscon, newGraph, result) -> (newDiscon, newGraph, result)
72-}
75-}
76+
77+evalROGraphOp :: Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
78+evalROGraphOp conn ShowGraph = transactionGraphAsRelation conn
project-m36.cabal−1
@@ -92,7 +92,6 @@ Library
92
92
93Executable tutd
93Executable tutd
94 Build-Depends: base >=4.8 && <4.9,
94 Build-Depends: base >=4.8 && <4.9,
95− project-m36,
96 containers,
95 containers,
97 unordered-containers,
96 unordered-containers,
98 hashable,
97 hashable,