{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} {-| -} module Workflow.Derived where import Workflow.Derived.Extra import Workflow.Core import Control.Monad.Trans.Free (intersperseT) -- import Control.Monad.Free import Control.Monad.Catch (MonadThrow) import qualified Data.ByteString.Char8 as BS import Network.HTTP.Types.URI (renderQuery) import Control.Concurrent (threadDelay) import Control.Monad.IO.Class import Numeric.Natural import Data.Function ((&)) -------------------------------------------------------------------------------- chord = sendKeyChord -- | access the currently selected region from Haskell, -- by copying to the clipboard, via the default keyboard shortcut. -- ('wait's 30ms) copy :: (MonadWorkflow m) => m String -- copy t :: (MonadWorkflow m) => Natural -> m String copy = do chord [HyperModifier] CKey --TODO press "H-c" delay 30 -- one "frame". TODO how long does it need to wait? getClipboard -- ((->) Natural)? Reader? Cont? -- | paste via the default keyboard shortcut. paste :: (MonadWorkflow m) => m () paste = do chord [HyperModifier] VKey --TODO press "H-v" -- | zoomInByKeyboard = chord [HyperModifier] EqualKey -- | zoomOutByKeyboard = chord [HyperModifier] MinusKey -------------------------------------------------------------------------------- insert = sendText -- | \"paste\" by directly inserting the current clipboard contents. paste' :: (MonadWorkflow m) => m () paste' = do getClipboard >>= insert -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- click :: (MonadWorkflow m) => [Modifier] -> Natural -> MouseButton -> m () click = sendMouseClick --click = sendMouseClick [] 1 LeftButton {- Click = sendMouseClick [] Button -} leftClick = sendMouseClick [] 1 LeftButton middleClick = sendMouseClick [] 1 MiddleButton rightClick = sendMouseClick [] 1 RightButton doubleClick = sendMouseClick [] 2 LeftButton tripleClick = sendMouseClick [] 3 LeftButton controlClick = sendMouseClick [ControlModifier] 1 LeftButton shiftClick = sendMouseClick [ShiftModifier] 1 LeftButton -------------------------------------------------------------------------------- scroll = sendMouseScroll ticks = (*120) -- | scroll one "tick" of the wheel. scrollOnce wheel = scroll [] wheel (1&ticks) -- TODO windows only? -- | zoomInByMouse = scroll [ControlModifier] ScrollTowards (1&ticks) -- | zoomOutByMouse = scroll [ControlModifier] ScrollAway (1&ticks) flingAway = scroll [] ScrollAway (10&ticks) -------------------------------------------------------------------------------- wait :: (MonadWorkflow m, Integral a) => a -> m () wait = delay . fromIntegral -------------------------------------------------------------------------------- -- | google a query. properly encodes the url. google :: (MonadWorkflow m) => String -> m () google (BS.pack -> query) = openURL (BS.unpack url) where url = domain <> parameters domain = "https://www.google.com/search" parameters = renderQuery True [("q", Just query)] -------------------------------------------------------------------------------- {-| intersperse a delay between each action. @ delayWorkflowT 1 $ do sendKeyChord [CommandModifier] VKey s <- getClipboard sendText s @ is equivalent to: @ do sendKeyChord [CommandModifier] VKey delay 1 s <- getClipboard delay 1 sendText s @ -} delayWorkflowT :: (Monad m) => Int -> WorkflowT m a -> WorkflowT m a delayWorkflowT t = intersperseT (Delay t ()) sendTextEach :: (MonadWorkflow m) => Int -> String -> m () -- sendText :: (MonadIO m) => (Monad m m) => String -> m () sendTextEach t s = sequence_ . intersperse (delay t) . fmap sendText . fmap (:[]) $ s -------------------------------------------------------------------------------- {- the keychord that would insert the number (integral/decimal) into the application. >>> digit2keychord 0 :: Maybe KeyChord Just ([], ZeroKey) >>> digit2keychord 10 :: Maybe KeyChord Nothing -} digit2keychord :: (MonadThrow m, Num i, Eq i, Show i) => i -> m KeyChord digit2keychord d = case d of 0 -> return $ SimpleKeyChord ZeroKey 1 -> return $ SimpleKeyChord OneKey 2 -> return $ SimpleKeyChord TwoKey 3 -> return $ SimpleKeyChord ThreeKey 4 -> return $ SimpleKeyChord FourKey 5 -> return $ SimpleKeyChord FiveKey 6 -> return $ SimpleKeyChord SixKey 7 -> return $ SimpleKeyChord SevenKey 8 -> return $ SimpleKeyChord EightKey 9 -> return $ SimpleKeyChord NineKey _ -> failed $ "{{ digit2keychord "++(show d)++" }} not a single-digit decimal number" --------------------------------------------------------------------------------