on master help sign in
WIP distributed haskell DBMS daemon
5577809AgentM
ProjectM36/Daemon/EndPoints.hsnew file+15
@@ -0,0 +1,15 @@
1+module ProjectM36.Daemon.EndPoints where
2+import ProjectM36.Base
3+import ProjectM36.Client
4+import ProjectM36.Error
5+
6+import Control.Distributed.Process (Process)
7+import Control.Distributed.Process.ManagedProcess (ProcessReply)
8+import Control.Distributed.Process.ManagedProcess.Server (reply)
9+import Control.Monad.IO.Class (liftIO)
10+
11+handleExecuteRelationalExpr :: Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)
12+handleExecuteRelationalExpr conn expr = do
13+ ret <- liftIO $ executeRelationalExpr conn expr
14+ reply ret conn
15+
ProjectM36/Daemon/Main.hsnew file+56
@@ -0,0 +1,56 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
2+import ProjectM36.Client
3+import ProjectM36.Daemon.ParseArgs (parseConfig, persistenceStrategy)
4+import ProjectM36.Daemon.EndPoints (handleExecuteRelationalExpr)
5+
6+import System.Exit (exitFailure, exitSuccess)
7+import Control.Concurrent (threadDelay)
8+import Control.Monad.IO.Class (liftIO)
9+import Network.Transport.TCP (createTransport, defaultTCPParameters)
10+import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode)
11+import Control.Distributed.Process.Extras.Time (Delay(..))
12+import Control.Distributed.Process (ProcessId, spawnLocal, Process, register, RemoteTable)
13+import Control.Distributed.Process.ManagedProcess (defaultProcess, UnhandledMessagePolicy(..), ProcessDefinition(..), handleCall, serve, InitHandler, InitResult(..))
14+import Control.Monad (forever)
15+import System.IO (hPutStrLn, stderr)
16+import qualified Control.Distributed.Process.Extras.Internal.Types as DIT
17+
18+serverDefinition :: ProcessDefinition Connection
19+serverDefinition = defaultProcess {
20+ apiHandlers = [handleCall (\conn (expr :: RelationalExpr) -> handleExecuteRelationalExpr conn expr)],
21+ unhandledMessagePolicy = Drop
22+ }
23+
24+initServer :: InitHandler Connection Connection
25+initServer conn = return $ InitOk conn Infinity
26+
27+launchServer :: Connection -> Process ProcessId
28+launchServer conn = spawnLocal (serve conn initServer serverDefinition)
29+
30+remoteTable :: RemoteTable
31+remoteTable = DIT.__remoteTable initRemoteTable
32+
33+main :: IO ()
34+main = do
35+ daemonConfig <- parseConfig
36+ econn <- connectProjectM36 (InProcessConnectionInfo (persistenceStrategy daemonConfig))
37+ case econn of
38+ Left err -> do
39+ hPutStrLn stderr ("Failed to create database connection: " ++ show err)
40+ exitFailure
41+ Right conn -> do
42+ etransport <- createTransport "127.0.0.1" "6543" defaultTCPParameters
43+ case etransport of
44+ Left err -> error (show err)
45+ Right transport -> do
46+ localTCPNode <- newLocalNode transport remoteTable
47+ runProcess localTCPNode $ do
48+ serverPid <- launchServer conn
49+ register "project-m36" serverPid
50+ liftIO $ do
51+ putStrLn (show serverPid)
52+ _ <- forever $ threadDelay 1000000
53+ putStrLn "Server Exit."
54+ exitSuccess
55+
56+
ProjectM36/Daemon/ParseArgs.hsnew file+26
@@ -0,0 +1,26 @@
1+module ProjectM36.Daemon.ParseArgs where
2+import ProjectM36.Base
3+import Options.Applicative
4+
5+data DaemonConfig = DaemonConfig { persistenceStrategy :: PersistenceStrategy }
6+
7+parseArgs :: Parser DaemonConfig
8+parseArgs = DaemonConfig <$> parsePersistenceStrategy
9+
10+parsePersistenceStrategy :: Parser PersistenceStrategy
11+parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>
12+ MinimalPersistence <$> dbdirOpt <|>
13+ pure NoPersistence
14+ where
15+ dbdirOpt = strOption (short 'd' <>
16+ long "database-directory" <>
17+ metavar "DIRECTORY" <>
18+ showDefaultWith show
19+ )
20+ fsyncOpt = switch (short 'f' <>
21+ long "fsync" <>
22+ help "Fsync all new transactions.")
23+
24+parseConfig :: IO DaemonConfig
25+parseConfig = execParser $ info parseArgs idm
26+
ProjectM36/Error.hs+3−3
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2module ProjectM36.Error where
2module ProjectM36.Error where
3import ProjectM36.Base
3import ProjectM36.Base
4import qualified Data.Set as S
4import qualified Data.Set as S
@@ -7,7 +7,7 @@ import Control.DeepSeq (NFData, rnf)
7import Control.DeepSeq.Generics (genericRnf)
7import Control.DeepSeq.Generics (genericRnf)
8import GHC.Generics (Generic)
8import GHC.Generics (Generic)
9import qualified Data.Text as T
9import qualified Data.Text as T
10−
10+import Data.Binary
11
11
12data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
12data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
13 | TupleAttributeCountMismatchError Int --attribute name
13 | TupleAttributeCountMismatchError Int --attribute name
@@ -38,7 +38,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
38 | RelationValuedAttributesNotSupportedError [AttributeName]
38 | RelationValuedAttributesNotSupportedError [AttributeName]
39 | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra
39 | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra
40 | ExportError T.Text
40 | ExportError T.Text
41− deriving (Show,Eq,Generic)
41+ deriving (Show,Eq,Generic,Binary)
42
42
43instance NFData RelationalError where rnf = genericRnf
43instance NFData RelationalError where rnf = genericRnf
44
44
project-m36.cabal+58−3
@@ -3,11 +3,16 @@ Version: 0.1
3License: PublicDomain
3License: PublicDomain
4Build-Type: Simple
4Build-Type: Simple
5Homepage: https://github.com/agentm/project-m36
5Homepage: https://github.com/agentm/project-m36
6+Bug-Reports: https://github.com/agentm/project-m36/issues
7+Author: AgentM
8+Stability: experimental
6Category: Relational Algebra
9Category: Relational Algebra
7−Cabal-Version: >= 1.2
10+Cabal-Version: >= 1.10
11+Synopsis: Relational Algebra Engine
12+Description: A relational algebra engine which can be used to persist and query Haskell data types.
8
13
9Library
14Library
10− Build-Depends: base>=4.8
15+ Build-Depends: base>=4.8 && < 4.9
11 ,mtl
16 ,mtl
12 ,containers
17 ,containers
13 ,unordered-containers
18 ,unordered-containers
@@ -74,9 +79,10 @@ Library
74 Database.Persist.ProjectM36
79 Database.Persist.ProjectM36
75 GHC-Options: -Wall -rtsopts
80 GHC-Options: -Wall -rtsopts
76 C-sources: ProjectM36/DirectoryFsync.c
81 C-sources: ProjectM36/DirectoryFsync.c
82+ Default-Language: Haskell2010
77
83
78Executable tutd
84Executable tutd
79− Build-Depends: base
85+ Build-Depends: base, project-m36
80 Other-Modules: ProjectM36.Error,
86 Other-Modules: ProjectM36.Error,
81 ProjectM36.Base,
87 ProjectM36.Base,
82 ProjectM36.RelationalExpression,
88 ProjectM36.RelationalExpression,
@@ -91,8 +97,48 @@ Executable tutd
91 main-is: TutorialD/tutd.hs
97 main-is: TutorialD/tutd.hs
92 GHC-Options: -Wall
98 GHC-Options: -Wall
93 C-sources: ProjectM36/DirectoryFsync.c
99 C-sources: ProjectM36/DirectoryFsync.c
100+ Default-Language: Haskell2010
101+
102+Executable daemon
103+ Build-Depends: project-m36,
104+ base >=4.8 && <4.9,
105+ distributed-process-client-server,
106+ distributed-process-extras,
107+ distributed-process-async,
108+ distributed-process,
109+ network-transport-tcp,
110+ distributed-process,
111+ binary,
112+ transformers,
113+ temporary,
114+ unix,
115+ data-interval,
116+ deepseq,
117+ uuid,
118+ stm,
119+ filepath,
120+ directory,
121+ parallel,
122+ bytestring,
123+ optparse-applicative,
124+ hashable-time,
125+ time,
126+ vector-binary-instances,
127+ text,
128+ deepseq-generics,
129+ mtl,
130+ containers,
131+ hashable,
132+ unordered-containers,
133+ vector
134+ Main-Is: ProjectM36/Daemon/Main.hs
135+ GHC-Options: -Wall -threaded -rtsopts
136+ GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
137+ Default-Language: Haskell2010
138+
94
139
95Executable bigrel
140Executable bigrel
141+ Default-Language: Haskell2010
96 Build-Depends: base,deepseq,optparse-applicative
142 Build-Depends: base,deepseq,optparse-applicative
97 Other-Modules: ProjectM36.Base,
143 Other-Modules: ProjectM36.Base,
98 ProjectM36.Relation
144 ProjectM36.Relation
@@ -104,6 +150,7 @@ Executable bigrel
104 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
150 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
105
151
106Test-Suite test-tutoriald
152Test-Suite test-tutoriald
153+ Default-Language: Haskell2010
107 type: exitcode-stdio-1.0
154 type: exitcode-stdio-1.0
108 main-is: test/TutorialD/Interpreter.hs
155 main-is: test/TutorialD/Interpreter.hs
109 Build-Depends: base,HUnit,Cabal
156 Build-Depends: base,HUnit,Cabal
@@ -111,18 +158,21 @@ Test-Suite test-tutoriald
111 C-sources: ProjectM36/DirectoryFsync.c
158 C-sources: ProjectM36/DirectoryFsync.c
112
159
113Test-Suite test-relation
160Test-Suite test-relation
161+ Default-Language: Haskell2010
114 type: exitcode-stdio-1.0
162 type: exitcode-stdio-1.0
115 main-is: test/Relation/Basic.hs
163 main-is: test/Relation/Basic.hs
116 Build-Depends: base,HUnit,Cabal
164 Build-Depends: base,HUnit,Cabal
117 GHC-Options: -Wall
165 GHC-Options: -Wall
118
166
119Test-Suite test-static-optimizer
167Test-Suite test-static-optimizer
168+ Default-Language: Haskell2010
120 type: exitcode-stdio-1.0
169 type: exitcode-stdio-1.0
121 main-is: test/Relation/StaticOptimizer.hs
170 main-is: test/Relation/StaticOptimizer.hs
122 Build-Depends: base,HUnit,Cabal
171 Build-Depends: base,HUnit,Cabal
123 GHC-Options: -Wall
172 GHC-Options: -Wall
124
173
125Test-Suite test-transactiongraph-persist
174Test-Suite test-transactiongraph-persist
175+ Default-Language: Haskell2010
126 type: exitcode-stdio-1.0
176 type: exitcode-stdio-1.0
127 main-is: test/TransactionGraph/Persist.hs
177 main-is: test/TransactionGraph/Persist.hs
128 Build-Depends: base,HUnit,Cabal
178 Build-Depends: base,HUnit,Cabal
@@ -130,24 +180,28 @@ Test-Suite test-transactiongraph-persist
130 C-sources: ProjectM36/DirectoryFsync.c
180 C-sources: ProjectM36/DirectoryFsync.c
131
181
132Test-Suite test-relation-import-csv
182Test-Suite test-relation-import-csv
183+ Default-Language: Haskell2010
133 type: exitcode-stdio-1.0
184 type: exitcode-stdio-1.0
134 main-is: test/Relation/Import/CSV.hs
185 main-is: test/Relation/Import/CSV.hs
135 Build-Depends: base,HUnit,Cabal
186 Build-Depends: base,HUnit,Cabal
136 GHC-Options: -Wall
187 GHC-Options: -Wall
137
188
138Test-Suite test-tutoriald-import-tutoriald
189Test-Suite test-tutoriald-import-tutoriald
190+ Default-Language: Haskell2010
139 type: exitcode-stdio-1.0
191 type: exitcode-stdio-1.0
140 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
192 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
141 Build-Depends: base,HUnit,Cabal
193 Build-Depends: base,HUnit,Cabal
142 GHC-Options: -Wall
194 GHC-Options: -Wall
143
195
144Test-Suite test-relation-export-csv
196Test-Suite test-relation-export-csv
197+ Default-Language: Haskell2010
145 type: exitcode-stdio-1.0
198 type: exitcode-stdio-1.0
146 main-is: test/Relation/Export/CSV.hs
199 main-is: test/Relation/Export/CSV.hs
147 Build-Depends: base,HUnit,Cabal
200 Build-Depends: base,HUnit,Cabal
148 GHC-Options: -Wall
201 GHC-Options: -Wall
149
202
150Test-Suite test-persistent-driver
203Test-Suite test-persistent-driver
204+ Default-Language: Haskell2010
151 type: exitcode-stdio-1.0
205 type: exitcode-stdio-1.0
152 main-is: test/persistent-driver/test.hs
206 main-is: test/persistent-driver/test.hs
153 Build-Depends: base,HUnit,Cabal,template-haskell
207 Build-Depends: base,HUnit,Cabal,template-haskell
@@ -155,6 +209,7 @@ Test-Suite test-persistent-driver
155 C-sources: ProjectM36/DirectoryFsync.c
209 C-sources: ProjectM36/DirectoryFsync.c
156
210
157benchmark bench
211benchmark bench
212+ Default-Language: Haskell2010
158 type: exitcode-stdio-1.0
213 type: exitcode-stdio-1.0
159 main-is: benchmark/Relation.hs
214 main-is: benchmark/Relation.hs
160 build-depends: base,criterion
215 build-depends: base,criterion