LightBulb.hs

module LightBulb
    ( LightBulb
    , newLightBulb
    , switchOn
    , switchOff
    ) where

import Control.Concurrent (Chan, newChan, readChan, writeChan)
import Control.Concurrent.Async (async)
import Control.Monad.Loops (iterateM_)

newLightBulb :: IO LightBulb
newLightBulb = do
    c <- newChan
    _ <- async $ iterateM_ (loop c) initialState
    return $ LightBulb c

switchOn :: LightBulb -> IO ()
switchOn = sendCommand SwitchOn

switchOff :: LightBulb -> IO ()
switchOff = sendCommand SwitchOff

newtype LightBulb = LightBulb (Chan Command)

data Command
    = SwitchOn
    | SwitchOff
    deriving (Show)

data Event
    = SwitchedOn
    | SwitchedOff
    | Broke
    deriving (Eq, Show)

data Bulb
    = Bulb { on :: Bool, remaining :: Int }
    deriving (Show)

data State
    = Working Bulb
    | Broken
    deriving (Show)

sendCommand :: Command -> LightBulb -> IO ()
sendCommand cmd (LightBulb chan) = writeChan chan cmd

loop :: Chan Command -> State -> IO State
loop chan state = do
    command <- readChan chan
    let events = decide command state
    let newState = foldl evolve state events
    print newState
    return newState

initialState :: State
initialState = Working Bulb{ on = False, remaining = 2 }

decide :: Command -> State -> [Event]
decide SwitchOn  (Working Bulb{on=False, remaining=0}) = [Broke]
decide SwitchOn  (Working Bulb{on=False             }) = [SwitchedOn]
decide SwitchOn  (Working Bulb{on=True              }) = []
decide SwitchOff (Working Bulb{on=True              }) = [SwitchedOff]
decide SwitchOff (Working Bulb{on=False             }) = []
decide _         Broken                                = []

evolve :: State -> Event -> State
evolve _                                          Broke       = Broken
evolve (Working      Bulb{on=False, remaining=r}) SwitchedOn  = Working Bulb {on=True, remaining = r - 1}
evolve (Working bulb@Bulb{on=True              }) SwitchedOff = Working (bulb {on=False})
evolve (Working bulb                            ) _           = Working bulb
evolve Broken                                     _           = Broken