Skip to content

Latest commit

 

History

History
497 lines (371 loc) · 9.88 KB

11_OTPBehaviours.md

File metadata and controls

497 lines (371 loc) · 9.88 KB
Raw

OTP Behaviours

[ToC]

Overview

Hamler implements OTP Behaviours with Type Classes.

GenServer

Client-Server Model

See: Erlang gen_server Behaviour

Client-server model

GenServer Typeclass

class GenServer req rep st | req -> rep, rep -> st, st -> req where
  handleCall :: HandleCall req rep st
  handleCast :: HandleCast req rep st

Server Example

module Demo.Server
  ( start
  , inc
  , dec
  , query
  ) where

import Prelude
import Control.Behaviour.GenServer
  ( class GenServer
  , HandleCall
  , HandleCast
  , Init
  , startLinkWith
  , initOk
  , call
  , cast
  , noReply
  , reply
  , shutdown
  )
import System.IO (println)

data Request = Inc | Dec | Query
data Reply = QueryResult Integer
data State = State Integer

name :: Atom
name = :server

start :: Process Pid
start = startLinkWith name (init 20)

-----------------------------------------------------------------------------
-- | Server API
-----------------------------------------------------------------------------

inc :: Process ()
inc = cast name Inc

dec :: Process ()
dec = cast name Dec

query :: Process Integer
query = do
  QueryResult i <- call name Query
  return i

-----------------------------------------------------------------------------
-- | Server callbacks
-----------------------------------------------------------------------------

instance GenServer Request Reply State where
  handleCall = handleCall
  handleCast = handleCast

init :: Integer -> Init Request State
init n = initOk (State n)

handleCall :: HandleCall Request Reply State
handleCall Query _from (State i) = do
  println "Call: Query"
  reply (QueryResult i) (State i)
handleCall _req _from st =
  shutdown :badRequest st

handleCast :: HandleCast Request Reply State
handleCast Inc (State n) = do
  println "Cast: Inc"
  noReply $ State (n+1)
handleCast Dec (State n) = do
  println "Cast: Dec"
  noReply $ State (n-1)
handleCast _ st = noReply st

Start a Server process

-- | Start a standalone Server process.
start :: forall req rep st. GenServer req rep st => (Init req st) -> Process Pid
startWith :: forall req rep st. GenServer req rep st => Name -> (Init req st) -> Process Pid

-- | Start a Server process as part of a supervision tree.
startLink :: forall req rep st. GenServer req rep st => (Init req st) -> Process Pid
startLinkWith :: forall req rep st. GenServer req rep st => Name -> (Init req st) -> Process Pid

Init callback

-- | Init Result
data InitResult req st
  = InitOk st (Maybe (Action req))
    -- ^ {ok, State}
  | InitIgnore
    -- ^ ignore
  | InitStop ExitReason
    -- ^ {stop, Reason}

-- | Init callback
type Init req st = Process (InitResult req st)

HandleCall and HandleCast

-- | HandleCall callback
type HandleCall req rep st
  = req -> From -> st -> Process (Reply req rep st)

-- | HandleCast callback
type HandleCast req rep st
  = req -> st -> Process (Reply req rep st)

Client APIs

-- | Synchronous call to the server process.
call :: forall req rep. Name -> req -> Process rep

-- | Sends an asynchronous request to the server process.
cast :: forall req. Name -> req -> Process ()

GenStatem

Event-Driven FSM

See: Erlang gen_statem Behaviour

State(S) x Event(E) -> Actions(A), State(S')

GenStatem Typeclass

class GenStatem e s d | e -> s, s -> d, d -> e where
  handleEvent :: HandleEvent e s d

CodeLock Example

module Demo.FSM.CodeLock
  ( name
  , start
  , push
  , stop
  ) where

import Prelude

import Control.Behaviour.GenStatem
  ( class GenStatem
  , Action(..)
  , EventType(..)
  , Init
  , OnEvent
  , initOk
  , handleWith
  , unhandled
  )
import Control.Behaviour.GenStatem as FSM

data Event = Button Integer | Lock
data State = Locked | Opened
data Data = Data
  { code :: [Integer]
  , length :: Integer
  , buttons :: [Integer]
  }

instance Eq State where
  eq Locked Locked = true
  eq Opened Opened = true
  eq _ _ = false

instance GenStatem Event State Data where
  handleEvent = handleWith [(Locked, locked), (Opened, opened)]

name :: Atom
name = :code_lock

start :: [Integer] -> Process Pid
start code = FSM.startLinkWith name (init code)

push :: Integer -> Process ()
push n = FSM.cast name (Button n)

stop :: Process ()
stop = FSM.stop name

init :: [Integer] -> Init Event State Data
init code = initOk Locked d
  where d = Data $ { code = reverse code
                   , length = length code
                   , buttons = []
                   }

locked :: OnEvent Event State Data
locked Cast (Button n) (Data d) =
  let buttons = take d.length [n|d.buttons]
   in if buttons == d.code then
        let actions = [StateTimeout 1000 Lock] in
            FSM.nextWith Opened (Data d{buttons = []}) actions
      else FSM.keep (Data d{buttons = buttons})

locked t e d = unhandled t e Locked d

opened :: OnEvent Event State Data
opened Cast (Button _) d = FSM.keep d

opened Timeout Lock d = do
  println "Timeout Lock"
  FSM.next Locked d

opened t e d = unhandled t e Opened d

Start a FSM process

-- | Start a standalone FSM process
start :: forall e s d. GenStatem e s d => (Init e s d) -> Process Pid
startWith :: forall e s d. GenStatem e s d => Name -> (Init e s d) -> Process Pid

-- | Start a FSM process as part of a supervision tree.
startLink :: forall e s d. GenStatem e s d => (Init e s d) -> Process Pid
startLinkWith :: forall e s d. GenStatem e s d => Name -> (Init e s d) -> Process Pid

Init callback

-- | Init Result
data InitResult e s d
  = InitOk s d [Action e]
    -- ^ {ok, State, Actions}
  | InitIgnore
    -- ^ ignore
  | InitStop ExitReason
    -- ^ {stop, Reason}

-- | Init Action
type Init e s d = Process (InitResult e s d)

HandleEvent callback

-- | Event Type
data EventType
  = Call From | Cast | Info
    -- ^ external event type
  | Timeout
    -- ^ timeout event type
  | Internal
    -- ^ internal

-- | Statem Transition
data Transition e s d
  = Keep d [Action e]
  | Next s d [Action e]
  | Repeat d [Action e]
  | Shutdown ExitReason d

type HandleEvent e s d = EventType -> e -> s -> d -> Process (Transition e s d)

-- | On Event
type OnEvent e s d = EventType -> e -> d -> Process (Transition e s d)

-- | Handle with state functions.
handleWith :: forall e s d. [(s, OnEvent e s d)] -> HandleEvent e s d

Client APIs

call :: forall req rep. Name -> req -> Process rep

cast :: forall msg. Name -> msg -> Process ()

GenEvent

Event Handling Principles

See: Erlang gen_event Behaviour

GenEvent Typeclass

class GenEvent e st | e -> st, st -> e where
  handleEvent :: HandleEvent e st

Event Manager Example

module Demo.Event
  ( Event(..)
  , start
  , notify
  ) where

import Prelude

import Control.Behaviour.GenEvent
  ( class GenEvent
  , Init
  , initOk
  , HandleEvent
  , startLinkWith
  )
import Control.Behaviour.GenEvent as E

data Event = EventA | EventB
data State = State [Event]

instance GenEvent Event State where
  handleEvent = handleEvent

name :: Atom
name = :event

start :: Process Pid
start = startLinkWith name init

notify :: Event -> Process ()
notify = E.notify name

init :: Init State
init = initOk (State [])

handleEvent :: HandleEvent Event State
handleEvent e (State events) = do
  println "Event"
  return $ State [e|events]

Start a Event Manager process

-- | Start a standalone Event Manager process.
start :: forall e st. GenEvent e st => (Init st) -> Process Pid
startWith :: forall e st. GenEvent e st => Name -> (Init st) -> Process Pid

-- | Start a Event Manager process as part of a supervision tree.
startLink :: forall e st. GenEvent e st => (Init st) -> Process Pid
startLinkWith :: forall e st. GenEvent e st => Name -> (Init st) -> Process Pid

Init callback

data InitResult st
  = InitOk st
  | InitOkHib st
  | InitError ExitReason

-- | Init callback
type Init st = Process (InitResult st)

HandleEvent Callback

-- | HandleEvent callback
type HandleEvent e st = e -> st -> Process st

Client APIs

notify :: forall e. Name -> e -> Process ()

syncNotify :: forall e. Name -> e -> Process ()

Supervisor

Supervision Tree

See: Erlang Supervisor Behaviour

Example

module Demo.Sup (start) where

import Prelude

import Demo.Event as Event
import Demo.Server as Server
import Demo.FSM.PushButton as FSM
import Control.Behaviour.Supervisor
  ( Init
  , initOk
  , Strategy(..)
  , childSpec
  , startSupWith
  )

name :: Atom
name = :sup

start :: Process Pid
start = startSupWith name init

init :: Init
init = initOk (OneForOne, 10, 100)
  [ childSpec "Demo.Event" Event.start
  , childSpec "Demo.Server" Server.start
  , childSpec "Demo.Statem" FSM.start
  ]

Start a Supervisor process

-- Start a supervisor process.
startSup :: Init -> Process Pid

-- Start a supervisor with name.
startSupWith :: Name -> Init -> Process Pid

Init callback

type SupFlags = (Strategy, Intensity, Integer)

-- | Init Result
data InitResult
  = InitOk SupFlags [ChildSpec]
    -- ^ {ok, State}
  | InitIgnore
    -- ^ ignore

-- | Init callback
type Init = Process InitResult

Restart Strategy

See: Erlang Restart Strategy

data Strategy
  = OneForAll
  -- ^ Restart all child processes if one terminated.
  | OneForOne
  -- ^ Restart only the child processs terminated.
  | RestForOne
  -- ^ TODO: comment...
  | SimpleOneForOne
  -- ^ TODO: comment...

OneForOne

OneForAll

OneForRest

SimpleOneForOne