module AutoGUI.MessageBoxes
  ( alert
  , confirm
  , password
  , prompt
  )
where

import AutoGUI.Call
import CPython.Simple
import Control.Monad
import Control.Monad.IO.Class
import Data.Text (Text)
import qualified Data.Text as T

-- | Show a box onscreen until dismissed
alert :: Text -> IO ()
alert :: Text -> IO ()
alert Text
msg = Text -> [Arg] -> [(Text, Arg)] -> IO ()
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"alert" [Text -> Arg
forall a. ToPy a => a -> Arg
arg Text
msg] []

-- | Show a box onscreen until a user hits OK or Cancel
--   Return True on OK, False on Cancel, and False if user closes the box
confirm :: Text -> IO Bool
confirm :: Text -> IO Bool
confirm Text
msg = do
  Text
okOrCancel :: Text <- Text -> [Arg] -> [(Text, Arg)] -> IO Text
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"confirm" [Text -> Arg
forall a. ToPy a => a -> Arg
arg Text
msg] []
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text
okOrCancel Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"OK"

-- | Show a box onscreen, allowing user to enter some screened text
--   Return empty string if user closes the box
password :: Text -> IO Text
password :: Text -> IO Text
password Text
msg = Text -> Text -> IO Text
textInput Text
"password" Text
msg

-- | Show a box onscreen, allowing user to enter some text
--   Return empty string if user closes the box
prompt :: Text -> IO Text
prompt :: Text -> IO Text
prompt Text
msg = Text -> Text -> IO Text
textInput Text
"prompt" Text
msg

textInput :: Text -> Text -> IO Text
textInput :: Text -> Text -> IO Text
textInput Text
func Text
msg = do
  Maybe Text
pyPrompt :: Maybe Text <- Text -> [Arg] -> [(Text, Arg)] -> IO (Maybe Text)
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
func [Text -> Arg
forall a. ToPy a => a -> Arg
arg Text
msg] []
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ case Maybe Text
pyPrompt of
    Just Text
promptText -> Text
promptText
    Maybe Text
Nothing -> Text
""