Browse Source

fixes

addedsingle
Alberto G. Corona 6 years ago
parent
commit
bdd46c612c
  1. 1
      .gitignore
  2. 1495
      DistrbDataSets.prof
  3. 1
      TransIO
  4. 4
      buildrun.bat
  5. 8
      buildrun.sh
  6. BIN
      examples/DistrbDataSets
  7. 25
      examples/DistrbDataSets.hs
  8. 2
      examples/PiDistribCountinuous.hs
  9. 158
      examples/distributedExamples.hs
  10. BIN
      examples/webapp.exe
  11. 14
      examples/webapp.hs
  12. 1416
      nohup.out
  13. 0
      retry
  14. 0
      return
  15. 2
      src/Transient/DDS.hs
  16. 53
      src/Transient/Move.hs
  17. 10
      src/Transient/Move/Services.hs
  18. 3
      stack.yaml
  19. 124
      transient-universe.cabal
  20. 19
      transient-universe.cabal.lkshs
  21. 14
      transient-universe.cabal.lkshw

1
.gitignore

@ -14,6 +14,7 @@ dist
*.js*
*.o
*.hi
*.exe
.cabal-sandbox
cabal.sanbox.config
.stack*

1495
DistrbDataSets.prof

File diff suppressed because it is too large

1
TransIO

@ -0,0 +1 @@


4
buildrun.bat

@ -1,4 +1,4 @@
ghcjs -isrc -i../ghcjs-hplay/src %1 -o static/out
ghcjs -isrc -i../transient/src -i../ghcjs-hplay/src -i../ghcjs-perch/src %1 -o static/out
if %errorlevel% neq 0 exit
runghc -isrc -i../ghcjs-hplay/src %1
runghc -isrc -i../transient/src -i../ghcjs-hplay/src -i../ghcjs-perch/src %1

8
buildrun.sh

@ -1,5 +1,9 @@
#!/bin/bash
set -e
ghcjs -isrc -i../transient/src -i../ghcjs-hplay/src -i../ghcjs-perch/src $1 -o static/out
runghc -isrc -i../transient/src -i../ghcjs-hplay/src -i../ghcjs-perch/src $1
stack exec ghcjs -- -isrc -i../transient/src -i../transient-universe/src -i../ghcjs-hplay/src -i../ghcjs-perch/src $1 -o static/out
stack exec runghc -- -isrc -i../transient/src -i../transient-universe/src -i../ghcjs-hplay/src -i../ghcjs-perch/src $1

BIN
examples/DistrbDataSets

Binary file not shown.

25
examples/DistrbDataSets.hs

File diff suppressed because one or more lines are too long

2
examples/PiDistribCountinuous.hs

@ -87,7 +87,7 @@ mainDistributed= do
numCalcsNode= 100
rresults <- liftIO $ newIORef (0,0)
runCloud' $ do
runCloudIO $ do
connect mynode seedNode
local $ option "start" "start the calculation once all the nodes have been started" :: Cloud String

158
examples/distributedExamples.hs

@ -1,158 +0,0 @@
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, MonadComprehensions #-}
module Main where
import Transient.Move
import Transient.Logged
import Transient.Base
import Transient.Indeterminism
import Transient.EVars
import Network
import Control.Applicative
import Control.Monad.IO.Class
import System.Environment
import System.IO.Unsafe
import Data.Monoid
import System.IO
import Control.Monad
import Data.Maybe
import Control.Exception
import Control.Concurrent (threadDelay)
import Data.Typeable
import Data.IORef
import Data.List((\\))
-- to be executed with two or more nodes
main = do
args <- getArgs
if length args < 2
then do
putStrLn "The program need at least two parameters: localHost localPort remoteHost RemotePort"
putStrLn "Start one node alone. The rest, connected to this node."
return ()
else keep $ do
let localHost= head args
localPort= read $ args !! 1
(remoteHost,remotePort) =
if length args >=4
then(args !! 2, read $ args !! 3)
else (localHost,localPort)
let localNode= createNode localHost localPort
remoteNode= createNode remoteHost remotePort
connect localNode remoteNode
examples
examples = do
logged $ option "main" "to see the menu" <|> return ""
r <- logged $ option "move" "move to another node"
<|> option "call" "call a function in another node"
<|> option "chat" "chat"
<|> option "netev" "events propagating trough the network"
case r of
"call" -> callExample
"move" -> moveExample
"chat" -> chat
"netev" -> networkEvents
data Environ= Environ (IORef String) deriving Typeable
callExample = do
node <- logged $ do
nodes <- getNodes
myNode <- getMyNode
return . head $ nodes \\ [myNode]
logged $ putStrLnhp node "asking for the remote data"
s <- callTo node $ do
putStrLnhp node "remote callTo request"
liftIO $ readIORef environ
liftIO $ putStrLn $ "resp=" ++ show s
{-# NOINLINE environ #-}
environ= unsafePerformIO $ newIORef "Not Changed"
moveExample = do
node <- logged $ do
nodes <- getNodes
myNode <- getMyNode
return . head $ nodes \\ [myNode]
putStrLnhp node "enter a string. It will be inserted in the other node by a migrating program"
name <- logged $ input (const True)
beamTo node
putStrLnhp node "moved!"
putStrLnhp node $ "inserting "++ name ++" as new data in this node"
liftIO $ writeIORef environ name
return()
chat :: TransIO ()
chat = do
name <- logged $ do liftIO $ putStrLn "Name?" ; input (const True)
text <- logged $ waitEvents $ putStr ">" >> hFlush stdout >> getLine' (const True)
let line= name ++": "++ text
clustered $ liftIO $ putStrLn line
networkEvents = do
node <- logged $ do
nodes <- getNodes
myNode <- getMyNode
return . head $ nodes \\ [myNode]
logged $ putStrLnhp node "<- write \"fire\" in this other node"
r <- callTo node $ do
option "fire" "fire event"
return "event fired"
putStrLnhp node $ r ++ " in remote node"
putStrLnhp p msg= liftIO $ putStr (show p) >> putStr " ->" >> putStrLn msg
--call host port proc params= do
-- port <- getPort
-- listen port <|> return
-- parms <- logged $ return params
-- callTo host port proc parms
-- close
--
--distribute proc= do
-- case dataFor proc
-- Nothing -> proc
-- Just dataproc -> do
-- (h,p) <- bestNode dataproc
-- callTo h p proc
--
--bestNode dataproc=
-- nodes <- getNodes
-- (h,p) <- bestMatch dataproc nodes <- user defined
--
--bestMatch (DataProc nodesAccesed cpuLoad resourcesNeeded) nodes= do
-- nodesAccesed: node, response
--
--bestMove= do
-- thisproc <- gets myProc
-- case dataFor thisproc
-- Nothing -> return ()
-- Just dataproc -> do
-- (h,p) <- bestNode dataproc
-- moveTo h p
--
--
--inNetwork= do
-- p <- getPort
-- listen p <|> return ()

BIN
examples/webapp.exe

Binary file not shown.

14
examples/webapp.hs

@ -5,13 +5,13 @@ module Main where
import Prelude hiding (div,id,span)
import Transient.Base
#ifdef ghcjs_HOST_OS
hiding ( option,runCloud')
hiding ( option)
#endif
import GHCJS.HPlay.View
#ifdef ghcjs_HOST_OS
hiding (map)
#else
hiding (map, option,runCloud')
hiding (map, option)
#endif
import Transient.Move
@ -83,16 +83,6 @@ fs= toJSString
-- To demonstrate wormhole, teleport, widgets, interactive streaming
-- and composability in a web application.
--
-- This is one of the most complicated interactions: how to control a stream in the server
-- by means of a web interface without loosing composability.
--
-- in this example, events flow from the server to the browser (a counter) and back from
-- the browser to the server (initiating and cancelling the counters)
counters= do
local . render . rawHtml $ do
hr

1416
nohup.out

File diff suppressed because it is too large

0
retry

0
return

2
src/Transient/DDS.hs

@ -120,7 +120,7 @@ mapKeyB= mapKey
-- | perform a map and partition the result with different keys using unboxed vectors
-- The final result will be used by reduce.
mapKeyU :: (Loggable a, Loggable b, Loggable k,Ord k)
mapKeyU :: (Loggable a, DVU.Unbox a, Loggable b, DVU.Unbox b, Loggable k,Ord k)
=> (a -> (k,b))
-> DDS (DVU.Vector a)
-> DDS (M.Map k(DVU.Vector b))

53
src/Transient/Move.hs

@ -110,16 +110,16 @@ local = Cloud . logged
#ifndef ghcjs_HOST_OS
-- #ifndef ghcjs_HOST_OS
-- | run the cloud computation.
runCloud' :: Cloud a -> IO a
runCloud' (Cloud mx)= keep mx
runCloudIO :: Cloud a -> IO a
runCloudIO (Cloud mx)= keep mx
-- | run the cloud computation with no console input
runCloud'' :: Cloud a -> IO a
runCloud'' (Cloud mx)= keep' mx
runCloudIO' :: Cloud a -> IO a
runCloudIO' (Cloud mx)= keep' mx
#endif
-- #endif
-- | alternative to `local` It means that if the computation is translated to other node
-- this will be executed again if this has not been executed inside a `local` computation.
@ -1089,39 +1089,6 @@ connect node remotenode = do
onAll $ liftIO $ putStrLn $ "Connected to nodes: " ++ show nodes
onAll $ addNodes nodes
{-
#ifndef ghcjs_HOST_OS
listen1 node remotenode = listen node <|> return ()
#else
listen1 node remotenode = onAll $ do
conn <- mconnect remotenode
release remotenode conn
setSData conn -- !!> "OPENED in listen1"
do
r <- mread conn
log <- case r of
SError e -> do
release remotenode conn
error $ show e
SDone -> do
release remotenode conn
empty
SMore log -> return log
SLast log -> do
release remotenode conn
return log
setSData $ Log True log (reverse log) -- !!> show log
<|> return ()
#endif
-}
--------------------------------------------
@ -1156,15 +1123,15 @@ httpMode (method,uri, headers) conn = do
else do
let uri'= BC.tail $ uriPath uri !> "HTTP REQUEST"
let uri'= BC.tail $ uriPath uri -- !> "HTTP REQUEST"
file= if BC.null uri' then "index.html" else uri'
content <- liftIO $ BL.readFile ( "static/out.jsexe/"++ BC.unpack file)
`catch` (\(e:: SomeException) -> return "NOT FOUND")
return ()
n <- liftIO $ SBS.sendMany conn $ ["HTTP/1.0 200 OK\nContent-Type: text/html\n\n"] ++
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 )
return () !> "HTTP sent"
return () -- !> "HTTP sent"
empty
where
@ -1202,7 +1169,7 @@ giveData h= do
receiveHTTPHead h = do
setSData $ ParseContext (giveData h) ""
(method, uri, vers) <- (,,) <$> getMethod <*> getUri <*> getVers
headers <- many $ (,) <$> (mk <$> getParam) <*> getParamValue !> (method, uri, vers)
headers <- many $ (,) <$> (mk <$> getParam) <*> getParamValue -- !> (method, uri, vers)
return (method, uri, headers) -- !> (method, uri, headers)
where

10
src/Transient/Move/Services.hs

@ -126,7 +126,7 @@ notifyService node service= clustered $ do
local $ sendNodeEvent (node,service)
return ()
{-
main= do
-- keep $ install "http://github.com/agocorona/transient" "MainStreamFiles" 3000
let node1= createNode "localhost" 2000
@ -135,7 +135,7 @@ main= do
let [localNode,remoteNode]= if null args then [node1,node2] else [node2,node1]
runCloud' $ do
runCloudIO $ do
onAll $ addNodes [localNode, remoteNode]
onAll $ setMyNode localNode
listen localNode <|> return ()
@ -144,11 +144,7 @@ main= do
startServices
port <-initService remoteNode "http://github.com/agocorona/transient" "MainStreamFiles"
onAll . liftIO $ putStrLn $ "installed at" ++ show port
-- nodes <- getNodes
-- liftIO $ print nodes
-- liftIO syncCache
-- option "end" "end"
-- liftIO $ print "END"
-}

3
stack.yaml

@ -1,7 +1,10 @@
flags: {}
packages:
- '.'
- ../transient
extra-deps: [transient-0.2]
resolver: lts-3.1

124
transient-universe.cabal

@ -8,68 +8,108 @@ maintainer: agocorona@gmail.com
homepage: http://www.fpcomplete.com/user/agocorona
bug-reports: https://github.com/agocorona/transient/issues
synopsis: wormholes,teleporting remote executions and map-reduce: distributed computing for transient
description: see <http://github.com/agocorona/transient>
description:
see <http://github.com/agocorona/transient>
category: Control
author: Alberto G. Corona
data-dir: ""
source-repository head
type: git
location: https://github.com/agocorona/transient-universe
library
build-depends: transformers
if impl(ghcjs >=0.1)
build-depends: base >4 && <5, mtl , random ,
containers , stm , transformers , process ,
bytestring , time , ghcjs-base , ghcjs-prim
exposed: True
buildable: True
build-depends:
base >4 && <5,
mtl -any,
random -any,
containers -any,
stm -any,
transformers -any,
process -any,
bytestring -any,
time -any,
ghcjs-base -any,
ghcjs-prim -any
else
build-depends: base >4 && <5, mtl , random , transient,
containers , directory , filepath , stm ,
HTTP , network , transformers , process ,network,
network-info , bytestring , time , vector ,
TCache , websockets , network-uri ,
case-insensitive , hashable , text
exposed: True
buildable: True
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 -any,
network-info -any,
bytestring -any,
time -any,
vector -any,
TCache -any,
websockets -any,
network-uri -any,
case-insensitive -any,
hashable -any,
text -any
if impl(ghcjs >=0.1)
exposed-modules: Transient.Move
exposed: True
buildable: True
exposed-modules:
Transient.Move
else
exposed-modules: Transient.DDS
Transient.Move
Transient.Move.Services
exposed: True
buildable: True
exposed: True
buildable: True
exposed-modules:
Transient.DDS
Transient.Move
Transient.Move.Services
build-depends:
transformers -any,
containers >=0.5.6.2 && <0.6
default-language: Haskell2010
hs-source-dirs: src .
Executable DistrbDataSets
Main-is: DistrbDataSets.hs
Other-Modules:
Build-Depends: base, network,transient,TCache, transformers,transient-universe
hs-source-dirs: examples
ghc-options: -prof -auto-all -rtsopts -threaded
--executable DistrbDataSets
-- main-is: DistrbDataSets.hs
-- build-depends:
-- base -any,
-- network -any,
-- transient -any,
-- TCache -any,
-- transformers -any,
-- transient-universe -any,
-- containers >=0.5.6.2 && <0.6
-- hs-source-dirs: examples
-- ghc-options: -prof -auto-all -rtsopts -threaded
test-suite test-transient
build-depends: base >4 && <5, mtl , random ,
containers , directory , filepath , stm ,
HTTP , network , transformers , process ,network,
network-info , bytestring , time , vector ,
TCache , websockets , network-uri ,
case-insensitive , hashable
type: exitcode-stdio-1.0
main-is: TestSuite.hs
buildable: True
build-depends:
base >4 && <5,
mtl -any,
random -any,
containers -any,
directory -any,
filepath -any,
stm -any,
HTTP -any,
network -any,
transformers -any,
process -any,
network -any,
network-info -any,
bytestring -any,
time -any,
vector -any,
TCache -any,
websockets -any,
network-uri -any,
case-insensitive -any,
hashable -any,
containers >=0.5.6.2 && <0.6
default-language: Haskell2010
hs-source-dirs: tests src .

19
transient-universe.cabal.lkshs

@ -0,0 +1,19 @@
Version of session file format:
2
Time of storage:
"Fri Apr 8 12:46:53 Hora de verano romance 2016"
Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) 124)], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 2, detachedId = Nothing, detachedSize = Nothing}) 346) 228255
Population: [(Just (BufferSt (BufferState "C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient-universe\\examples\\DistrbDataSets.hs" 224)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 250 (SystemScope,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP]),(Just (SearchSt (SearchState {searchString = "render", searchScope = SystemScope, searchMode = Prefix {caseSense = False}})),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient-universe\\src\\Transient\\Move\\Services.hs" 2789)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP BottomP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient-universe\\examples\\webapp.hs" 1194)),[SplitP LeftP])]
Window size: (1366,705)
Full screen: False
Completion size:
(1021,403)
Workspace: Just "C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient-universe\\transient-universe.cabal.lkshw"
Active pane: Just "DistrbDataSets.hs"
Toolbar visible:
True
FindbarState: (True,FindState {entryStr = "runCLo", entryHist = ["runCLo"], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, regex = False, lineNr = 1})
Recently opened files:
[]
Recently opened workspaces:
[]

14
transient-universe.cabal.lkshw

@ -0,0 +1,14 @@
Version of workspace file format:
2
Time of storage:
"Sat Apr 9 12:30:07 Hora de verano romance 2016"
Name of the workspace:
"transient-universe.cabal"
File paths of contained packages:
["C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\ghcjs-hplay\\ghcjs-hplay.cabal","C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient\\transient.cabal","transient-universe.cabal"]
Maybe file path of an active package:
Just "C:\\Users\\magocoal\\OneDrive\\Haskell\\devel\\transient\\transient.cabal"
Maybe name of an active executable:
Nothing
Version Control System configurations for packages:
fromList []
Loading…
Cancel
Save