Mark Eibes
2019-11-04T09:51:36Z

Effect_Goroutine.go

| package purescript_goroutine
|
| import (
| "sync"
| "time"
|
| . "github.com/purescript-native/go-runtime"
| )
|
| func init() {
| exports := Foreign("Effect.Goroutine")
|
| exports["fireAndForget"] = func(fn Any) Any {
| return func() Any {
| go Run(fn)
| return nil
| }
| }
|
| exports["blocking"] = func(wg_ Any) Any {
| return func(fn Any) Any {
| return func() Any {
| wg, _ := wg_.(*sync.WaitGroup)
| wg.Add(1)
| go func() {
| Run(fn)
| wg.Done()
| }()
| wg.Wait()
| return nil
| }
| }
| }
|
| exports["receive"] = func(channel_ Any) Any {
| return func() Any {
| channel := channel_.(chan Any)
| result := <-channel
| return result
| }
| }
|
| exports["go"] = func(fn Any) Any {
| return func() Any {
| go Run(fn)
| return nil
| }
| }
|
| exports["send"] = func(channel_ Any) Any {
| return func(value Any) Any {
| return func() Any {
| channel := channel_.(chan Any)
| channel <- value
| return nil
| }
| }
| }
|
| exports["sleepImpl"] = func(millis_ Any) Any {
| return func() Any {
| millis, _ := millis_.(int)
| time.Sleep(time.Duration(millis) * time.Millisecond)
| return nil
| }
| }
|
| exports["mkChannel"] = func() Any {
| return make(chan Any)
| }
|
| exports["waitGroup"] = func() Any {
| var wg sync.WaitGroup
| return &wg
| }
|
| }

Goroutine.purs

| module Effect.Goroutine where
|
| import Prelude
|
| import Data.Either (Either(..))
| import Data.Foldable (oneOf, traverse_)
| import Data.Maybe (Maybe(..))
| import Data.Traversable (sequence_)
| import Data.Tuple (Tuple(..))
| import Effect (Effect)
| import Effect.Class (class MonadEffect, liftEffect)
| import Effect.Unsafe (unsafePerformEffect)
| import Partial.Unsafe (unsafeCrashWith)
| import Unsafe.Coerce (unsafeCoerce)
|
| foreign import fireAndForget ∷ Effect Unit -> Effect Unit
|
| foreign import data WaitGroup ∷ Type
| foreign import data Channel ∷ Type
|
| foreign import waitGroup ∷ Effect WaitGroup
|
| foreign import blocking ∷ forall a. WaitGroup -> Effect a -> Effect Unit
| foreign import mkChannel ∷ Effect Channel
| foreign import send ∷ forall a. Channel -> a -> Effect Unit
| foreign import receive ∷ forall a. Channel -> Effect a
| foreign import go ∷ Effect Unit -> Effect Unit
| foreign import sleepImpl ∷ Int -> Effect Unit
|
| newtype Go a = Go (Effect a)
|
| toEffect :: forall a. Go a -> Effect a
| toEffect (Go x) = x
|
| sleep ∷ ∀ f. MonadEffect f => Int -> f Unit
| sleep = liftEffect <<< sleepImpl
|
| async ∷ forall a. Effect a -> Go a
| async eff = Go do
| c <- mkChannel
| go $ eff >>= send c
| receive c
|
| parAsync ∷ forall a b. Effect a -> Effect b -> Go (Tuple a b)
| parAsync eff1 eff2 = Go do
| c <- mkChannel
| go $ eff1 >>= Right >>> send c
| go $ eff2 >>= Left >>> send c
| res1 <- receive c
| res2 <- receive c
| case res1, res2 of
| Left r1, Right r2 -> pure (Tuple r1 r2)
| Right r2, Left r1 -> pure (Tuple r1 r2)
| _,_ -> unsafeCrashWith "Impossible channel state"
|
| race ∷ forall a b. Effect a -> Effect a -> Go a
| race eff1 eff2 = Go do
| c <- mkChannel
| go $ eff1 >>= send c
| go $ eff2 >>= send c
| receive c
|
| apathise ∷ forall a. Go a -> Effect Unit
| apathise x = do
| _ <- pure (unsafePerformEffect (toEffect x))
| pure unit
|
| dunno :: ∀ a. a
| dunno = unsafeCoerce ""
|
| instance functorGo ∷ Functor Go where
| map f (Go eff) = Go (map f eff)
|
| instance applicativeGo ∷ Applicative Go where
| pure = Go <<< pure
|
| instance applyGo ∷ Apply Go where
| apply :: forall a b. Go (a -> b) -> Go a -> Go b
| apply (Go f) (Go a) = Go (apply f a)
|
| instance bindGo ∷ Bind Go where
| bind (Go first) f = Go do
| frst <- first
| toEffect (f frst)
|
| instance monadGo ∷ Monad Go
|
| instance monadEffectGo ∷ MonadEffect Go where
| liftEffect = Go

Main.purs

| module Main where
|
| import Prelude
|
| import Data.Array ((!!), length)
| import Data.Int (floor)
| import Data.Maybe (fromMaybe)
| import Effect (Effect)
| import Effect.Class (liftEffect)
| import Effect.Class.Console (log)
| import Effect.Goroutine (apathise, async, blocking, fireAndForget, go, mkChannel, receive, send, sleep, sync, toEffect, waitGroup, parAsync, race)
| import Effect.Random (random)
|
| ofm = [ "Always put yourself in our customer’s shoes", "Solve something that matters", "Put purpose first, ego second", "Think big, act fast", "Keep it simple, Sherlock", "Disagree and commit", "Start with “yes”", "Act like an owner", "Fly high and dive deep", "Don’t meet because it’s “Thursday”", "Make us better, not bigger", "Be your team’s biggest fan", "Live high challenge and high support", "Default to transparency" ]
|
| main :: Effect Unit
| main = void $ toEffect do
| res <- race (sleep 2000 $> "Slowboy") (sleep 3000 $> "Fastboy")
| log res
| parAsync (bla "first") (bla "second")
|
| bla str = toEffect $ do
| void $ parAsync
| (sleep 2000 *> log (str <> " 1"))
| (sleep 1000 *> log (str <> " 2"))
| @meibes
|