deft/blog-transient.org

Haskell Transient

• Transient Basic
  • Basic operators async and (<|>)
    • Intuition for (<|>)
    • Follow up
• Working with multiple nodes
  • Launch a process on two external nodes
  • Now with n nodes:
  • More details

Transient Basic

Basic operators async and (<|>)

import Control.Monad.IO.Class (liftIO)
import Transient.Base (keep',async)
import Transient.Move (local,onAll,runAt,lliftIO,Node,Cloud,addNodes,listen,createNode,runCloudIO)
import Data.Monoid ((<>))
import Control.Applicative ((<|>),empty)
import Data.Foldable (traverse_)
flapping :: IO ()
flapping = keep' $ do -- keep' is just here to stranslate from TransIO to IO
  -- Inside this do we are in the TransIO Monad context
  x <- async (return "1") -- spawn another thread
       <|> async (return "2") -- spawn another thread
       <|> return "main thread MUST BE AT THE END!!!!!!" -- don't spawn any thread
  liftIO $ print x

So this code spawn 2 threads, each printing something different. The first will print "1", the second "2" and the main thread will print "main thread MUST BE AT THE END!!!!!!!".

Intuition for (<|>)

(<|>) is an operator of choice on Applicative. To shut down all the abstraction bullshit. Let's just say that (<|>) operator is defined aside of an empty element. Just that:

empty <|> x = x
x <|> empty = x

In TransIO monad context, it will choose the first non empty choice.

> Just "Hello" <|> Just "World"
Just "Hello"

> Nothing <|> Just "World"
Just World

> :t (<|>)
(<|>) :: Alternative f => f a -> f a -> f a

-- Compare to this:
> :t (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b

> (,) <$> Just "Hello" <*> Just "World"
Just ("Hello","World")

> (,) <$> Nothing <*> Just "World"
Nothing

Follow up

In the code example as async will return empty in the current process but not empty in the other process. The same code do two different things depending on the context. Exactly like fork in C.

Working with multiple nodes

Launch a process on two external nodes

module Flapping
  (flapper
  ,flapping)
where


import Control.Monad.IO.Class (liftIO)
import Transient.Base (TransIO)
import Transient.Move (local,onAll,runAt,lliftIO,Node,Cloud,addNodes,listen,createNode,runCloudIO)
import GHCJS.HPlay.View (div,id,span)
import Data.Monoid ((<>))
import Control.Applicative ((<|>),empty)
import Control.Monad (mapM)

main :: IO ()
main = do
  -- creating two nodes on localhost
  node1 <- createNode "localhost" 20000
  node2 <- createNode "localhost" 20001
  runCloudIO $ do
    -- create 3 threads
    -- one listen node1
    -- the other listen node 2
    -- the last one is the current thread
    listen node1 <|> listen node2 <|> return ()
    -- on node1 return "hello"
    r1 <- runAt node1 (return "hello")
    -- on node2 return "world"
    r2 <- runAt node2 (return "world")
    -- the local thread print "hello world!"
    local $ liftIO $ putStrLn (r1 <> " " <> r2 <> "!")

Now with n nodes:

import Control.Monad.IO.Class (liftIO)
import Transient.Base (TransIO)
import Transient.Move (local,onAll,runAt,lliftIO,Node,Cloud,addNodes,listen,createNode,runCloudIO)
import GHCJS.HPlay.View (div,id,span)
import Data.Monoid ((<>))
import Control.Applicative ((<|>),empty)
import Control.Monad (mapM)
import Data.Foldable (traverse_)

func = a -> m a
func n = return ("received: " <> show n)

main :: IO ()
main = do
  let nbNodes = 10
  -- create nbNodes which can receive orders to execute functions
  nodes <- traverse (createNode "localhost") [20000..(20000 + nbNodes - 1)]
  runCloudIO $ do
    -- make nbNodes threads listening to all created nodes
    foldl (<|>) empty (map listen nodes) <|> return ()
    r <- traverse (\n -> runAt (nodes !! n) (func n))
                  [0..(fromIntegral nbNodes - 1)]
    -- local to go from TransIO -> Cloud
    -- liftIO to go from IO -> TransIO
    local $ liftIO $ traverse_ print r

More details

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flapping
  (flapping)
where

-- We use protolude to make things safer by default
-- and use less imports at the same time
-- Yeah, Base.Prelude is pretty fucked up
-- Not good for beginner neither for advanced users
import           Protolude      hiding (async, local)

import           Transient.Base (async, keep')
import           Transient.Move (Cloud, Node, addNodes, createNode, listen,
                                 lliftIO, local, onAll, runAt, runCloudIO)
-- import GHCJS.HPlay.View (div,id,span)

func :: Int -> Cloud Text
func n = return ("received: " <> show n)

flapping :: IO ()
flapping = do
  let nbNodes = 100
  -- create nbNodes which can receive orders to execute functions
  nodes <- traverse (createNode "localhost") [20000..(20000 + nbNodes - 1)]
  runCloudIO $ do
    -- make nbNodes threads listening to all created nodes
    foldl (<|>) empty (map listen nodes) <|> return ()
    -- zip nodes ([1..] :: [Int]) => [(node1,1), (node2,2),...]
    -- then we use these couples of type (Node,Int) to run some process
    -- on another node
    -- the & just reverse the order of function application
    -- I prefer to say, take theses objects and do this thing to them
    -- instead of
    -- do this thing to all of theses objects
    r <- zip nodes ([1..] :: [Int]) &
           traverse (\(node,n) -> runAt node (func n))

    -- local to go from TransIO -> Cloud
    -- liftIO to go from IO -> TransIO
    -- so
    -- local . liftIO :: IO -> Cloud
    -- is just here for the plumbing
    local . liftIO $ traverse_ putText r

Results are in order, because traverse is sequential