git.iko.soy/project-m36
on master help sign in
more sessionizing
commitdda2c778a5aa02816d61c2e05b0afc1f08da449d authorAgentM <agentm@themactionfaction.com> dateMon 30 Nov 2015, 23:06 (11 years ago) parentac0c8ad
6 files changed+85−63
compare with master
unifiedsplit
ProjectM36/Server.hs+9−9 ProjectM36/Server/EntryPoints.hs+29−32 benchmark/bigrel.hs+2−2 examples/PersistClient.hs+20 examples/SimpleClient.hs+21−16 project-m36.cabal+4−4
ProjectM36/Server.hs+9−9
@@ -20,15 +20,15 @@ import Control.Concurrent.MVar (putMVar, MVar)
2020serverDefinition :: ProcessDefinition Connection
2121serverDefinition = defaultProcess {
2222 apiHandlers = [
23− handleCall (\conn ExecuteHeadName -> handleExecuteHeadName conn),
24− handleCall (\conn (ExecuteRelationalExpr expr) -> handleExecuteRelationalExpr conn expr),
25− handleCall (\conn (ExecuteDatabaseContextExpr expr) -> handleExecuteDatabaseContextExpr conn expr),
26− handleCall (\conn (ExecuteGraphExpr expr) -> handleExecuteGraphExpr conn expr),
27− handleCall (\conn (ExecuteTypeForRelationalExpr expr) -> handleExecuteTypeForRelationalExpr conn expr),
28− handleCall (\conn RetrieveInclusionDependencies -> handleRetrieveInclusionDependencies conn),
29− handleCall (\conn (RetrievePlanForDatabaseContextExpr dbExpr) -> handleRetrievePlanForDatabaseContextExpr conn dbExpr),
30− handleCall (\conn RetrieveHeadTransactionUUID -> handleRetrieveHeadTransactionUUID conn),
31− handleCall (\conn RetrieveTransactionGraph -> handleRetrieveTransactionGraph conn),
23+ handleCall (\conn (ExecuteHeadName sessionId) -> handleExecuteHeadName sessionId conn),
24+ handleCall (\conn (ExecuteRelationalExpr sessionId expr) -> handleExecuteRelationalExpr sessionId conn expr),
25+ handleCall (\conn (ExecuteDatabaseContextExpr sessionId expr) -> handleExecuteDatabaseContextExpr sessionId conn expr),
26+ handleCall (\conn (ExecuteGraphExpr sessionId expr) -> handleExecuteGraphExpr sessionId conn expr),
27+ handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr sessionId conn expr),
28+ handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies sessionId conn),
29+ handleCall (\conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> handleRetrievePlanForDatabaseContextExpr sessionId conn dbExpr),
30+ handleCall (\conn (RetrieveHeadTransactionUUID sessionId) -> handleRetrieveHeadTransactionUUID sessionId conn),
31+ handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph sessionId conn),
3232 handleCall (\conn Login -> handleLogin conn)
3333 ],
3434 unhandledMessagePolicy = Log
ProjectM36/Server/EntryPoints.hs+29−32
@@ -8,54 +8,51 @@ import Control.Distributed.Process.ManagedProcess.Server (reply)
88import Control.Monad.IO.Class (liftIO)
99import Data.Map
1010import Data.UUID (UUID)
11−import Data.UUID.V4 (nextRandom)
1211
13−handleExecuteRelationalExpr :: Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)
14−handleExecuteRelationalExpr conn expr = do
15− ret <- liftIO $ executeRelationalExpr conn expr
12+handleExecuteRelationalExpr :: SessionId -> Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)
13+handleExecuteRelationalExpr sessionId conn expr = do
14+ ret <- liftIO $ executeRelationalExpr sessionId conn expr
1615 reply ret conn
1716
18−handleExecuteDatabaseContextExpr :: Connection -> DatabaseExpr -> Process (ProcessReply (Maybe RelationalError) Connection)
19−handleExecuteDatabaseContextExpr conn dbexpr = do
20− ret <- liftIO $ executeDatabaseContextExpr conn dbexpr
17+handleExecuteDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> Process (ProcessReply (Maybe RelationalError) Connection)
18+handleExecuteDatabaseContextExpr sessionId conn dbexpr = do
19+ ret <- liftIO $ executeDatabaseContextExpr sessionId conn dbexpr
2120 reply ret conn
2221
23−handleExecuteHeadName :: Connection -> Process (ProcessReply (Maybe HeadName) Connection)
24−handleExecuteHeadName conn = do
25− ret <- liftIO $ headName conn
22+handleExecuteHeadName :: SessionId -> Connection -> Process (ProcessReply (Maybe HeadName) Connection)
23+handleExecuteHeadName sessionId conn = do
24+ ret <- liftIO $ headName sessionId conn
2625 reply ret conn
2726
28−handleLogin :: Connection -> Process (ProcessReply UUID Connection)
29−handleLogin conn = do
30− sessionId <- liftIO $ nextRandom
31− reply sessionId conn
27+handleLogin :: Connection -> Process (ProcessReply Bool Connection)
28+handleLogin conn = reply True conn
3229
33−handleExecuteGraphExpr :: Connection -> TransactionGraphOperator -> Process (ProcessReply (Maybe RelationalError) Connection)
34−handleExecuteGraphExpr conn graphExpr = do
35− ret <- liftIO $ executeGraphExpr conn graphExpr
30+handleExecuteGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> Process (ProcessReply (Maybe RelationalError) Connection)
31+handleExecuteGraphExpr sessionId conn graphExpr = do
32+ ret <- liftIO $ executeGraphExpr sessionId conn graphExpr
3633 reply ret conn
3734
38−handleExecuteTypeForRelationalExpr :: Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)
39−handleExecuteTypeForRelationalExpr conn relExpr = do
40− ret <- liftIO $ typeForRelationalExpr conn relExpr
35+handleExecuteTypeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)
36+handleExecuteTypeForRelationalExpr sessionId conn relExpr = do
37+ ret <- liftIO $ typeForRelationalExpr sessionId conn relExpr
4138 reply ret conn
4239
43−handleRetrieveInclusionDependencies :: Connection -> Process (ProcessReply (Map IncDepName InclusionDependency) Connection)
44−handleRetrieveInclusionDependencies conn = do
45− ret <- liftIO $ inclusionDependencies conn
40+handleRetrieveInclusionDependencies :: SessionId -> Connection -> Process (ProcessReply (Either RelationalError (Map IncDepName InclusionDependency)) Connection)
41+handleRetrieveInclusionDependencies sessionId conn = do
42+ ret <- liftIO $ inclusionDependencies sessionId conn
4643 reply ret conn
4744
48−handleRetrievePlanForDatabaseContextExpr :: Connection -> DatabaseExpr -> Process (ProcessReply (Either RelationalError DatabaseExpr) Connection)
49−handleRetrievePlanForDatabaseContextExpr conn dbExpr = do
50− ret <- liftIO $ planForDatabaseContextExpr conn dbExpr
45+handleRetrievePlanForDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> Process (ProcessReply (Either RelationalError DatabaseExpr) Connection)
46+handleRetrievePlanForDatabaseContextExpr sessionId conn dbExpr = do
47+ ret <- liftIO $ planForDatabaseContextExpr sessionId conn dbExpr
5148 reply ret conn
5249
53−handleRetrieveTransactionGraph :: Connection -> Process (ProcessReply (Either RelationalError Relation) Connection)
54−handleRetrieveTransactionGraph conn = do
55− ret <- liftIO $ transactionGraphAsRelation conn
50+handleRetrieveTransactionGraph :: SessionId -> Connection -> Process (ProcessReply (Either RelationalError Relation) Connection)
51+handleRetrieveTransactionGraph sessionId conn = do
52+ ret <- liftIO $ transactionGraphAsRelation sessionId conn
5653 reply ret conn
5754
58−handleRetrieveHeadTransactionUUID :: Connection -> Process (ProcessReply UUID Connection)
59−handleRetrieveHeadTransactionUUID conn = do
60− ret <- liftIO $ headTransactionUUID conn
55+handleRetrieveHeadTransactionUUID :: SessionId -> Connection -> Process (ProcessReply (Maybe UUID) Connection)
56+handleRetrieveHeadTransactionUUID sessionId conn = do
57+ ret <- liftIO $ headTransactionUUID sessionId conn
6158 reply ret conn
benchmark/bigrel.hs+2−2
@@ -3,9 +3,9 @@ import ProjectM36.Base
33import ProjectM36.Relation
44import ProjectM36.Relation.Show.CSV
55import ProjectM36.Relation.Show.HTML
6−import TutorialD.Interpreter.Base (displayOpResult)
6+--import TutorialD.Interpreter.Base
77import TutorialD.Interpreter.DatabaseExpr (interpretDatabaseExpr)
8−import TutorialD.Interpreter.RODatabaseContextOperator (interpretRODatabaseContextOp)
8+--import TutorialD.Interpreter.RODatabaseContextOperator (interpretRODatabaseContextOp)
99import ProjectM36.RelationalExpression
1010import qualified Data.HashSet as HS
1111import qualified Data.ByteString.Lazy.Char8 as BS
examples/PersistClient.hsnew file+20
@@ -0,0 +1,20 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+{- A simple example of using the persistent-ProjectM36 driver. -}
3+import Database.Persist.ProjectM36
4+import ProjectM36.Client
5+
6+--1. declare the models with Template Haskell
7+let projectM36PersistSettings = mkPersistSettings (ConT ''ProjectM36Backend)
8+ in
9+ share [mkPersist projectM36PersistSettings] [persistLowerCase|
10+Person
11+ name String Eq
12+ age Int
13+ UniqueName name
14+ deriving Show
15+|]
16+
17+main :: IO ()
18+main = do
19+ --1. create the database connection
20+ pure ()
examples/SimpleClient.hs+21−16
@@ -14,21 +14,26 @@ main = do
1414 case eConn of
1515 Left err -> putStrLn (show err)
1616 Right conn -> do
17− --3. define a new relation variable with a DatabaseContext expression
18− let attrs = attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType]
19− mErr1 <- executeDatabaseContextExpr conn (Define "person" attrs)
20− putStrLn (show mErr1)
21− --4. add a tuple to the relation referenced by the relation variable
22− let (Right tupSet) = mkTupleSetFromList attrs [[stringAtom "Bob", intAtom 45]]
23− mErr2 <- executeDatabaseContextExpr conn (Insert "person" (MakeStaticRelation attrs tupSet))
24− putStrLn (show mErr2)
25−
26− --5. execute a relational algebra query
27− let restrictionPredicate = AttributeEqualityPredicate "name" (NakedAtomExpr (stringAtom "Steve"))
28− eRel <- executeRelationalExpr conn (Restrict restrictionPredicate (RelationVariable "person"))
29− case eRel of
17+ --3. create a session on the "master" branch
18+ eSessionId <- createSessionAtHead "master" conn
19+ case eSessionId of
3020 Left err -> putStrLn (show err)
31− Right rel -> putStrLn (show $ showRelation rel)
21+ Right sessionId -> do
22+ --4. define a new relation variable with a DatabaseContext expression
23+ let attrs = attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType]
24+ mErr1 <- executeDatabaseContextExpr sessionId conn (Define "person" attrs)
25+ putStrLn (show mErr1)
26+ --5. add a tuple to the relation referenced by the relation variable
27+ let (Right tupSet) = mkTupleSetFromList attrs [[stringAtom "Bob", intAtom 45]]
28+ mErr2 <- executeDatabaseContextExpr sessionId conn (Insert "person" (MakeStaticRelation attrs tupSet))
29+ putStrLn (show mErr2)
30+
31+ --6. execute a relational algebra query
32+ let restrictionPredicate = AttributeEqualityPredicate "name" (NakedAtomExpr (stringAtom "Steve"))
33+ eRel <- executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "person"))
34+ case eRel of
35+ Left err -> putStrLn (show err)
36+ Right rel -> putStrLn (show $ showRelation rel)
3237
33− --6. close the connection
34− close conn
38+ --7. close the connection
39+ close conn
project-m36.cabal+4−4
@@ -192,7 +192,7 @@ Executable project-m36-server
192192
193193Executable bigrel
194194 Default-Language: Haskell2010
195− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers
195+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t
196196 Other-Modules: ProjectM36.Base,
197197 ProjectM36.Relation
198198 ProjectM36.Tuple,
@@ -207,7 +207,7 @@ Test-Suite test-tutoriald
207207 Default-Language: Haskell2010
208208 type: exitcode-stdio-1.0
209209 main-is: test/TutorialD/Interpreter.hs
210− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers
210+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t
211211 GHC-Options: -Wall
212212 C-sources: ProjectM36/DirectoryFsync.c
213213
@@ -279,14 +279,14 @@ Test-Suite test-server
279279
280280Executable Example-SimpleClient
281281 Default-Language: Haskell2010
282− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers
282+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t
283283 Main-Is: examples/SimpleClient.hs
284284 GHC-Options: -Wall
285285 C-sources: ProjectM36/DirectoryFsync.c
286286
287287Executable Example-PersistClient
288288 Default-Language: Haskell2010
289− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers
289+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data
290290 Main-Is: examples/PersistClient.hs
291291 GHC-Options: -Wall
292292 C-sources: ProjectM36/DirectoryFsync.c