Skip to content

Instantly share code, notes, and snippets.

@danielwaterworth
Created December 21, 2011 18:30
Show Gist options
  • Save danielwaterworth/1507107 to your computer and use it in GitHub Desktop.
Save danielwaterworth/1507107 to your computer and use it in GitHub Desktop.
State Machine Library
{-# LANGUAGE GADTs #-}
module StateMachine where
-- A library for managing complexity of state machines by making them composable, feel free to contribute/steal
data StateMachine state where
Simple :: (state -> state -> Bool) -> StateMachine state
OrMachine :: StateMachine a -> StateMachine b -> (a -> b -> Bool) -> (b -> a -> Bool) -> StateMachine (Either a b)
AndMachine :: StateMachine a -> StateMachine b -> StateMachine (a, b)
canTransition :: StateMachine state -> state -> state -> Bool
canTransition (Simple fn) a b = fn a b
canTransition (OrMachine s _ _ _) (Left a) (Left b) = canTransition s a b
canTransition (OrMachine _ s _ _) (Right a) (Right b) = canTransition s a b
canTransition (OrMachine _ _ fn _) (Left a) (Right b) = fn a b
canTransition (OrMachine _ _ _ fn) (Right a) (Left b) = fn a b
canTransition (AndMachine p q) (pa,qa) (pb,qb) = canTransition p pa pb && canTransition q qa qb
-- examples
-- this is a counter state machine, it only allows transitions that cause the value to increase by one
counter = Simple (\a b -> b == a + 1)
-- A simple connection state machine
data ConnectionState =
Closed |
Opening |
Open
connection = Simple (\a b -> case (a, b) of
(Closed, Opening) -> True
(Opening, Closed) -> True
(Opening, Open) -> True
(Open, Closed) -> True
_ -> False)
-- of course, you may want to compose state machines, a simple example is where you want a global clock to another machine
clockedConnection = AndMachine counter connection
-- or you may want to enhance a machine by adding more states
data ConnectionStateExtension =
Inactive
connectionExtension = Simple (\a b -> False)
extendedMachine = OrMachine connection connectionExtension
(\a b -> case (a, b) of
(Open, Inactive) -> True
_ -> False)
(\b a -> case (b, a) of
(Inactive, Closed) -> True
_ -> False)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment