packages feed

transient-universe 0.3 → 0.3.1.2

raw patch · 3 files changed

+89/−90 lines, 3 filesdep ~transient

Dependency ranges changed: transient

Files

src/Transient/Move.hs view
@@ -1199,7 +1199,7 @@ 
           content <- liftIO $  BL.readFile ( "./static/out.jsexe/"++ BC.unpack file)
                             `catch` (\(e:: SomeException) ->
-                                return  "Not found file: Index.html<br/> please compile with ghcjs<br/> ghcjs program.hs -o static/out")
+                                return  "Not found file: index.html<br/> please compile with ghcjs<br/> ghcjs program.hs -o static/out")
 
           n <- liftIO $ SBS.sendMany conn   $  ["HTTP/1.0 200 OK\nContent-Type: text/html\nConnection: close\nContent-Length: " <> BC.pack (show $ BL.length content) <>"\n\n"] ++
                                   (BL.toChunks content )
src/Transient/Move/Services.hs view
@@ -17,7 +17,7 @@ import Transient.Base
 import Transient.Move
 import Transient.Logged(Loggable(..))
---import Transient.Internals((!>))
+import Transient.Internals(RemoteStatus(..))
 import Transient.Move.Utils
 import Transient.Internals(Log(..))
 import Transient.EVars
@@ -32,6 +32,7 @@ import Control.Monad
 import Data.List
 import Data.Maybe
+import Data.Monoid
 --import Data.TCache hiding(onNothing)
 
 -- for the example
@@ -91,27 +92,37 @@        Just node -> return node
        Nothing -> do
 
-          nodes <- callOne $ do
+          nodes <- callOne $ \thisNode -> do
                     yn<- requestService ident service
                     if yn then do
                         port <- onAll freePort
                         install package program  port
-                        nodeService port
+                        nodeService thisNode port
                       else empty
           local $ addNodes nodes
           return $ head nodes
     where
-    nodeService port= local $ do
-       Node h _ _ _ <- getMyNode
-       return $ Node h port (unsafePerformIO $ newMVar []) [service] :: TransIO Node
+    nodeService (Node h _ _ _) port= local $
+       return [Node h port (unsafePerformIO $ newMVar []) [service] ]
 
 
 
-callOne mx= local . collect 1 . runCloud $ clustered mx
+callOne mx= callNodes' (<>) empty mx
+ where
 
+ callNodes' op init proc= loggedc $ do
+    nodes <-  local getNodes
+    let nodes' = filter (not . isWebNode) nodes
+    foldr op init $ map (\node -> runAt node $ proc node) nodes'  :: Cloud [Node]
+    where
+    isWebNode Node {nodeServices=srvs}
+         | ("webnode","") `elem` srvs = True
+         | otherwise = False
+
+
 rfriends        =   unsafePerformIO $ newMVar []
 rservices       =   unsafePerformIO $ newMVar []
-ridentsBanned    =   unsafePerformIO $ newMVar []
+ridentsBanned   =   unsafePerformIO $ newMVar []
 rServicesBanned =   unsafePerformIO $ newMVar []
 
 requestService ident service= local $  do
@@ -163,40 +174,45 @@ 
 
 
-{-
-servicios
-      autoinstall service
-      servicio de instalaci¢n de servicios
-  procedurers call services, services install themselves in nodes.
-     clustered oriented call invoke the nodes that shares the same service.
-        if the service variable state is set. if not, invoke all the nodes.
-
-  some service accessing data may move to the machine where the data is if support the service.
-
-  servicio en browser necesita algo que en el server no existe y no pude dar:
-     forward the request to other nodes
-     return the result to the browser.
-  forward service requests:
-     cuando un nodo no puede servir un servicio, puede hacer forward.
-        otros nodos puede instalarlo o hacer forward a su vez
-
-  clusterizaci¢n de servicios
-   nodo con database saturado puede hacer automatic sharding
-     siquientes requests retornan los nuevos nodos
-  la resupuesta de un servicio puede incluir una nueva direcci¢n, del nodo donde se ha movido o donde ha delegado.
+runEmbeddedService :: (Loggable a, Loggable b) =>  Service -> (a -> Cloud b) -> Cloud b
+runEmbeddedService servname serv =  do
+   port <- lliftIO $ freePort
+   listen $ createNode "localhost" (fromIntegral port) [servname]
+   wormhole notused $ loggedc $ do
+      x <- local $ return notused
+      r <- onAll $ runCloud (serv x) <** setData WasRemote
+      local $ return r
+      teleport
+      return r
 
-  servicio wrarpper que ejecuta una libreria no transient
+  where
 
-  cat logo de servicios
-  ghcjsi service for notebooks
+  notused= error "runEmbeddedService: variable should not be used"
 
-  web site de compilaci¢n que compile en su propio ordenador
-     opcion descargar el programa de instalacion y hace stack build
-     ventaja: conectar todos los nodos que ejecutan un servicio determinado
-       necesario un deposito de nombres de servicios:: github
+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
+      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= createNode "localhost" port servs
 
-  friend ident.... request you to install... in your computer. Do you agree?
-   if ident is the same, this is automatic.
--}
+      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
 
 
transient-universe.cabal view
@@ -1,15 +1,14 @@ name: transient-universe
-version: 0.3
+version: 0.3.1.2
 cabal-version: >=1.10
 build-type: Simple
-license: GPL-3
+license: MIT
 license-file: LICENSE
 maintainer: agocorona@gmail.com
 homepage: http://www.fpcomplete.com/user/agocorona
-bug-reports: https://github.com/agocorona/transient/issues
-synopsis: remote execution and map-reduce: distributed computing for transient
-description:
-    see <http://github.com/agocorona/transient>
+bug-reports: https://github.com/agocorona/transient-universe/issues
+synopsis: Remote execution and map-reduce: distributed computing for Transient
+description: See <http://github.com/agocorona/transient>.
 category: Control
 author: Alberto G. Corona
 
@@ -18,56 +17,40 @@     location: https://github.com/agocorona/transient-universe
 
 library
-
+    build-depends: base          > 4  &&  < 5
+                 , bytestring    -any
+                 , containers    -any
+                 , mtl           -any
+                 , process       -any
+                 , random        -any
+                 , stm           -any
+                 , text          -any
+                 , time          -any
+                 , transformers  -any
+                 , transient     >= 0.4
     if impl(ghcjs >=0.1)
-        build-depends:
-            base >4 && <5,
-            mtl -any,
-            random -any,
-            transient -any,
-            containers -any,
-            stm -any,
-            transformers -any,
-            process -any,
-            bytestring -any,
-            time -any,
-            ghcjs-base -any,
-            ghcjs-prim -any,
-            text -any
+        build-depends: ghcjs-base   -any
+                     , ghcjs-prim   -any
     else
-        build-depends:
-            base >4 && <5,
-            mtl -any,
-            random -any,
-            transient -any,
-            containers -any,
-            directory -any,
-            filepath -any,
-            stm -any,
-            HTTP -any,
-            network -any,
-            transformers -any,
-            process -any,
-            network-info -any,
-            bytestring -any,
-            time -any,
-            vector -any,
-            TCache -any,
-            websockets -any,
-            network-uri -any,
-            case-insensitive -any,
-            hashable -any,
-            text -any
+        build-depends:  HTTP             -any
+                      , TCache           -any
+                      , case-insensitive -any
+                      , directory        -any
+                      , filepath         -any
+                      , hashable         -any
+                      , network          -any
+                      , network-info     -any
+                      , network-uri      -any
+                      , vector           -any
+                      , websockets       -any
 
-    if !impl(ghcjs >=0.1)
-        exposed-modules:
-            Transient.Move.Services
     exposed-modules:
         Transient.Move
         Transient.MapReduce
         Transient.Move.Utils
+    if !impl(ghcjs >=0.1)
+        exposed-modules:
+            Transient.Move.Services
+
     default-language: Haskell2010
     hs-source-dirs: src .
-    other-modules:
-
-