git.iko.soy/project-m36
on master help sign in
#88 switch to stack LTS-8.5
0c347e3AgentM
project-m36.cabal+4−4
compare with master
unifiedsplit
@@ -56,10 +56,10 @@ Library
56 ,resourcet
56 ,resourcet
57 ,http-api-data
57 ,http-api-data
58--needed for remote access
58--needed for remote access
59− ,distributed-process-client-server
59+ ,distributed-process-client-server >= 0.2.3
60− ,distributed-process
60+ ,distributed-process >= 0.6.6
61− ,distributed-process-extras
61+ ,distributed-process-extras >= 0.3.2
62− ,distributed-process-async
62+ ,distributed-process-async >= 0.2.4
63 ,network-transport-tcp
63 ,network-transport-tcp
64 ,network-transport
64 ,network-transport
65 ,stm-containers
65 ,stm-containers
src/lib/ProjectM36/Server.hs+3−7
@@ -9,11 +9,10 @@ import ProjectM36.Server.Config (ServerConfig(..))
9import Control.Monad.IO.Class (liftIO)
9import Control.Monad.IO.Class (liftIO)
10import Network.Transport.TCP (createTransport, defaultTCPParameters)
10import Network.Transport.TCP (createTransport, defaultTCPParameters)
11import Network.Transport (EndPointAddress(..), newEndPoint, address)
11import Network.Transport (EndPointAddress(..), newEndPoint, address)
12−import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode)
12+import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode, initRemoteTable)
13import Control.Distributed.Process.Extras.Time (Delay(..))
13import Control.Distributed.Process.Extras.Time (Delay(..))
14−import Control.Distributed.Process (Process, register, RemoteTable, getSelfPid)
14+import Control.Distributed.Process (Process, register, getSelfPid)
15import Control.Distributed.Process.ManagedProcess (defaultProcess, UnhandledMessagePolicy(..), ProcessDefinition(..), handleCall, serve, InitHandler, InitResult(..))
15import Control.Distributed.Process.ManagedProcess (defaultProcess, UnhandledMessagePolicy(..), ProcessDefinition(..), handleCall, serve, InitHandler, InitResult(..))
16−import qualified Control.Distributed.Process.Extras.Internal.Types as DIT
17import Control.Concurrent.MVar (putMVar, MVar)
16import Control.Concurrent.MVar (putMVar, MVar)
18import System.IO (stderr, hPutStrLn)
17import System.IO (stderr, hPutStrLn)
19
18
@@ -62,9 +61,6 @@ initServer (conn, dbname, mAddressMVar, saddress) = do
62 --traceShowM ("server started on " ++ show saddress)
61 --traceShowM ("server started on " ++ show saddress)
63 pure $ InitOk conn Infinity
62 pure $ InitOk conn Infinity
64
63
65−remoteTable :: RemoteTable
66−remoteTable = DIT.__remoteTable initRemoteTable
67−
68registerDB :: DatabaseName -> Process ()
64registerDB :: DatabaseName -> Process ()
69registerDB dbname = do
65registerDB dbname = do
70 self <- getSelfPid
66 self <- getSelfPid
@@ -95,7 +91,7 @@ launchServer daemonConfig mAddressMVar = do
95 case eEndpoint of
91 case eEndpoint of
96 Left err -> hPutStrLn stderr ("Failed to create transport: " ++ show err) >> pure False
92 Left err -> hPutStrLn stderr ("Failed to create transport: " ++ show err) >> pure False
97 Right endpoint -> do
93 Right endpoint -> do
98− localTCPNode <- newLocalNode transport remoteTable
94+ localTCPNode <- newLocalNode transport initRemoteTable
99 --traceShowM ("newLocalNode in Server " ++ show (localNodeId localTCPNode))
95 --traceShowM ("newLocalNode in Server " ++ show (localNodeId localTCPNode))
100 runProcess localTCPNode $ do
96 runProcess localTCPNode $ do
101 let testBool = testMode daemonConfig
97 let testBool = testMode daemonConfig
src/lib/ProjectM36/Server/EntryPoints.hs+1−2
@@ -7,7 +7,6 @@ import Control.Distributed.Process (Process, ProcessId)
7import Control.Distributed.Process.ManagedProcess (ProcessReply)
7import Control.Distributed.Process.ManagedProcess (ProcessReply)
8import Control.Distributed.Process.ManagedProcess.Server (reply)
8import Control.Distributed.Process.ManagedProcess.Server (reply)
9import Control.Distributed.Process.Async (async, task, waitCancelTimeout, AsyncResult(..))
9import Control.Distributed.Process.Async (async, task, waitCancelTimeout, AsyncResult(..))
10−import Control.Distributed.Process.Extras.Time (microSeconds)
11import Control.Distributed.Process.Serializable (Serializable)
10import Control.Distributed.Process.Serializable (Serializable)
12import Control.Monad.IO.Class (liftIO)
11import Control.Monad.IO.Class (liftIO)
13import Data.Map
12import Data.Map
@@ -19,7 +18,7 @@ timeoutOrDie micros act = do
19 liftIO act >>= \x -> pure (Right x)
18 liftIO act >>= \x -> pure (Right x)
20 else do
19 else do
21 asyncUnit <- async (task (liftIO act))
20 asyncUnit <- async (task (liftIO act))
22− asyncRes <- waitCancelTimeout (microSeconds micros) asyncUnit
21+ asyncRes <- waitCancelTimeout micros asyncUnit
23 case asyncRes of
22 case asyncRes of
24 AsyncDone x -> pure (Right x)
23 AsyncDone x -> pure (Right x)
25 AsyncCancelled -> pure (Left RequestTimeoutError)
24 AsyncCancelled -> pure (Left RequestTimeoutError)
stack.yaml+4−4
@@ -2,7 +2,7 @@
2# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/
2# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/
3
3
4# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
4# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
5−resolver: lts-8.0
5+resolver: lts-8.5
6
6
7# Local packages, usually specified by relative directory name
7# Local packages, usually specified by relative directory name
8packages:
8packages:
@@ -16,9 +16,9 @@ extra-deps:
16- text-1.2.2.1
16- text-1.2.2.1
17- uuid-aeson-0.1.0.0
17- uuid-aeson-0.1.0.0
18- distributed-process-0.6.6
18- distributed-process-0.6.6
19−- distributed-process-async-0.2.3
19+- distributed-process-async-0.2.4
20−- distributed-process-client-server-0.1.3.2
20+- distributed-process-client-server-0.2.3
21−- distributed-process-extras-0.2.1.2
21+- distributed-process-extras-0.3.2
22
22
23# Override default flag values for local packages and extra-deps
23# Override default flag values for local packages and extra-deps
24flags: {}
24flags: {}