git.iko.soy/project-m36
on 52182bc help sign in
project-m36/src/lib/ProjectM36/Server/EntryPoints.hs
173 lines 8.6 kB history raw
1module ProjectM36.Server.EntryPoints where
2import ProjectM36.Base hiding (inclusionDependencies)
3import ProjectM36.IsomorphicSchema
4import ProjectM36.Client as C
5import ProjectM36.Error
6import ProjectM36.DataFrame
7import Control.Distributed.Process (Process, ProcessId)
8import Control.Distributed.Process.ManagedProcess (ProcessReply)
9import Control.Distributed.Process.ManagedProcess.Server (reply)
10import Control.Distributed.Process.Async (async, task, waitCancelTimeout, AsyncResult(..))
11import Control.Distributed.Process.Serializable (Serializable)
12import Control.Monad.IO.Class (liftIO)
13import Data.Map
14import Control.Concurrent (threadDelay)
16timeoutOrDie :: Serializable a => Timeout -> IO a -> Process (Either ServerError a)
17timeoutOrDie micros act =
18 if micros == 0 then
19 liftIO act >>= \x -> pure (Right x)
20 else do
21 asyncUnit <- async (task (liftIO act))
22 asyncRes <- waitCancelTimeout micros asyncUnit
23 case asyncRes of
24 AsyncDone x -> pure (Right x)
25 AsyncCancelled -> pure (Left RequestTimeoutError)
26 AsyncFailed reason -> pure (Left (ProcessDiedError (show reason)))
27 AsyncLinkFailed reason -> pure (Left (ProcessDiedError (show reason)))
28 AsyncPending -> pure (Left (ProcessDiedError "process pending"))
30type Timeout = Int
32type Reply a = Process (ProcessReply (Either ServerError a) Connection)
34handleExecuteRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)
35handleExecuteRelationalExpr ti sessionId conn expr = do
36 ret <- timeoutOrDie ti (executeRelationalExpr sessionId conn expr)
37 reply ret conn
39handleExecuteDataFrameExpr :: Timeout -> SessionId -> Connection -> DataFrameExpr -> Reply (Either RelationalError DataFrame)
40handleExecuteDataFrameExpr ti sessionId conn expr = do
41 ret <- timeoutOrDie ti (executeDataFrameExpr sessionId conn expr)
42 reply ret conn
44handleExecuteDatabaseContextExpr :: Timeout -> SessionId -> Connection -> DatabaseContextExpr -> Reply (Either RelationalError ())
45handleExecuteDatabaseContextExpr ti sessionId conn dbexpr = do
46 ret <- timeoutOrDie ti (executeDatabaseContextExpr sessionId conn dbexpr)
47 reply ret conn
49handleExecuteDatabaseContextIOExpr :: Timeout -> SessionId -> Connection -> DatabaseContextIOExpr -> Reply (Either RelationalError ())
50handleExecuteDatabaseContextIOExpr ti sessionId conn dbexpr = do
51 ret <- timeoutOrDie ti (executeDatabaseContextIOExpr sessionId conn dbexpr)
52 reply ret conn
54handleExecuteHeadName :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError HeadName)
55handleExecuteHeadName ti sessionId conn = do
56 ret <- timeoutOrDie ti (headName sessionId conn)
57 reply ret conn
59handleLogin :: Timeout -> Connection -> ProcessId -> Reply Bool
60handleLogin ti conn newClientProcessId = do
61 ret <- timeoutOrDie ti (addClientNode conn newClientProcessId)
62 case ret of
63 Right () -> reply (Right True) conn
64 Left err -> reply (Left err) conn
66handleExecuteGraphExpr :: Timeout -> SessionId -> Connection -> TransactionGraphOperator -> Reply (Either RelationalError ())
67handleExecuteGraphExpr ti sessionId conn graphExpr = do
68 ret <- timeoutOrDie ti (executeGraphExpr sessionId conn graphExpr)
69 reply ret conn
71handleExecuteTransGraphRelationalExpr :: Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> Reply (Either RelationalError Relation)
72handleExecuteTransGraphRelationalExpr ti sessionId conn graphExpr = do
73 ret <- timeoutOrDie ti (executeTransGraphRelationalExpr sessionId conn graphExpr)
74 reply ret conn
76handleExecuteTypeForRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)
77handleExecuteTypeForRelationalExpr ti sessionId conn relExpr = do
78 ret <- timeoutOrDie ti (typeForRelationalExpr sessionId conn relExpr)
79 reply ret conn
81handleRetrieveInclusionDependencies :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError (Map IncDepName InclusionDependency))
82handleRetrieveInclusionDependencies ti sessionId conn = do
83 ret <- timeoutOrDie ti (inclusionDependencies sessionId conn)
84 reply ret conn
86handleRetrievePlanForDatabaseContextExpr :: Timeout -> SessionId -> Connection -> DatabaseContextExpr -> Reply (Either RelationalError DatabaseContextExpr)
87handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr = do
88 ret <- timeoutOrDie ti (planForDatabaseContextExpr sessionId conn dbExpr)
89 reply ret conn
91handleRetrieveTransactionGraph :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
92handleRetrieveTransactionGraph ti sessionId conn = do
93 ret <- timeoutOrDie ti (transactionGraphAsRelation sessionId conn)
94 reply ret conn
96handleRetrieveHeadTransactionId :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TransactionId)
97handleRetrieveHeadTransactionId ti sessionId conn = do
98 ret <- timeoutOrDie ti (headTransactionId sessionId conn)
99 reply ret conn
101handleCreateSessionAtCommit :: Timeout -> Connection -> TransactionId -> Reply (Either RelationalError SessionId)
102handleCreateSessionAtCommit ti conn commitId = do
103 ret <- timeoutOrDie ti (createSessionAtCommit conn commitId)
104 reply ret conn
106handleCreateSessionAtHead :: Timeout -> Connection -> HeadName -> Reply (Either RelationalError SessionId)
107handleCreateSessionAtHead ti conn headn = do
108 ret <- timeoutOrDie ti (createSessionAtHead conn headn)
109 reply ret conn
111handleCloseSession :: Timeout -> SessionId -> Connection -> Reply ()
112handleCloseSession ti sessionId conn = do
113 ret <- timeoutOrDie ti (closeSession sessionId conn)
114 case ret of
115 Right () -> reply (Right ()) conn
116 Left err -> reply (Left err) conn
118handleRetrieveAtomTypesAsRelation :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
119handleRetrieveAtomTypesAsRelation ti sessionId conn = do
120 ret <- timeoutOrDie ti (atomTypesAsRelation sessionId conn)
121 reply ret conn
123-- | Returns a relation which lists the names of relvars in the current session as well as its types.
124handleRetrieveRelationVariableSummary :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
125handleRetrieveRelationVariableSummary ti sessionId conn = do
126 ret <- timeoutOrDie ti (relationVariablesAsRelation sessionId conn)
127 reply ret conn
129handleRetrieveAtomFunctionSummary :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
130handleRetrieveAtomFunctionSummary ti sessionId conn = do
131 ret <- timeoutOrDie ti (atomFunctionsAsRelation sessionId conn)
132 reply ret conn
134handleRetrieveDatabaseContextFunctionSummary :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
135handleRetrieveDatabaseContextFunctionSummary ti sessionId conn = do
136 ret <- timeoutOrDie ti (databaseContextFunctionsAsRelation sessionId conn)
137 reply ret conn
139handleRetrieveCurrentSchemaName :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError SchemaName)
140handleRetrieveCurrentSchemaName ti sessionId conn = do
141 ret <- timeoutOrDie ti (currentSchemaName sessionId conn)
142 reply ret conn
144handleExecuteSchemaExpr :: Timeout -> SessionId -> Connection -> SchemaExpr -> Reply (Either RelationalError ())
145handleExecuteSchemaExpr ti sessionId conn schemaExpr = do
146 ret <- timeoutOrDie ti (executeSchemaExpr sessionId conn schemaExpr)
147 reply ret conn
149handleLogout :: Timeout -> Connection -> Reply Bool
150handleLogout _ =
151 --liftIO $ closeRemote_ conn
152 reply (pure True)
154handleTestTimeout :: Timeout -> SessionId -> Connection -> Reply Bool
155handleTestTimeout ti _ conn = do
156 ret <- timeoutOrDie ti (threadDelay 100000 >> pure True)
157 reply ret conn
159handleRetrieveSessionIsDirty :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Bool)
160handleRetrieveSessionIsDirty ti sessionId conn = do
161 ret <- timeoutOrDie ti (disconnectedTransactionIsDirty sessionId conn)
162 reply ret conn
164handleExecuteAutoMergeToHead :: Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> Reply (Either RelationalError ())
165handleExecuteAutoMergeToHead ti sessionId conn strat headName' = do
166 ret <- timeoutOrDie ti (autoMergeToHead sessionId conn strat headName')
167 reply ret conn
169handleRetrieveTypeConstructorMapping :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TypeConstructorMapping)
170handleRetrieveTypeConstructorMapping ti sessionId conn = do
171 ret <- timeoutOrDie ti (C.typeConstructorMapping sessionId conn)
172 reply ret conn