yogsototh/transient-universe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixed input fields

Browse source
This commit is contained in:
Alberto G. Corona 2017-06-17 16:20:46 +02:00
parent b6683c9b13
commit ef85898941
3 changed files with 28 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Transient/MapReduce.hs
View file

@ -216,7 +216,7 @@ reduce red (dds@(DDS mx))= loggedc $ do
foldAndSend node nodes ref= do
pairs <- onAll $ getPartitionData1 ref
<|> return (error $ "DDS computed out of his node:"++ show ref)
<|> return (error $ "DDS computed out of his node:"++ show ref )
let mpairs = groupByDestiny pairs
length <- local . return $ M.size mpairs

45
src/Transient/Move/Internals.hs
View file

@ -407,6 +407,7 @@ teleport = do
#else
do
#endif
--read this Closure
Closure closRemote <- getData `onNothing` return (Closure 0 )
@ -422,9 +423,8 @@ teleport = do
liftIO $ modifyMVar_ closures $ \map -> return $ M.insert closLocal (fulLog,cont) map
let tosend= reverse $ if closRemote==0 then fulLog else log
runTrans $ msend conn $ SMore $ ClosureData closRemote closLocal tosend
runTrans $ do msend conn $ SMore $ ClosureData closRemote closLocal tosend
!> ("teleport sending", SMore (closRemote,closLocal,tosend))
!> "--------->------>---------->"
@ -582,8 +582,8 @@ msend :: MonadIO m => Connection -> StreamData NodeMSG -> m ()
#ifndef ghcjs_HOST_OS
msend (Connection _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r=
liftIO $ withMVar blocked $ const $ SBS.sendAll sock $ BC.pack (show r) -- !> "N2N SEND"
msend (Connection _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r=do
liftIO $ withMVar blocked $ const $ SBS.sendAll sock $ BC.pack (show r) !> "N2N SEND"
msend (Connection _ _ (Just (TLSNode2Node ctx)) _ _ _ _ _ _) r=
liftIO $ sendTLSData ctx $ BS.pack (show r) -- !> "TLS SEND"
@ -1092,7 +1092,7 @@ listen (node@(Node _ port _ _ )) = onAll $ do
case mlog of
SMore (RelayMSG _ _ _) ->relay mlog
_ -> execLog mlog
`catcht` (\(e ::SomeException) -> liftIO (print e))
`catcht` (\(e ::SomeException) -> liftIO $ print e)
-- relayService :: TransIO ()
@ -1182,9 +1182,11 @@ listenNew port conn'= do
input <- liftIO $ SBSL.getContents sock
cutExceptions
onException $ \(e :: SomeException) -> do
cutExceptions
-- cutExceptions
liftIO $ putStr "listen: " >> print e
let Connection{remoteNode=rnode,closures=closures,closChildren= rmap} = conn
-- TODO How to close Connection by discriminating exceptions
mnode <- liftIO $ readIORef rnode
@ -1198,7 +1200,9 @@ listenNew port conn'= do
modifyMVar_ closures $ const $ return M.empty
writeIORef rmap M.empty
-- topState >>= showThreads
-- cutExceptions
killBranch
setData $ (ParseContext (NS.close sock >> error "Communication error" ) input
::ParseContext BS.ByteString)
@ -1258,8 +1262,7 @@ listenNew port conn'= do
onException $ \(e :: SomeException) -> do
cutExceptions
liftIO $ putStr "listen websocket:" >> print e
continue
liftIO $ mclose conn'
--liftIO $ mclose conn'
killBranch
empty
-- async (return (SMore (0,0,[Exec]))) <|> do
@ -1819,24 +1822,24 @@ connect node remotenode = do
-- | synchronize the list of nodes with a remote node and all the nodes connected to it
-- the final effect is that all the nodes reachable share the same list of nodes
connect' :: Node -> Cloud ()
connect' remotenode= do
connect' remotenode= loggedc $ do
nodes <- local getNodes
localIO $ putStr "connecting to: " >> print remotenode
newNodes <- runAt remotenode $ interchange remotenode nodes
newNodes <- runAt remotenode $ interchange nodes
-- local $ return () !> "interchange finish"
local $ return () !> "interchange finish"
-- add the new nodes to the local nodes in all the nodes connected previously
let toAdd=remotenode:tail newNodes
callNodes' nodes (<>) mempty $ local $ do
liftIO $ putStr "New nodes: " >> print toAdd
liftIO $ putStr "New nodes: " >> print toAdd !> "NEWNODES"
addNodes toAdd
where
-- receive new nodes and send their own
interchange remotemode nodes=
interchange nodes=
do
newNodes <- local $ do
conn@Connection{remoteNode=rnode, connData=Just cdata} <- getSData <|>
@ -1856,12 +1859,12 @@ connect' remotenode= do
liftIO $ modifyMVar_ (fromJust $ connection callingNode) $ const $ return [conn]
onException $ \(e :: SomeException) -> do
liftIO $ putStr "connect:" >> print e
liftIO $ putStrLn "removing node: " >> print callingNode
-- topState >>= showThreads
nodes <- getNodes
setNodes $ nodes \\ [callingNode]
-- onException $ \(e :: SomeException) -> do
-- liftIO $ putStr "connect:" >> print e
-- liftIO $ putStrLn "removing node: " >> print callingNode
-- -- topState >>= showThreads
-- nodes <- getNodes
-- setNodes $ nodes \\ [callingNode]
return newNodes
@ -1869,7 +1872,7 @@ connect' remotenode= do
mclustered . local $ do
liftIO $ putStrLn "New nodes1111: " >> print newNodes
liftIO $ putStrLn "New nodes: " >> print newNodes
addNodes newNodes

6
src/Transient/Move/Utils.hs
View file

@ -62,8 +62,8 @@ getNodeParams :: TransIO Node
getNodeParams =
if isBrowserInstance then liftIO createWebNode else do
oneThread $ option "start" "re/start node"
host <- input (const True) "hostname of this node (must be reachable): "
port <- input (const True) "port to listen? "
host <- input (const True) "hostname of this node. (Must be reachable)? "
port <- input (const True) "port to listen? "
liftIO $ createNode host port
initNodeDef :: Loggable a => String -> Int -> Cloud a -> TransIO a
@ -92,7 +92,7 @@ inputNodes= onServer $ listNodes <|> addNew
where
addNew= do
local $ option "add" "add a new node"
local $ oneThread $ option "add" "add a new node"
host <- local $ do
r <- input (const True) "Hostname of the node (none): "