{-# LANGUAGE TypeApplications #-}

module AutoGUI.Mouse
  ( MouseButton(..)
  , moveTo
  , moveToDuration
  , moveRel
  , moveRelDuration
  , click
  , leftClick
  , doubleClick
  , tripleClick
  , rightClick
  , middleClick
  , moveAndClick
  , drag
  , dragDuration
  , dragTo
  , dragToDuration
  , dragRel
  , dragRelDuration
  , scroll
  , mouseDown
  , mouseUp
  )
where

import AutoGUI.Call
import CPython.Simple
import CPython.Simple.Instances
import Data.Text

data MouseButton
  = LeftMouseButton
  | RightMouseButton
  | MiddleMouseButton

-- TODO: try to make this as easy/automatic as possible
instance ToPy MouseButton where
  toPy :: MouseButton -> IO SomeObject
toPy MouseButton
LeftMouseButton   = Text -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy @Text Text
"left"
  toPy MouseButton
RightMouseButton  = Text -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy @Text Text
"right"
  toPy MouseButton
MiddleMouseButton = Text -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy @Text Text
"middle"

-- | Move the mouse to an (x, y) position
moveTo :: Integer -> Integer -> IO ()
moveTo :: Integer -> Integer -> IO ()
moveTo Integer
x Integer
y = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"moveTo" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y] []

-- | Move the mouse to an (x, y) position, over a number of seconds
moveToDuration :: Integer -> Integer -> Double -> IO ()
moveToDuration :: Integer -> Integer -> Double -> IO ()
moveToDuration Integer
x Integer
y Double
duration =
  Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"moveTo" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y] [(Text
"duration", Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
duration)]

-- | Move the mouse relative to where it is now
moveRel :: Integer -> Integer -> IO ()
moveRel :: Integer -> Integer -> IO ()
moveRel Integer
xOffset Integer
yOffset =
  Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"moveRel" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
xOffset, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
yOffset] []

-- | Move the mouse relative to where it is now, over a number of seconds
moveRelDuration :: Integer -> Integer -> Double -> IO ()
moveRelDuration :: Integer -> Integer -> Double -> IO ()
moveRelDuration Integer
xOffset Integer
yOffset Double
duration =
  Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"moveRel" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
xOffset, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
yOffset, Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
duration] []

-- | Click a specified mouse button
click :: MouseButton -> IO ()
click :: MouseButton -> IO ()
click MouseButton
button = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"click" [] [(Text
"button", MouseButton -> Arg
forall a. ToPy a => a -> Arg
arg MouseButton
button)]

-- | Double click the mouse
doubleClick :: IO ()
doubleClick :: IO ()
doubleClick = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"doubleClick" [] []

-- | Triple click the mouse
tripleClick :: IO ()
tripleClick :: IO ()
tripleClick = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"tripleClick" [] []

-- | Left click the mouse
leftClick :: IO ()
leftClick :: IO ()
leftClick = MouseButton -> IO ()
click MouseButton
LeftMouseButton

-- | Right click the mouse
rightClick :: IO ()
rightClick :: IO ()
rightClick = MouseButton -> IO ()
click MouseButton
RightMouseButton

-- | Middle click the mouse
middleClick :: IO ()
middleClick :: IO ()
middleClick = MouseButton -> IO ()
click MouseButton
MiddleMouseButton

-- | Move the mouse to some (x, y) position and click there
moveAndClick :: Integer -> Integer -> IO ()
moveAndClick :: Integer -> Integer -> IO ()
moveAndClick Integer
x Integer
y = Integer -> Integer -> IO ()
moveTo Integer
x Integer
y IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MouseButton -> IO ()
click MouseButton
LeftMouseButton

-- | Clicks and drags the mouse through a motion of (x, y)
drag :: Integer -> Integer -> IO ()
drag :: Integer -> Integer -> IO ()
drag Integer
x Integer
y = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"drag" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y] []

-- | Clicks and drags the mouse through a motion of (x, y), over a number of seconds
dragDuration :: Integer -> Integer -> Double -> IO ()
dragDuration :: Integer -> Integer -> Double -> IO ()
dragDuration Integer
x Integer
y Double
duration = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"drag" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y, Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
duration] []

-- | Clicks and drags the mouse to the position (x, y)
dragTo :: Integer -> Integer -> IO ()
dragTo :: Integer -> Integer -> IO ()
dragTo Integer
x Integer
y = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"dragTo" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y] []

-- | Clicks and drags the mouse to the position (x, y), over a number of seconds
dragToDuration :: Integer -> Integer -> Double -> IO ()
dragToDuration :: Integer -> Integer -> Double -> IO ()
dragToDuration Integer
x Integer
y Double
duration = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"dragTo" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y, Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
duration] []

-- | Clicks and drags the mouse through a motion of (x, y)
dragRel :: Integer -> Integer -> IO ()
dragRel :: Integer -> Integer -> IO ()
dragRel Integer
xOffset Integer
yOffset = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"dragRel" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
xOffset, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
yOffset] []

-- | Clicks and drags the mouse through a motion of (x, y)
dragRelDuration :: Integer -> Integer -> Double -> IO ()
dragRelDuration :: Integer -> Integer -> Double -> IO ()
dragRelDuration Integer
xOffset Integer
yOffset Double
duration =
  Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"dragRel" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
xOffset, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
yOffset, Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
duration] []

-- | Scroll up (positive) or down (negative)
scroll :: Integer -> IO ()
scroll :: Integer -> IO ()
scroll Integer
amount = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"scroll" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
amount] []

-- | Press the left mouse button down
mouseDown :: IO ()
mouseDown :: IO ()
mouseDown = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"mouseDown" [] []

-- | Release the left mouse button
mouseUp :: IO ()
mouseUp :: IO ()
mouseUp = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"mouseUp" [] []

-- | Press a specified mouse button
mouseButtonDown :: MouseButton -> IO ()
mouseButtonDown :: MouseButton -> IO ()
mouseButtonDown MouseButton
button = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"mouseDown" [] [(Text
"button", MouseButton -> Arg
forall a. ToPy a => a -> Arg
arg MouseButton
button)]

-- | Press a specified mouse button
mouseButtonUp :: MouseButton -> IO ()
mouseButtonUp :: MouseButton -> IO ()
mouseButtonUp MouseButton
button = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"mouseUp" [] [(Text
"button", MouseButton -> Arg
forall a. ToPy a => a -> Arg
arg MouseButton
button)]