Skip to content

Instantly share code, notes, and snippets.

@mikesorae
Created December 26, 2018 17:07
Show Gist options
  • Save mikesorae/9a3106077872f5ca7ce5815e2a25dd7b to your computer and use it in GitHub Desktop.
Save mikesorae/9a3106077872f5ca7ce5815e2a25dd7b to your computer and use it in GitHub Desktop.
Ring Bell in Haskell (no jummed, not override monad operators)
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# language RankNTypes #-}
data DoorState = DoorClosed | DoorOpen
deriving Show
data DoorCmd before end a where
Open :: DoorCmd DoorClosed DoorOpen ()
Close :: DoorCmd DoorOpen DoorClosed ()
Ring :: DoorCmd DoorClosed DoorClosed ()
Pure :: a -> DoorCmd s1 s2 a
Bind :: DoorCmd s1 s2 a -> (forall a. a -> DoorCmd s2 s3 b) -> DoorCmd s1 s3 b
run :: DoorCmd before after a -> IO DoorState
run Ring = do
putStrLn "Ring Ring"
return DoorClosed
run Open = do
putStrLn "Open"
return DoorOpen
run Close = do
putStrLn "Close"
return DoorClosed
run (Bind cmd nextFn) = do
nextState <- run cmd
run (nextFn nextState)
doorProg :: DoorCmd DoorClosed DoorClosed ()
doorProg = Bind (Bind Ring (\_ -> Open)) (\_ -> Close)
main :: IO ()
main = do
run doorProg
putStrLn "Finished"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment