Skip to content

Instantly share code, notes, and snippets.

@mastoj
Last active February 12, 2016 23:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mastoj/9dfc21848c449fadcc93 to your computer and use it in GitHub Desktop.
Save mastoj/9dfc21848c449fadcc93 to your computer and use it in GitHub Desktop.
Simple FSM in F#. The fowler_fsm.fsx is an F# implementation of Miss Grant's controller from Fowler's DSL book: http://www.informit.com/articles/article.aspx?p=1592379&seqNum=2
module FSM =
type FSM<'TState, 'TEvent, 'TCommand when 'TEvent : comparison and 'TState : comparison> =
{
Transitions: Map<'TState, Map<'TEvent, 'TState>>
CurrentState: 'TState
InitState: 'TState
Commands: Map<'TState, 'TCommand list>
ResetEvents: 'TEvent list
CommandChannel: 'TCommand -> unit
}
let handleEvent e fsm =
let transitionTo state fsm =
match fsm.Commands |> Map.tryFind state with
| None -> ()
| Some commands -> commands |> List.iter fsm.CommandChannel
{fsm with CurrentState = state}
match fsm.ResetEvents |> List.tryFind (fun re -> re = e) with
| Some _ -> transitionTo fsm.InitState fsm
| None ->
fsm.Transitions
|> Map.tryFind fsm.CurrentState
|> Option.bind (Map.tryFind e)
|> Option.bind (fun nextState -> Some (transitionTo nextState fsm))
|> function
| None -> fsm
| Some fsm' -> fsm'
let initFsm initState =
{
InitState = initState
CurrentState = initState
Transitions = Map.empty
Commands = Map.empty
CommandChannel = (fun _ -> ())
ResetEvents = []
}
let registerTransition currentState event nextState fsm =
match fsm.Transitions |> Map.tryFind currentState with
| None -> {fsm with Transitions = fsm.Transitions |> Map.add currentState (Map.empty |> Map.add event nextState)}
| Some m -> {fsm with Transitions = fsm.Transitions |> Map.add currentState (m |> Map.add event nextState)}
let registerCommand state command fsm =
match fsm.Commands |> Map.tryFind state with
| None -> {fsm with Commands = fsm.Commands |> Map.add state [command]}
| Some commands -> {fsm with Commands = fsm.Commands |> Map.add state (command::commands)}
let registerResetEvent event fsm = {fsm with ResetEvents = (event::fsm.ResetEvents)}
let registerCommandChannel f fsm = {fsm with CommandChannel = f}
type Event =
| DoorClosed
| DrawerOpened
| LightOn
| DoorOpened
| PanelClosed
type Command =
| UnlockPanel
| LockPanel
| LockDoor
| UnlockDoor
type State =
| Idle
| Active
| WaitingForLight
| WaitingForDrawer
| UnlockedPanel
open FSM
let fsm =
initFsm Idle
|> registerResetEvent DoorOpened
|> registerCommandChannel (printfn "Execute command: %A")
|> registerTransition Idle DoorClosed Active
|> registerTransition Active DrawerOpened WaitingForLight
|> registerTransition Active LightOn WaitingForDrawer
|> registerTransition WaitingForLight LightOn UnlockedPanel
|> registerTransition WaitingForDrawer DrawerOpened UnlockedPanel
|> registerTransition UnlockedPanel PanelClosed Idle
|> registerCommand Active UnlockDoor
|> registerCommand Active LockPanel
|> registerCommand UnlockedPanel UnlockPanel
|> registerCommand UnlockedPanel LockDoor
let (|+>) fsm f =
printfn "Current state: %A" fsm.CurrentState
f fsm
fsm
|+> handleEvent DrawerOpened
|+> handleEvent DoorClosed
|+> handleEvent DrawerOpened
|+> handleEvent LightOn
|+> handleEvent LightOn
|+> handleEvent PanelClosed
|+> handleEvent DoorClosed
|+> handleEvent DoorOpened
|+> handleEvent DoorClosed
|+> handleEvent LightOn
|+> (printfn "Result: %A")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment