purescript-node-workers/src/Node.Worker.Parent.purs

module Node.Worker.Parent
  ( Worker
  , SpawnEnv(..)
  , stdout
  , stderr
  , stdin
  , exitH
  , errorH
  , terminate
  , threadId
  , ref
  , unref
  , resourceLimits
  , messageerrorH
  , onlineH
  , SpawnOptions
  , spawnFile
  , spawnFile'
  , spawnScript
  , spawnScript'
  ) where

import Prelude

import Control.Promise (Promise)
import Control.Promise as Promise
import Data.Either (hush)
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Nullable as Nullable
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Exception (Error)
import Effect.Uncurried (mkEffectFn1)
import Foreign (Foreign, unsafeToForeign)
import Foreign.Object as Object
import Node.EventEmitter (EventHandle(..))
import Node.EventEmitter.UtilTypes (EventHandle1, EventHandle0)
import Node.Stream (Readable, Writable)
import Node.Worker (ResourceLimits, shareEnv)
import Node.Worker.Port (class PortLike)
import Node.Worker.Serializable (class Serializable, deserialize, serialize)
import Prim.Row (class Nub, class Union)
import Record as Record
import Record.Apply (applyRecord)
import Type.Prelude (Proxy(..))

foreign import data Worker :: Type

foreign import spawnImpl :: String -> Record SpawnImplOptions -> Effect Worker
foreign import workerPostMessageImpl :: Worker -> Foreign -> Effect Unit
foreign import stdinImpl :: Worker -> Nullable (Writable ())
foreign import terminateImpl :: Worker -> Effect (Promise Int)
foreign import resourceLimitsImpl :: Worker -> Foreign

foreign import stderr :: Worker -> Readable ()
foreign import stdout :: Worker -> Readable ()
foreign import threadId :: Worker -> Int
foreign import ref :: Worker -> Effect Unit
foreign import unref :: Worker -> Effect Unit

instance PortLike Worker where
  postMessage w a = workerPostMessageImpl w (serialize a)
  messageH = EventHandle "message" $ \psCb -> mkEffectFn1 (psCb <<< deserialize)

type SpawnImplOptions =
  ( argv :: Nullable (Array Foreign)
  , env :: Nullable Foreign
  , eval :: Nullable (Boolean)
  , execArgv :: Nullable (Array String)
  , stdin :: Nullable (Boolean)
  , stdout :: Nullable (Boolean)
  , stderr :: Nullable (Boolean)
  , workerData :: Nullable (Foreign)
  , trackUnmanagedFds :: Nullable (Boolean)
  , transferList :: Nullable (Array Foreign)
  , resourceLimits :: Nullable (ResourceLimits)
  , name :: Nullable (String)
  )

data SpawnEnv
  = InheritEnv
  | FixedEnv (Map String String)

type SpawnOptions r =
  ( argv :: Maybe (Array String)
  , env :: Maybe SpawnEnv
  , execArgv :: Maybe (Array String)
  , stdin :: Maybe (Boolean)
  , stdout :: Maybe (Boolean)
  , stderr :: Maybe (Boolean)
  , trackUnmanagedFds :: Maybe (Boolean)
  , transferList :: Maybe (Array Foreign)
  , resourceLimits :: Maybe (ResourceLimits)
  , name :: Maybe (String)
  | r
  )

emptySpawnOptions :: Record (SpawnOptions ())
emptySpawnOptions =
  { argv: Nothing
  , env: Nothing
  , execArgv: Nothing
  , stdin: Nothing
  , stdout: Nothing
  , stderr: Nothing
  , trackUnmanagedFds: Nothing
  , transferList: Nothing
  , resourceLimits: Nothing
  , name: Nothing
  }

spawnOptionsToImpl :: forall a. Serializable a => Record (SpawnOptions (workerData :: Maybe a, eval :: Boolean)) -> Record SpawnImplOptions
spawnOptionsToImpl =
  let
    mapEnv (Just InheritEnv) = Nullable.notNull $ unsafeToForeign shareEnv
    mapEnv (Just (FixedEnv env)) = Nullable.notNull $ serialize $ Object.fromFoldableWithIndex env
    mapEnv Nothing = Nullable.null
  in
    applyRecord
      { argv: Nullable.toNullable <<< map (map unsafeToForeign)
      , env: mapEnv
      , eval: Nullable.notNull
      , execArgv: Nullable.toNullable
      , stdin: Nullable.toNullable
      , stdout: Nullable.toNullable
      , stderr: Nullable.toNullable
      , trackUnmanagedFds: Nullable.toNullable
      , transferList: Nullable.toNullable
      , resourceLimits: Nullable.toNullable
      , name: Nullable.toNullable
      , workerData: Nullable.toNullable <<< map serialize
      }

spawnFile :: forall a r optsdup. Serializable a => Union r (SpawnOptions ()) optsdup => Nub optsdup (SpawnOptions ()) => Record r -> String -> a -> Effect Worker
spawnFile opts' file d =
  let
    opts :: Record (SpawnOptions ())
    opts = Record.merge opts' emptySpawnOptions

    implOpts :: Record SpawnImplOptions
    implOpts =
      spawnOptionsToImpl
        $ Record.insert (Proxy @"workerData") (Just d)
        $ Record.insert (Proxy @"eval") false opts
  in
    spawnImpl file implOpts

spawnFile' :: forall r optsdup. Union r (SpawnOptions ()) optsdup => Nub optsdup (SpawnOptions ()) => Record r -> String -> Effect Worker
spawnFile' opts' file = spawnFile opts' file (Nothing :: Maybe String)

spawnScript :: forall a r optsdup. Serializable a => Union r (SpawnOptions ()) optsdup => Nub optsdup (SpawnOptions ()) => Record r -> String -> a -> Effect Worker
spawnScript opts' script d =
  let
    opts :: Record (SpawnOptions ())
    opts = Record.merge opts' emptySpawnOptions

    implOpts :: Record SpawnImplOptions
    implOpts =
      spawnOptionsToImpl
        $ Record.insert (Proxy @"workerData") (Just d)
        $ Record.insert (Proxy @"eval") true opts
  in
    spawnImpl script implOpts

spawnScript' :: forall r optsdup. Union r (SpawnOptions ()) optsdup => Nub optsdup (SpawnOptions ()) => Record r -> String -> Effect Worker
spawnScript' opts' script = spawnScript opts' script (Nothing :: Maybe String)

exitH :: EventHandle1 Worker Int
exitH = EventHandle "exit" mkEffectFn1

errorH :: EventHandle1 Worker Error
errorH = EventHandle "error" mkEffectFn1

messageerrorH :: EventHandle1 Worker Error
messageerrorH = EventHandle "messageerror" mkEffectFn1

onlineH :: EventHandle0 Worker
onlineH = EventHandle "online" (const $ pure unit)

stdin :: Worker -> Maybe (Writable ())
stdin = Nullable.toMaybe <<< stdinImpl

terminate :: Worker -> Aff Int
terminate = Promise.toAffE <<< terminateImpl

resourceLimits :: Worker -> Maybe ResourceLimits
resourceLimits = join <<< hush <<< deserialize <<< resourceLimitsImpl