Skip to content

Instantly share code, notes, and snippets.

@petermarks
Created December 16, 2012 12:21
Show Gist options
  • Save petermarks/4306744 to your computer and use it in GitHub Desktop.
Save petermarks/4306744 to your computer and use it in GitHub Desktop.
Sketch of Bot interface
module Bot where
import Control.Monad.Reader
import Control.Monad.Cont
import Data.List
data Command
= NoAction
| Fire
| Accelerate
deriving Show
-- | This is the dashboard of readings, ie. the bots view.
-- The bot is provided a new set of readings every step.
data DashBoard = DashBoard { velocity :: Double } -- TODO this just has a dummy value for now
-- | Given a DashBoard, an Automaton emits a command and a new Automaton.
type Automaton = Reader DashBoard Step
data Step = Step { stepCmd :: Command, stepNext :: Automaton}
-- | Run an Automaton to the next command
step :: DashBoard -> Automaton -> Step
step db a = runReader a db
-- | A Bot is a program for a bot. It is written in an imperative style
-- and is transformed into an Automoton for stepped execution.
type Bot = ContT Step (Reader DashBoard)
yield :: Command -> Bot ()
yield cmd = ContT $ \c -> return $ Step cmd (c ())
fire :: Bot ()
fire = yield Fire
accelerate :: Bot ()
accelerate = yield Accelerate
-- | Start a Bot, transforming it into an Automaton
start :: Bot a -> Automaton
start bot = runContT bot $ const . fix $ return . Step NoAction
----------------------------------------------------------------------
-- TODO For now we use the dashboard to keep the state of the bot, but
-- this should be separated with the dashboard just being a view.
initDashBoard :: DashBoard
initDashBoard = DashBoard 0
execCommand :: Command -> DashBoard -> DashBoard
execCommand Fire = id -- Ignored for now
execCommand NoAction = id -- Do nothing
execCommand Accelerate = \d -> d{velocity = velocity d + 1}
bot :: Bot ()
bot = forever $ do
fire
v <- asks velocity
when (v < 10) accelerate
test = take 30 $ unfoldr runStep (start bot, initDashBoard)
runStep (aut, dash) = Just (cmd, (aut', dash'))
where
Step cmd aut' = step dash aut
dash' = execCommand cmd dash
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment