Mark Eibes
2019-12-24T00:22:07Z

Effect_Goroutine.go

| package purescript_goroutine
|
| import (
| "io/ioutil"
| "net/http"
| "sync"
| "time"
|
| . "github.com/purescript-native/go-runtime"
| )
|
| func init() {
| exports := Foreign("Effect.Goroutine")
|
| exports["httpReqImpl"] = func(left Any) Any {
| return func(right Any) Any {
| return func(url_ Any) Any {
| return func() Any {
| url := url_.(string)
| req, err := http.NewRequest(http.MethodGet, url, nil)
| if err != nil {
| return Apply(left, err.Error())
| }
| res, err := http.DefaultClient.Do(req)
| if err != nil {
| return Apply(left, err.Error())
| }
| defer res.Body.Close()
| if err != nil {
| return Apply(left, err.Error())
| }
| bodyString, err := ioutil.ReadAll(res.Body)
| if err != nil {
| return Apply(left, err.Error())
| }
| return Apply(right, (string(bodyString)))
| }
| }
| }
| }
| 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.Uncurried (EffectFn3, runEffectFn3)
| 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 ∷ ∀ a. WaitGroup -> Effect a -> Effect Unit
| foreign import mkChannel ∷ Effect Channel
| foreign import send ∷ ∀ a. Channel -> a -> Effect Unit
| foreign import receive ∷ ∀ a. Channel -> Effect a
| foreign import go ∷ Effect Unit -> Effect Unit
| foreign import sleepImpl ∷ Int -> Effect Unit
|
| foreign import httpReqImpl ∷
| (String -> Either String String) ->
| (String -> Either String String) ->
| String ->
| Effect (Either String String)
|
| httpReq ∷ String -> Effect (Either String String)
| httpReq = httpReqImpl Left Right
|
| newtype Go a = Go (Effect a)
|
| toEffect ∷ ∀ a. Go a -> Effect a
| toEffect (Go x) = x
|
| sleep ∷ ∀ f. MonadEffect f => Int -> f Unit
| sleep = liftEffect <<< sleepImpl
|
| async ∷ ∀ a. Effect a -> Go a
| async eff = Go do
| c <- mkChannel
| go $ eff >>= send c
| receive c
|
| parAsync ∷ ∀ 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 ∷ ∀ 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 ∷ ∀ 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 ∷ ∀ 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