git.iko.soy/project-m36
on master help sign in
add first pass at client-facing library (not specific to Tutorial D)
870aadaAgentM
ProjectM36/Client.hsnew file+107
compare with master
unifiedsplit
@@ -0,0 +1,107 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module ProjectM36.Client where
3+import ProjectM36.Base
4+import ProjectM36.Error
5+import Control.Monad.State
6+import ProjectM36.Transaction
7+import ProjectM36.RelationalExpression
8+import ProjectM36.TransactionGraph
9+import ProjectM36.TransactionGraph.Persist
10+import Data.UUID.V4 (nextRandom)
11+import Control.Concurrent.STM
12+import qualified Data.Map as M
13+import Data.Word
14+
15+type DatabaseName = StringType
16+
17+type Hostname = StringType
18+
19+type Port = Word16
20+
21+data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy
22+ --TCPRemoteConnectionInfo HeadName DatabaseName Hostname Port
23+
24+data Connection = InProcessConnection PersistenceStrategy (TVar (DisconnectedTransaction, TransactionGraph))
25+ -- TCPRemoteConnection
26+
27+data ConnectionError = SetupDatabaseDirectoryError PersistenceError
28+ deriving (Show, Eq)
29+
30+-- connect to an in-process database
31+connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
32+--create a new in-memory database/transaction graph
33+connectProjectM36 (InProcessConnectionInfo strat) = do
34+ freshUUID <- nextRandom
35+ let bootstrapContext = DatabaseContext { inclusionDependencies = M.empty,
36+ relationVariables = M.empty,
37+ atomFunctions = basicAtomFunctions }
38+ freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext
39+ freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext
40+ case strat of
41+ --create date examples graph for now- probably should be empty context in the future
42+ NoPersistence -> do
43+ tvar <- newTVarIO (freshDiscon, freshGraph)
44+ return $ Right $ InProcessConnection strat tvar
45+ MinimalPersistence dbdir -> do
46+ err <- setupDatabaseDir dbdir freshGraph
47+ case err of
48+ Just err' -> return $ Left (SetupDatabaseDirectoryError err')
49+ Nothing -> do
50+ graph <- transactionGraphLoad dbdir emptyTransactionGraph
51+ case graph of
52+ Left err' -> return $ Left (SetupDatabaseDirectoryError err')
53+ Right graph' -> do
54+ tvar <- newTVarIO (freshDiscon, graph')
55+ return $ Right $ InProcessConnection strat tvar
56+
57+disconnectedTransaction :: Connection -> IO (DisconnectedTransaction)
58+disconnectedTransaction (InProcessConnection _ tvar) = liftM fst (readTVarIO tvar)
59+
60+transactionGraph :: Connection -> IO (TransactionGraph)
61+transactionGraph (InProcessConnection _ tvar) = liftM snd (readTVarIO tvar)
62+
63+close :: Connection -> IO ()
64+close (InProcessConnection _ _) = return ()
65+
66+executeRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
67+executeRelationalExpr (InProcessConnection _ tvar) expr = atomically $ do
68+ ((DisconnectedTransaction _ context), _) <- readTVar tvar
69+ return $ evalState (evalRelationalExpr expr) context
70+
71+executeDatabaseContextExpr :: Connection -> DatabaseExpr -> IO (Maybe RelationalError)
72+executeDatabaseContextExpr (InProcessConnection _ tvar) expr = atomically $ do
73+ ((DisconnectedTransaction parentUUID context), graph) <- readTVar tvar
74+ case runState (evalContextExpr expr) context of
75+ (Just err,_) -> return $ Just err
76+ (Nothing, context') -> do
77+ let newDiscon = DisconnectedTransaction parentUUID context'
78+ writeTVar tvar (newDiscon, graph)
79+ return Nothing
80+
81+executeGraphExpr :: Connection -> TransactionGraphOperator -> IO (Maybe RelationalError)
82+executeGraphExpr (InProcessConnection strat tvar) graphExpr = do
83+ freshUUID <- nextRandom
84+ manip <- atomically $ do
85+ (discon, graph) <- readTVar tvar
86+ case evalGraphOp freshUUID discon graph graphExpr of
87+ Left err -> return $ Left err
88+ Right (discon', graph') -> do
89+ writeTVar tvar (discon', graph')
90+ return $ Right (discon', graph')
91+ case manip of
92+ Left err -> return $ Just err
93+ Right (_, newGraph) -> do
94+ --update filesystem database, if necessary
95+ --this should really grab a lock at the beginning of the method to be threadsafe
96+ processPersistence strat newGraph
97+ return Nothing
98+
99+commit :: Connection -> IO (Maybe RelationalError)
100+commit conn = executeGraphExpr conn Commit
101+
102+rollback :: Connection -> IO (Maybe RelationalError)
103+rollback conn = executeGraphExpr conn Rollback
104+
105+processPersistence :: PersistenceStrategy -> TransactionGraph -> IO ()
106+processPersistence NoPersistence _ = return ()
107+processPersistence (MinimalPersistence dbdir) graph = transactionGraphPersist dbdir graph