diff --git a/src/Transient/Move/Services.hs b/src/Transient/Move/Services.hs index 0c2b075..4d1516c 100644 --- a/src/Transient/Move/Services.hs +++ b/src/Transient/Move/Services.hs @@ -17,9 +17,9 @@ module Transient.Move.Services where import Transient.Base import Transient.Move import Transient.Logged(Loggable(..)) -import Transient.Internals(RemoteStatus(..)) +import Transient.Internals((!>),RemoteStatus(..), Log(..)) import Transient.Move.Utils -import Transient.Internals(Log(..)) + import Transient.EVars import Transient.Indeterminism import Control.Monad.IO.Class @@ -51,7 +51,7 @@ import System.Environment -- createProcess $ shell prog -pathExe package program port= package++"/dist/build/"++package++"/"++program +pathExe package program port= {-"./"++package++"/dist/build/"++package++"/"++ -} program ++ " -p start/" ++ show port install :: String -> String -> Int -> Cloud () @@ -61,15 +61,15 @@ install package program port = do exist <- local $ liftIO $ doesDirectoryExist packagename when (not exist) $ local $ liftIO $ do callProcess "git" ["clone",package] - liftIO $ print "GIT DONE" + liftIO $ putStr package >> putStrLn " cloned" setCurrentDirectory packagename callProcess "cabal" ["install","--force-reinstalls"] setCurrentDirectory ".." return() let prog = pathExe packagename program port - lliftIO $ print prog + lliftIO $ print $ "executing "++ prog local $ liftIO $ do - createProcess $ shell program + createProcess $ shell prog return () return() @@ -97,7 +97,7 @@ initService ident service@(package, program)= loggedc $ do if yn then do port <- onAll freePort install package program port - nodeService thisNode port + nodeService thisNode port !> "GENERATED NODE" else empty local $ addNodes nodes return $ head nodes @@ -146,6 +146,7 @@ callService => String -> Service -> a -> Cloud b callService ident service params = do node <- initService ident service + return () !> node log <- onAll $ do log <- getSData <|> return emptyLog setData emptyLog @@ -191,28 +192,26 @@ runEmbeddedService servname serv = do runService :: (Loggable a, Loggable b) => Service -> (a -> Cloud b) -> Cloud b runService servname serv = do - initNode [servname] - wormhole notused $ loggedc $ do - x <- local $ return notused + initNodeServ [servname] + wormhole (notused 1) $ loggedc $ do + x <- local $ return $ notused 2 r <- onAll $ runCloud (serv x) <** setData WasRemote local $ return r teleport return r where - notused= error "runService: variable should not be used" - initNode servs=do - port <- local getPort - let conn= defConnection 8192 - mynode= createNodeServ "localhost" port servs + notused n= error $ "runService: "++ show (n::Int) ++ " variable should not be used" + initNodeServ servs=do + mynode <- local $ do + port <- getPort + return $ createNodeServ "localhost" port servs - listen mynode <|> return() + listen mynode -- <|> return() where getPort :: TransIO Integer - getPort = - if isBrowserInstance then return 0 else do - oneThread $ option "start" "re/start" - port <- input (const True) "port to listen? " - liftIO $ putStrLn "node started" - return port + getPort = if isBrowserInstance then return 0 else do + oneThread $ option "start" "re/start node" + input (const True) "port to listen? " + diff --git a/src/Transient/Move/Utils.hs b/src/Transient/Move/Utils.hs index 47d6a78..363776e 100644 --- a/src/Transient/Move/Utils.hs +++ b/src/Transient/Move/Utils.hs @@ -58,7 +58,7 @@ initNode app= do getPort :: TransIO Node getPort = if isBrowserInstance then return createWebNode else do - oneThread $ option "start" "re/start" + oneThread $ option "start" "re/start node" host <- input (const True) "hostname of this node (must be reachable): " port <- input (const True) "port to listen? " return $ createNode host port diff --git a/stack.yaml b/stack.yaml index ad4797b..bfe1724 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,7 +3,7 @@ packages: - '.' - location: git: https://github.com/agocorona/transient.git - commit: d9ee775d84b4d9aa7c4df3fa441450b8640a0d63 + commit: 8573c0b7d77197af94e5d46c60b3d361f0b4dfae extra-dep: true extra-package-dbs: [] flags: {} diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 20b8563..7e739c8 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -41,7 +41,6 @@ main= do runNodes nodes local $ option "s" "start" - local $ do liftIO $ putStrLn "--------------checking parallel execution, events --------" ev <- newEVar @@ -49,32 +48,15 @@ main= do assert (sort r== [1,2,3]) $ liftIO $ print r --- t <- runAt n2000 (localIO $ print "hello0") --- <> runAt n2001 ( localIO $ print "world1") --- <> runAt n2002 ( localIO $ print "world2") --- <> runAt n2003 ( localIO $ print "world2") --- localIO $ print t --- t <- local (async $ return ()) <> local (async $ return ()) <> local (async $ return ()) --- --- localIO $ print t --- wormhole n2003 $ do --- teleport --- (localIO $ print "hello3") --- teleport --- stop - - - lliftIO $ putStrLn "--------------checking Applicative distributed--------" r <- loggedc $(runAt n2000 (shouldRun(2000) >> return "hello ")) <> (runAt n2001 (shouldRun(2001) >> return "world " )) <> (runAt n2002 (shouldRun (2002) >> return "world2" )) + localIO $ print r assert(r== "hello world world2") $ lliftIO $ print r - - lliftIO $ putStrLn "------checking Alternative distributed--------" r <- local $ collect' 3 1 0 $ runCloud $ (runAt n2000 (shouldRun(2000) >> return "hello")) diff --git a/tests/testService.hs b/tests/testService.hs index cd31d1b..ecd6901 100644 --- a/tests/testService.hs +++ b/tests/testService.hs @@ -2,7 +2,7 @@ import Transient.Base -import Transient.Internals((!>)) +--import Transient.Internals((!>)) import Transient.Move import Transient.Move.Utils import Transient.Logged @@ -15,45 +15,47 @@ import Control.Concurrent (threadDelay) import Control.Monad.IO.Class #ifdef Library -client params= do +#else + +clientStub params= do r <- callService "" ("service","service") params lliftIO $ print (r :: String) -#else + main= keep $ runCloud $ do - runService ("service","service") service + runEmbeddedService ("service","service") serviceImplementation empty <|> do - runNodes [2001] --- local $ option "start" "start" - client ("hello","world") +-- runTestNodes [2001] +-- local $ option "start1" "start1" + clientStub ("hello","world") empty -addService s= do - con@Connection{myNode= mynode} <- getSData <|> error "connection not set. please initialize it" - - let mynode'= mynode{nodeServices= s:nodeServices mynode} - addNodes [mynode'] - setData con{myNode= mynode'} +--addService s= do +-- con@Connection{myNode= mynode} <- getSData <|> error "connection not set. please initialize it" +-- +-- let mynode'= mynode{nodeServices= s:nodeServices mynode} +-- addNodes [mynode'] +-- setData con{myNode= mynode'} -service :: (String,String) -> Cloud String -service (x,y)= do +serviceImplementation :: (String,String) -> Cloud String +serviceImplementation (x,y)= do lliftIO $ print x return y -service' params= wormhole undefined $ loggedc $ do - (x,y) <- local $ return params - lliftIO $ print x - local $ return y - teleport - empty +--service' params= wormhole undefined . loggedc $ do +-- (x,y) <- local $ return params +-- lliftIO $ print x +-- local $ return y +-- teleport +-- empty #endif