module Test.Robot.Internal
(
Robot(..)
, runRobot
, runRobotWithConnection
, mkRobot
, mkRobot'
, bracketRobot_
, keyboard
, button
, motion
, releaseAll
) where
import Control.Applicative
import Control.Exception (bracket_, finally)
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Map (Map)
import qualified Data.Map as M
import Graphics.XHB
import qualified Test.Robot.Internal.XTest as X
import Test.Robot.Types
newtype Robot a = Robot { unRobot :: ReaderT (Connection, Map KEYSYM KEYCODE) IO a }
deriving (Functor, Applicative, Monad, MonadIO)
runRobot :: Robot a -> IO a
runRobot m = do
Just c <- connect
runRobotWithConnection m c
runRobotWithConnection :: Robot a -> Connection -> IO a
runRobotWithConnection (Robot m) c = do
keymap <- X.getKeysymMap c
runReaderT m (c, keymap) `finally` X.releaseAll c
mkRobot :: ((Connection, Map KEYSYM KEYCODE) -> IO a) -> Robot a
mkRobot = Robot . ReaderT
mkRobot' :: (Connection -> IO a) -> Robot a
mkRobot' = mkRobot . (. fst)
bracketRobot_ :: Robot a -> Robot z -> Robot r -> Robot r
bracketRobot_ (Robot before) (Robot after) (Robot middle)
= mkRobot $ \env -> let run = flip runReaderT env
in bracket_ (run before) (run after) (run middle)
keyboard :: Bool -> Key -> Robot ()
keyboard press key = mkRobot $ \(c, keymap) -> do
case M.lookup (rawKey key) keymap of
Nothing -> error $ "Unknown keysym: " ++ show (rawKey key)
Just keycode -> X.keyboard c press keycode
button :: Bool -> Button -> Robot ()
button press butt = mkRobot' $ \c ->
X.button c press (rawButton butt)
motion :: Bool -> Int -> Int -> Robot ()
motion press x y = mkRobot' $ \c ->
X.motion c press (clipIntegral x, clipIntegral y)
clipIntegral :: (Integral a, Integral b, Ord a, Bounded b) => a -> b
clipIntegral x = result
where
result
| x < fromIntegral (minBound `asTypeOf` result) = minBound
| x > fromIntegral (maxBound `asTypeOf` result) = maxBound
| otherwise = fromIntegral x
releaseAll :: Robot ()
releaseAll = mkRobot' $ \c -> X.releaseAll c