module Test.Robot.Internal
(
Robot(..)
, runRobot
, runRobotWith
, connect
, mkRobot
, mkRobot'
, keyboard
, button
, motion
) where
import Control.Applicative
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Map (Map)
import qualified Data.Map as M
import Graphics.XHB hiding (connect)
import qualified Graphics.XHB as X
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, MonadCatch, MonadMask, MonadThrow)
runRobot :: Robot a -> IO a
runRobot m = do
c <- connect
runRobotWith c m
runRobotWith :: Connection -> Robot a -> IO a
runRobotWith c (Robot m) = do
keymap <- X.getKeysymMap c
runReaderT m (c, keymap)
connect :: IO Connection
connect = do
Just c <- X.connect
return c
mkRobot :: ((Connection, Map KEYSYM KEYCODE) -> IO a) -> Robot a
mkRobot = Robot . ReaderT
mkRobot' :: (Connection -> IO a) -> Robot a
mkRobot' = mkRobot . (. fst)
keyboard :: Bool -> Key -> Robot ()
keyboard press key = mkRobot $ \(c, keymap) -> do
case M.lookup (rawKey key) keymap of
Nothing -> error $ "keysym " ++ show (rawKey key)
++ " does not exist on keyboard layout"
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 = narrow . widen
widen :: Integral a => a -> Integer
widen = fromIntegral
narrow :: (Integral b, Bounded b) => Integer -> b
narrow x = result
where
result
| x < fromIntegral (minBound `asTypeOf` result) = minBound
| x > fromIntegral (maxBound `asTypeOf` result) = maxBound
| otherwise = fromIntegral x