SkeletonEnvironment.hs

module Main where

import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import System.Exit

import RL_Glue.Environment
import RL_Glue.Network

main = loadEnvironment (Environment onInit onStart onStep onCleanup onMsg) 10

onInit :: StateT Int IO BS.ByteString
onInit = 
  lift $ return $ BSC.pack "VERSION RL-Glue-3.0 PROBLEMTYPE episodic DISCOUNTFACTOR 1.0 OBSERVATIONS INTS (0 20)  ACTIONS INTS (0 1)  REWARDS (-1.0 1.0)  EXTRA skeleton_environment(Haskell) by Richard Hofer."

onStart :: StateT Int IO Observation
onStart = do
  put 10
  return (Observation (RLAbstractType [10] [] BS.empty))

onStep :: Action -> StateT Int IO (Terminal, Reward, Observation)
onStep (Action (RLAbstractType (dir:_) _ _)) = do
  case dir of
    0 -> modify (subtract 1)
    1 -> modify (+1)
    _ -> lift $ do
      putStrLn "Error: non-binary direction received"
      exitWith (ExitFailure 1)
  state <- get
  handleState state
  where
    handleState x
      | x <= 0 = do
        put 0
        return (1, -1, Observation (RLAbstractType [0] [] BS.empty))
      | x >= 20 = do
        put 20
        return (1, 1, Observation (RLAbstractType [20] [] BS.empty))
      | otherwise = return (0, 0, Observation (RLAbstractType [x] [] BS.empty))

onCleanup :: StateT Int IO ()
onCleanup = return ()

onMsg :: BS.ByteString -> StateT Int IO BS.ByteString
onMsg msg =
  return $ BSC.pack $ if msg == BSC.pack "what is your name?"
    then "my name is skeleton_environment, Haskell edition!"
    else "I don't know how to respond to your message"