5577809 · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP distributed haskell DBMS daemon

commit55778091a6e0f5cc250b95c97b46454a7e507808 authorAgentM <agentm@themactionfaction.com> dateWed 11 Nov 2015, 23:52 (11 years ago) parent78fdc16

5 files changed+158−6

compare with master

unifiedsplit

ProjectM36/Daemon/EndPoints.hs+15 ProjectM36/Daemon/Main.hs+56 ProjectM36/Daemon/ParseArgs.hs+26 ProjectM36/Error.hs+3−3 project-m36.cabal+58−3

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

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)

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

5+data DaemonConfig = DaemonConfig { persistenceStrategy :: PersistenceStrategy }

7+parseArgs :: Parser DaemonConfig

8+parseArgs = DaemonConfig <$> parsePersistenceStrategy

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 #-}

22module ProjectM36.Error where

33import ProjectM36.Base

44import qualified Data.Set as S

@@ -7,7 +7,7 @@ import Control.DeepSeq (NFData, rnf)

77import Control.DeepSeq.Generics (genericRnf)

88import GHC.Generics (Generic)

99import qualified Data.Text as T

10−

10+import Data.Binary

1111

1212data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

1313 | TupleAttributeCountMismatchError Int --attribute name

@@ -38,7 +38,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

3838 | RelationValuedAttributesNotSupportedError [AttributeName]

3939 | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra

4040 | ExportError T.Text

41− deriving (Show,Eq,Generic)

41+ deriving (Show,Eq,Generic,Binary)

4242

4343instance NFData RelationalError where rnf = genericRnf

4444

project-m36.cabal+58−3

@@ -3,11 +3,16 @@ Version: 0.1

33License: PublicDomain

44Build-Type: Simple

55Homepage: https://github.com/agentm/project-m36

6+Bug-Reports: https://github.com/agentm/project-m36/issues

7+Author: AgentM

8+Stability: experimental

69Category: 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.

813

914Library

10− Build-Depends: base>=4.8

15+ Build-Depends: base>=4.8 && < 4.9

1116 ,mtl

1217 ,containers

1318 ,unordered-containers

@@ -74,9 +79,10 @@ Library

7479 Database.Persist.ProjectM36

7580 GHC-Options: -Wall -rtsopts

7681 C-sources: ProjectM36/DirectoryFsync.c

82+ Default-Language: Haskell2010

7783

7884Executable tutd

79− Build-Depends: base

85+ Build-Depends: base, project-m36

8086 Other-Modules: ProjectM36.Error,

8187 ProjectM36.Base,

8288 ProjectM36.RelationalExpression,

@@ -91,8 +97,48 @@ Executable tutd

9197 main-is: TutorialD/tutd.hs

9298 GHC-Options: -Wall

9399 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+

94139

95140Executable bigrel

141+ Default-Language: Haskell2010

96142 Build-Depends: base,deepseq,optparse-applicative

97143 Other-Modules: ProjectM36.Base,

98144 ProjectM36.Relation

@@ -104,6 +150,7 @@ Executable bigrel

104150 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

105151

106152Test-Suite test-tutoriald

153+ Default-Language: Haskell2010

107154 type: exitcode-stdio-1.0

108155 main-is: test/TutorialD/Interpreter.hs

109156 Build-Depends: base,HUnit,Cabal

@@ -111,18 +158,21 @@ Test-Suite test-tutoriald

111158 C-sources: ProjectM36/DirectoryFsync.c

112159

113160Test-Suite test-relation

161+ Default-Language: Haskell2010

114162 type: exitcode-stdio-1.0

115163 main-is: test/Relation/Basic.hs

116164 Build-Depends: base,HUnit,Cabal

117165 GHC-Options: -Wall

118166

119167Test-Suite test-static-optimizer

168+ Default-Language: Haskell2010

120169 type: exitcode-stdio-1.0

121170 main-is: test/Relation/StaticOptimizer.hs

122171 Build-Depends: base,HUnit,Cabal

123172 GHC-Options: -Wall

124173

125174Test-Suite test-transactiongraph-persist

175+ Default-Language: Haskell2010

126176 type: exitcode-stdio-1.0

127177 main-is: test/TransactionGraph/Persist.hs

128178 Build-Depends: base,HUnit,Cabal

@@ -130,24 +180,28 @@ Test-Suite test-transactiongraph-persist

130180 C-sources: ProjectM36/DirectoryFsync.c

131181

132182Test-Suite test-relation-import-csv

183+ Default-Language: Haskell2010

133184 type: exitcode-stdio-1.0

134185 main-is: test/Relation/Import/CSV.hs

135186 Build-Depends: base,HUnit,Cabal

136187 GHC-Options: -Wall

137188

138189Test-Suite test-tutoriald-import-tutoriald

190+ Default-Language: Haskell2010

139191 type: exitcode-stdio-1.0

140192 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs

141193 Build-Depends: base,HUnit,Cabal

142194 GHC-Options: -Wall

143195

144196Test-Suite test-relation-export-csv

197+ Default-Language: Haskell2010

145198 type: exitcode-stdio-1.0

146199 main-is: test/Relation/Export/CSV.hs

147200 Build-Depends: base,HUnit,Cabal

148201 GHC-Options: -Wall

149202

150203Test-Suite test-persistent-driver

204+ Default-Language: Haskell2010

151205 type: exitcode-stdio-1.0

152206 main-is: test/persistent-driver/test.hs

153207 Build-Depends: base,HUnit,Cabal,template-haskell

@@ -155,6 +209,7 @@ Test-Suite test-persistent-driver

155209 C-sources: ProjectM36/DirectoryFsync.c

156210

157211benchmark bench

212+ Default-Language: Haskell2010

158213 type: exitcode-stdio-1.0

159214 main-is: benchmark/Relation.hs

160215 build-depends: base,criterion