packages feed

workflow-windows (empty) → 0.0.0

raw patch · 18 files changed

+2102/−0 lines, 18 filesdep +QuickCheckdep +StateVardep +basesetup-changed

Dependencies added: QuickCheck, StateVar, base, c-storable-deriving, doctest, free, hspec, transformers, workflow-types, workflow-windows

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Spiros Boosalis (c) 2015
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Spiros Boosalis nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple
+main = defaultMain
+
+ executables/Main.hs view
@@ -0,0 +1,5 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+import qualified Workflow.Windows.Example
+
+-- stack build && stack exec workflow-windows
+main = Workflow.Windows.Example.main
+ native/Workflow.c view
@@ -0,0 +1,192 @@+#define _UNICODE
+#define UNICODE
+
+// package
+#include "Workflow.h"
+
+// windows
+#include <windows.h>
+
+// C
+#include <string.h>
+
+
+LPCTSTR GetClipboard()
+{
+	LPCTSTR _contents;
+	OpenClipboard(0);
+
+	if (IsClipboardFormatAvailable(CF_UNICODETEXT)) {
+		HGLOBAL hMem = GetClipboardData(CF_UNICODETEXT);  // TODO CF_UNICODETEXT
+		_contents = (LPCTSTR)GlobalLock(hMem); // lpctstr or lpcwstr?
+		GlobalUnlock(hMem);
+	}
+	else if (IsClipboardFormatAvailable(CF_TEXT)) {
+		// or ascii, and convert to widechar
+		_contents = TEXT("");
+	}
+	else
+	{
+		_contents = TEXT("");
+	}
+
+	CloseClipboard();
+	return _contents;
+}
+
+void SetClipboard(LPCTSTR output) {
+	const size_t len = (lstrlen(output) + 1) * sizeof(wchar_t); // was halving
+	HGLOBAL hMem = GlobalAlloc(GMEM_MOVEABLE, len);
+	memcpy(GlobalLock(hMem), output, len);
+	GlobalUnlock(hMem);
+	OpenClipboard(0);
+	EmptyClipboard();
+	SetClipboardData(CF_UNICODETEXT, hMem);
+	CloseClipboard();
+}
+
+UINT SendUnicodeChar(const wchar_t c) {
+	UINT successes = 0;
+
+	INPUT i;
+	i.type = INPUT_KEYBOARD;
+	i.ki.time = 0;
+	i.ki.dwExtraInfo = 0;
+	i.ki.wVk = 0;
+
+	i.ki.dwFlags = KEYEVENTF_UNICODE; // Specify the key as a unicode character
+	i.ki.wScan = c; //
+	successes += SendInput(1, &i, sizeof(INPUT));
+
+	return successes;
+}
+
+/*
+
+*/
+UINT PressKeyDown(WORD key) {
+	INPUT i;
+	i.type = INPUT_KEYBOARD;
+	i.ki.wScan = 0;
+	i.ki.time = 0;
+	i.ki.dwExtraInfo = 0;
+
+	i.ki.wVk = key;
+	i.ki.dwFlags = KEYEVENTF_KEYDOWN;
+	return SendInput(1, &i, sizeof(INPUT));
+}
+
+/*
+
+*/
+UINT PressKeyUp(WORD key) {
+	INPUT i;
+	i.type = INPUT_KEYBOARD;
+	i.ki.wScan = 0;
+	i.ki.time = 0;
+	i.ki.dwExtraInfo = 0;
+
+	i.ki.wVk = key;
+	i.ki.dwFlags = KEYEVENTF_KEYUP;
+	return SendInput(1, &i, sizeof(INPUT));
+}
+
+UINT ClickMouseAt(int x, int y, int n, DWORD buttonDown, DWORD buttonUp) {
+	UINT successes = 0;
+
+		//TODO? SendMessage(NULL, BM_CLICK, 0, 0);
+
+	const double XSCALEFACTOR = 65535 / (GetSystemMetrics(SM_CXSCREEN) - 1);
+	const double YSCALEFACTOR = 65535 / (GetSystemMetrics(SM_CYSCREEN) - 1);
+
+	POINT cursorPos;
+	GetCursorPos(&cursorPos);
+
+	double cx = cursorPos.x * XSCALEFACTOR;
+	double cy = cursorPos.y * YSCALEFACTOR;
+
+	//TODO why SCALEFACTOR?
+	double nx = x * XSCALEFACTOR;
+	double ny = y * YSCALEFACTOR;
+
+	INPUT i = { 0 };
+	i.type = INPUT_MOUSE;
+
+	i.mi.dx = (LONG)nx;
+	i.mi.dy = (LONG)ny;
+
+	i.mi.dwFlags = MOUSEEVENTF_MOVE | MOUSEEVENTF_ABSOLUTE | buttonDown | buttonUp;
+
+	// click mouse down and then up
+	for (int j = 0; j < n; j++) {
+		successes += SendInput(1, &i, sizeof(INPUT));
+	}
+
+	i.mi.dx = (LONG)cx;
+	i.mi.dy = (LONG)cy;
+
+	i.mi.dwFlags = MOUSEEVENTF_MOVE | MOUSEEVENTF_ABSOLUTE;
+
+	// move mouse back
+	successes += SendInput(1, &i, sizeof(INPUT));
+
+	return successes;
+}
+
+/*
+
+wheel is {MOUSEEVENTF_WHEEL, MOUSEEVENTF_HWHEEL}
+
+direction is {+1, -1} i.e. {forwards, backwards} i.e. {towards you, away from you}
+
+*/
+UINT ScrollMouseWheel(DWORD wheel, DWORD direction, DWORD distance) {
+	// mouse_event(MOUSEEVENTF_WHEEL, 0, 0, direction * distance, 0);
+
+	INPUT i;
+	i.type = INPUT_MOUSE;
+	i.mi.dx = 0;
+	i.mi.dy = 0;
+	i.mi.time = 0; // otherwise monitor falls asleep, because the last mouse event is said to be some large number (garbage memory).
+	i.mi.dwExtraInfo = 0;
+
+	i.mi.dwFlags = wheel; // MOUSEEVENTF_MOVE | MOUSEEVENTF_ABSOLUTE
+	i.mi.mouseData = direction * distance;
+
+	return SendInput(1, &i, sizeof(INPUT));
+}
+
+/*
+
+uses the PATH?
+
+*/
+HINSTANCE OpenApplication(LPCTSTR app) {
+	return ShellExecute(NULL, L"open", app, NULL, NULL, SW_SHOW);
+}
+
+HINSTANCE OpenUrl(LPCTSTR url) {
+	return ShellExecute(NULL, L"open", url, NULL, NULL, SW_SHOWNORMAL);
+}
+
+
+BOOL EnableDebugPriv()
+{
+	HANDLE hToken;
+	LUID luid;
+	TOKEN_PRIVILEGES tkp;
+
+	OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY, &hToken);
+
+	LookupPrivilegeValue(NULL, SE_DEBUG_NAME, &luid);
+
+	tkp.PrivilegeCount = 1;
+	tkp.Privileges[0].Luid = luid;
+	tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
+
+	BOOL wasAdjsuted = AdjustTokenPrivileges(hToken, 0, &tkp, sizeof(tkp), NULL, NULL); // ""'false' undeclared"
+
+	CloseHandle(hToken);
+
+	return wasAdjsuted;
+}
+ native/Workflow.h view
@@ -0,0 +1,19 @@+#include <windows.h>
+#include <string.h>
+
+WORD KEYEVENTF_KEYDOWN = 0;
+
+LPCTSTR GetClipboard();
+void    SetClipboard(LPCTSTR);
+
+UINT SendUnicodeChar(const wchar_t);
+
+UINT PressKeyDown(WORD);
+UINT PressKeyUp(WORD);
+
+UINT ClickMouseAt(int x, int y, int n, DWORD buttonDown, DWORD buttonUp);
+
+HINSTANCE OpenApplication(LPCTSTR);
+HINSTANCE OpenUrl(LPCTSTR);
+
+BOOL EnableDebugPriv();
+ sources/Workflow/Windows.hs view
@@ -0,0 +1,30 @@+{-| Automate keyboard\/mouse\/clipboard\/application interaction.
+
+-}
+module Workflow.Windows
+ (
+   -- |  WinAPI types
+   module Workflow.Windows.Types
+
+   -- | Low-level, C Foreign functions
+ , module Workflow.Windows.Foreign
+
+   -- | Medium-level, direct Haskell bindigs
+ , module Workflow.Windows.Bindings
+
+   -- | Higher-level bindings, for the platform-agnostic @workflow@ package.
+ , module Workflow.Windows.Execute
+
+  -- | Pattern synonyms
+ , module Workflow.Windows.Constants
+
+ -- | @StateVar@s
+ , module Workflow.Windows.Variables
+
+ ) where
+import Workflow.Windows.Types
+import Workflow.Windows.Constants
+import Workflow.Windows.Foreign
+import Workflow.Windows.Bindings
+import Workflow.Windows.Execute
+import Workflow.Windows.Variables
+ sources/Workflow/Windows/Bindings.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE ViewPatterns, RecordWildCards #-}
+{-|
+
+medium-level bindings.
+
+(all derived in Haskell. TODO wat?)
+
+-}
+module Workflow.Windows.Bindings where
+import Workflow.Windows.Types
+import Workflow.Windows.Extra
+import Workflow.Windows.Foreign
+-- import Workflow.Windows.Constants
+
+import Foreign
+import Foreign.C
+-- import Foreign.C.String
+import Data.Char
+import Numeric.Natural
+import Control.Monad.IO.Class
+import Control.Exception (bracket,bracket_)
+
+
+{-
+::  -> IO ()
+ = c_
+
+foreign import CALLING_CONVENTmN unsafe "Workflow.h "
+ c_ ::  -> IO ()
+-}
+
+--------------------------------------------------------------------------------
+
+getClipboard :: (MonadIO m) => m String
+getClipboard = liftIO $ c_GetClipboard >>= peekCWString
+
+setClipboard :: (MonadIO m) => String -> m ()
+setClipboard s = liftIO $ withCWString s c_SetClipboard
+
+
+--------------------------------------------------------------------------------
+
+{-| inserts some text into the current Application.
+
+char-by-char (one per event), no delay (between events).
+
+@
+sendText = 'traverse_' 'sendChar'
+@
+
+-}
+sendText :: (MonadIO m) => String -> m ()
+sendText = traverse_ sendChar
+
+{-| like 'sendText', interspersing a delay (in milliseconds)
+
+-}
+sendTextDelaying :: (MonadIO m) => Int -> String -> m ()
+sendTextDelaying i = traverse_ (\c -> sendChar c >> delayMilliseconds i)
+
+sendChar :: (MonadIO m) => Char -> m ()
+sendChar c = liftIO $ do
+ _ <- c_SendUnicodeChar ((CWchar . fromIntegral . ord) c) -- cast doesn't overflow, there are ~1,000,000 chars.
+ return ()
+
+--------------------------------------------------------------------------------
+
+--TODO workflow-types holdingModifiers
+
+{- perform an action while holding down some keys (e.g. modifiers).
+
+via 'bracket_', the keys are released even when an exception is raised.
+
+-}
+holdingKeys :: [VK] -> IO () -> IO ()
+holdingKeys keys = bracket_
+ (pressKeyDown `traverse_` keys)
+ (pressKeyUp   `traverse_` keys)
+
+-- holdingKeys :: (MonadIO m) => [VK] -> m () -> m ()
+-- holdingKeys keys action = liftIO $ bracket_
+--  (pressKeyDown `traverse_` keys)
+--  (pressKeyUp   `traverse_` keys)
+--  action
+
+pressKeyChord :: (MonadIO m) => [VK] -> VK -> m () --TODO rn KeyChord
+pressKeyChord modifiers key = liftIO $ do
+  holdingKeys modifiers $ do
+      pressKeyDown key
+      pressKeyUp   key
+
+pressKey :: (MonadIO m) => VK -> m ()
+pressKey key = liftIO $ do
+ pressKeyDown key
+ pressKeyUp   key
+
+{-|
+
+milliseconds
+
+-}
+pressKeyDelaying :: (MonadIO m) => Int -> VK -> m ()
+pressKeyDelaying t key = do
+ liftIO $ pressKeyDown key
+ delayMilliseconds t -- TODO is threadDelay 0 like noop?
+ liftIO $ pressKeyUp   key
+
+pressKeyDown :: VK -> IO ()
+pressKeyDown = c_PressKeyDown . getVK
+
+pressKeyUp :: VK -> IO ()
+pressKeyUp = c_PressKeyUp . getVK
+
+--------------------------------------------------------------------------------
+
+--clickMouse :: Natural -> m ()
+
+-- data MouseMotion = MoveMouseRelatively Interval | MoveMouseAbsolutely POINT
+--moveMouse :: (MonadIO m) => MouseMotion -> m ()
+--moveMouse =
+
+-- absolute coordinates
+-- getMousePosition :: (MonadIO m) => m POINT
+
+-- getScreenSize :: (MonadIO m) => m RECT
+-- getClientSize :: (MonadIO m) => m RECT
+
+clickMouseAt :: (MonadIO m) => POINT -> Natural -> MOUSEEVENTF -> MOUSEEVENTF -> m ()
+clickMouseAt (POINT x y) times down up = liftIO $
+ c_ClickMouseAt (toInt x) (toInt y) (toInt times) (getMOUSEEVENTF down) (getMOUSEEVENTF up)
+
+-- type IO' a = (MonadIO m) => m a
+
+{-|
+
+distance: 120 units is about one "tick" of the wheel
+(i.e. a few dozen nudges the screen).
+
+input:
+
+* 'True' is towards
+* 'False' is away
+
+-}
+scrollMouse :: (MonadIO m) => MOUSEEVENTF -> DWORD -> Natural -> m ()
+scrollMouse wheel direction distance = liftIO $ c_ScrollMouseWheel
+ (wheel & getMOUSEEVENTF)
+ direction -- (if direction then 1 else -1) -- seems to work, even though Word's are unsigned.
+ (distance & toDWORD)
+
+--GetCursorPos
+
+-- MOUSEEVENTF_MOVE .|. MOUSEEVENTF_ABSOLUTE .|. buttonDown .|. buttonUp
+-- foldl (.|.) [MOUSEEVENTF_MOVE, MOUSEEVENTF_ABSOLUTE, buttonDown, buttonUp]
+
+--------------------------------------------------------------------------------
+
+currentApplication :: (MonadIO m) => m Application
+currentApplication = Application <$> todo
+
+{-|
+TODO windows "apps"
+launchApplication :: String -> m ()
+launchApplication s = withCWString s c_LaunchApplication
+-}
+
+openApplication :: (MonadIO m) => Application -> m () -- launchApplication?
+openApplication (Application s) = liftIO $ withCWString s c_OpenApplication
+
+openUrl :: (MonadIO m) => URL -> m () -- visitURL?
+openUrl (URL s) = liftIO $ withCWString s c_OpenUrl
+
+------------------------------------------------------------------------
+
+{-|
+
+-}
+getCursorPosition :: (MonadIO m) => m POINT
+getCursorPosition = liftIO $ getByReference c_GetCursorPos
+{-|
+
+(doesn't trigger @RSIGuard@'s @AutoClick@).
+
+-}
+setCursorPosition :: (MonadIO m) => POINT -> m ()
+setCursorPosition (POINT x y) = liftIO $ do
+  c_SetCursorPos (CInt x) (CInt y)
+
+-------------------------------------------------------------------------
+
+findWindow :: (MonadIO m) => Window -> m HWND
+findWindow Window{..} = liftIO $ do
+  withCWString windowClass $ \_windowClass -> do -- ContT IO?
+    withCWString windowTitle $ \_windowTitle -> do
+        HWND <$> c_FindWindow _windowClass _windowTitle --TODO _windowExecutable
+
+-- | TODO check against 'nullPtr'?
+getWindowRectangle :: (MonadIO m) => HWND -> m RECT
+getWindowRectangle (HWND w) = liftIO $ getByReference (c_GetWindowRect w)
+
+getLastError :: (MonadIO m) => m SystemErrorCode
+getLastError = liftIO $ SystemErrorCode <$> c_GetLastError
+
+-------------------------------------------------------------------------
+
+{- for reference-parameter "getters" (unary).
+
+-}
+getByReference :: (Storable a) => (Ptr a -> IO ()) -> IO a
+getByReference setter = bracket
+ malloc
+ free
+ (\p -> setter p >> peek p)
+
+ -- getByReference :: (Storable a, MonadIO m) => (Ptr a -> m ()) -> m a
+ -- getByReference setter = liftIO $ bracket -- can liftIO? result IO is positive-position, but action IO is negative-position.
+ --  malloc
+ --  free
+ --  (\p -> setter p >> liftIO (peek p))
+ sources/Workflow/Windows/Constants.hs view
@@ -0,0 +1,694 @@+{-# LANGUAGE PatternSynonyms #-}
+{-| only exports @pattern@s -}
+module Workflow.Windows.Constants where
+import Workflow.Windows.Types (MOUSEEVENTF,VK,SystemErrorCode)
+
+--------------------------------------------------------------------------------
+
+-- | mouse move
+pattern MOUSEEVENTF_MOVE :: MOUSEEVENTF
+pattern MOUSEEVENTF_MOVE = 0x0001
+
+-- | left button down
+pattern MOUSEEVENTF_LEFTDOWN :: MOUSEEVENTF
+pattern MOUSEEVENTF_LEFTDOWN = 0x0002
+
+-- | left button up
+pattern MOUSEEVENTF_LEFTUP :: MOUSEEVENTF
+pattern MOUSEEVENTF_LEFTUP = 0x0004
+
+-- | right button down
+pattern MOUSEEVENTF_RIGHTDOWN :: MOUSEEVENTF
+pattern MOUSEEVENTF_RIGHTDOWN = 0x0008
+
+-- | right button up
+pattern MOUSEEVENTF_RIGHTUP :: MOUSEEVENTF
+pattern MOUSEEVENTF_RIGHTUP = 0x0010
+
+-- | middle button down
+pattern MOUSEEVENTF_MIDDLEDOWN :: MOUSEEVENTF
+pattern MOUSEEVENTF_MIDDLEDOWN = 0x0020
+
+-- | middle button up
+pattern MOUSEEVENTF_MIDDLEUP :: MOUSEEVENTF
+pattern MOUSEEVENTF_MIDDLEUP = 0x0040
+
+-- | x button down i.e. TODO
+pattern MOUSEEVENTF_XDOWN :: MOUSEEVENTF
+pattern MOUSEEVENTF_XDOWN = 0x0080
+
+-- | x button up
+pattern MOUSEEVENTF_XUP :: MOUSEEVENTF
+pattern MOUSEEVENTF_XUP = 0x0100
+
+-- | vertical wheel rolled
+pattern MOUSEEVENTF_WHEEL :: MOUSEEVENTF
+pattern MOUSEEVENTF_WHEEL = 0x0800
+
+-- | horizontal wheel rolled
+pattern MOUSEEVENTF_HWHEEL :: MOUSEEVENTF
+pattern MOUSEEVENTF_HWHEEL = 0x01000
+
+-- | do not coalesce mouse moves i.e. TODO
+pattern MOUSEEVENTF_MOVE_NOCOALESCE :: MOUSEEVENTF
+pattern MOUSEEVENTF_MOVE_NOCOALESCE = 0x2000
+
+-- | map to entire virtual desktop i.e. TODO
+pattern MOUSEEVENTF_VIRTUALDESK :: MOUSEEVENTF
+pattern MOUSEEVENTF_VIRTUALDESK = 0x4000
+
+-- | absolute move i.e. TODO
+pattern MOUSEEVENTF_ABSOLUTE :: MOUSEEVENTF
+pattern MOUSEEVENTF_ABSOLUTE = 0x8000
+
+--------------------------------------------------------------------------------
+
+-- | backwards delete, @BACKSPACE@ key
+pattern VK_BACK :: VK
+pattern VK_BACK = 0x08
+
+-- |
+pattern VK_TAB :: VK
+pattern VK_TAB = 0x09
+
+-- |
+pattern VK_CLEAR :: VK
+pattern VK_CLEAR = 0x0C
+
+-- | @ENTER@ key
+pattern VK_RETURN :: VK
+pattern VK_RETURN = 0x0D
+-- |
+pattern VK_SHIFT :: VK
+pattern VK_SHIFT = 0x10
+-- |
+pattern VK_CONTROL :: VK
+pattern VK_CONTROL = 0x11
+
+-- | @Alt@ key
+pattern VK_MENU :: VK
+pattern VK_MENU = 0x12
+-- |
+pattern VK_PAUSE :: VK
+pattern VK_PAUSE = 0x13
+-- | @CapsLock@
+pattern VK_CAPITAL :: VK
+pattern VK_CAPITAL = 0x14
+
+-- |
+pattern VK_KANA :: VK
+pattern VK_KANA = 0x15
+-- | "old name - should be here for compatibility"
+pattern VK_HANGEUL :: VK
+pattern VK_HANGEUL = 0x15
+-- |
+pattern VK_HANGUL :: VK
+pattern VK_HANGUL = 0x15
+-- |
+pattern VK_JUNJA :: VK
+pattern VK_JUNJA = 0x17
+-- |
+pattern VK_FINAL :: VK
+pattern VK_FINAL = 0x18
+-- |
+pattern VK_HANJA :: VK
+pattern VK_HANJA = 0x19
+-- |
+pattern VK_KANJI :: VK
+pattern VK_KANJI = 0x19
+-- |
+pattern VK_ESCAPE :: VK
+pattern VK_ESCAPE = 0x1B
+
+-- |
+pattern VK_CONVERT :: VK
+pattern VK_CONVERT = 0x1C
+-- |
+pattern VK_NONCONVERT :: VK
+pattern VK_NONCONVERT = 0x1D
+-- |
+pattern VK_ACCEPT :: VK
+pattern VK_ACCEPT = 0x1E
+-- |
+pattern VK_MODECHANGE :: VK
+pattern VK_MODECHANGE = 0x1F
+
+-- |
+pattern VK_SPACE :: VK
+pattern VK_SPACE = 0x20
+-- | @PgUp@
+pattern VK_PRIOR :: VK
+pattern VK_PRIOR = 0x21
+-- | @PgDn@
+pattern VK_NEXT :: VK
+pattern VK_NEXT = 0x22
+-- |
+pattern VK_END :: VK
+pattern VK_END = 0x23
+-- |
+pattern VK_HOME :: VK
+pattern VK_HOME = 0x24
+-- |
+pattern VK_LEFT :: VK
+pattern VK_LEFT = 0x25
+-- |
+pattern VK_UP :: VK
+pattern VK_UP = 0x26
+-- |
+pattern VK_RIGHT :: VK
+pattern VK_RIGHT = 0x27
+-- |
+pattern VK_DOWN :: VK
+pattern VK_DOWN = 0x28
+-- |
+pattern VK_SELECT :: VK
+pattern VK_SELECT = 0x29
+-- |
+pattern VK_PRINT :: VK
+pattern VK_PRINT = 0x2A
+-- |
+pattern VK_EXECUTE :: VK
+pattern VK_EXECUTE = 0x2B
+-- |
+pattern VK_SNAPSHOT :: VK
+pattern VK_SNAPSHOT = 0x2C
+-- |
+pattern VK_INSERT :: VK
+pattern VK_INSERT = 0x2D
+-- | forwards delete, @DELETE@ key
+pattern VK_DELETE :: VK
+pattern VK_DELETE = 0x2E
+-- |
+pattern VK_HELP :: VK
+pattern VK_HELP = 0x2F
+
+-- | 'VK_0' to 'VK_9' are the same as ASCII @0@ to @9@ (@0x30@ to @0x39@)
+pattern VK_0 :: VK
+pattern VK_0 = 0x30
+-- |
+pattern VK_1 :: VK
+pattern VK_1 = 0x31
+-- |
+pattern VK_2 :: VK
+pattern VK_2 = 0x32
+-- |
+pattern VK_3 :: VK
+pattern VK_3 = 0x33
+-- |
+pattern VK_4 :: VK
+pattern VK_4 = 0x34
+-- |
+pattern VK_5 :: VK
+pattern VK_5 = 0x35
+-- |
+pattern VK_6 :: VK
+pattern VK_6 = 0x36
+-- |
+pattern VK_7 :: VK
+pattern VK_7 = 0x37
+-- |
+pattern VK_8 :: VK
+pattern VK_8 = 0x38
+-- |
+pattern VK_9 :: VK
+pattern VK_9 = 0x39
+
+-- 0x40 : unassigned
+
+-- | 'VK_A' to 'VK_Z' are the same as ASCII @A@ to @Z@ (@0x41@ to @0x5A@)
+pattern VK_A :: VK
+pattern VK_A = 0x41
+-- |
+pattern VK_B :: VK
+pattern VK_B = 0x42
+-- |
+pattern VK_C :: VK
+pattern VK_C = 0x43
+-- |
+pattern VK_D :: VK
+pattern VK_D = 0x44
+-- |
+pattern VK_E :: VK
+pattern VK_E = 0x45
+-- |
+pattern VK_F :: VK
+pattern VK_F = 0x46
+-- |
+pattern VK_G :: VK
+pattern VK_G = 0x47
+-- |
+pattern VK_H :: VK
+pattern VK_H = 0x48
+-- |
+pattern VK_I :: VK
+pattern VK_I = 0x49
+-- |
+pattern VK_J :: VK
+pattern VK_J = 0x4A
+-- |
+pattern VK_K :: VK
+pattern VK_K = 0x4B
+-- |
+pattern VK_L :: VK
+pattern VK_L = 0x4C
+-- |
+pattern VK_M :: VK
+pattern VK_M = 0x4D
+-- |
+pattern VK_N :: VK
+pattern VK_N = 0x4E
+-- |
+pattern VK_O :: VK
+pattern VK_O = 0x4F
+-- |
+pattern VK_P :: VK
+pattern VK_P = 0x50
+-- |
+pattern VK_Q :: VK
+pattern VK_Q = 0x51
+-- |
+pattern VK_R :: VK
+pattern VK_R = 0x52
+-- |
+pattern VK_S :: VK
+pattern VK_S = 0x53
+-- |
+pattern VK_T :: VK
+pattern VK_T = 0x54
+-- |
+pattern VK_U :: VK
+pattern VK_U = 0x55
+-- |
+pattern VK_V :: VK
+pattern VK_V = 0x56
+-- |
+pattern VK_W :: VK
+pattern VK_W = 0x57
+-- |
+pattern VK_X :: VK
+pattern VK_X = 0x58
+-- |
+pattern VK_Y :: VK
+pattern VK_Y = 0x59
+-- |
+pattern VK_Z :: VK
+pattern VK_Z = 0x5A
+
+-- |
+pattern VK_LWIN :: VK
+pattern VK_LWIN = 0x5B
+-- |
+pattern VK_RWIN :: VK
+pattern VK_RWIN = 0x5C
+-- |
+pattern VK_APPS :: VK
+pattern VK_APPS = 0x5D
+
+-- |
+pattern VK_SLEEP :: VK
+pattern VK_SLEEP = 0x5F
+
+-- |
+pattern VK_NUMPAD0 :: VK
+pattern VK_NUMPAD0 = 0x60
+-- |
+pattern VK_NUMPAD1 :: VK
+pattern VK_NUMPAD1 = 0x61
+-- |
+pattern VK_NUMPAD2 :: VK
+pattern VK_NUMPAD2 = 0x62
+-- |
+pattern VK_NUMPAD3 :: VK
+pattern VK_NUMPAD3 = 0x63
+-- |
+pattern VK_NUMPAD4 :: VK
+pattern VK_NUMPAD4 = 0x64
+-- |
+pattern VK_NUMPAD5 :: VK
+pattern VK_NUMPAD5 = 0x65
+-- |
+pattern VK_NUMPAD6 :: VK
+pattern VK_NUMPAD6 = 0x66
+-- |
+pattern VK_NUMPAD7 :: VK
+pattern VK_NUMPAD7 = 0x67
+-- |
+pattern VK_NUMPAD8 :: VK
+pattern VK_NUMPAD8 = 0x68
+-- |
+pattern VK_NUMPAD9 :: VK
+pattern VK_NUMPAD9 = 0x69
+-- |
+pattern VK_MULTIPLY :: VK
+pattern VK_MULTIPLY = 0x6A
+-- |
+pattern VK_ADD :: VK
+pattern VK_ADD = 0x6B
+-- |
+pattern VK_SEPARATOR :: VK
+pattern VK_SEPARATOR = 0x6C
+-- |
+pattern VK_SUBTRACT :: VK
+pattern VK_SUBTRACT = 0x6D
+-- |
+pattern VK_DECIMAL :: VK
+pattern VK_DECIMAL = 0x6E
+-- |
+pattern VK_DIVIDE :: VK
+pattern VK_DIVIDE = 0x6F
+
+-- | 24 function keys: 'VK_F1' to 'VK_F24'
+pattern VK_F1 :: VK
+pattern VK_F1 = 0x70
+-- |
+pattern VK_F2 :: VK
+pattern VK_F2 = 0x71
+-- |
+pattern VK_F3 :: VK
+pattern VK_F3 = 0x72
+-- |
+pattern VK_F4 :: VK
+pattern VK_F4 = 0x73
+-- |
+pattern VK_F5 :: VK
+pattern VK_F5 = 0x74
+-- |
+pattern VK_F6 :: VK
+pattern VK_F6 = 0x75
+-- |
+pattern VK_F7 :: VK
+pattern VK_F7 = 0x76
+-- |
+pattern VK_F8 :: VK
+pattern VK_F8 = 0x77
+-- |
+pattern VK_F9 :: VK
+pattern VK_F9 = 0x78
+-- |
+pattern VK_F10 :: VK
+pattern VK_F10 = 0x79
+-- |
+pattern VK_F11 :: VK
+pattern VK_F11 = 0x7A
+-- |
+pattern VK_F12 :: VK
+pattern VK_F12 = 0x7B
+-- |
+pattern VK_F13 :: VK
+pattern VK_F13 = 0x7C
+-- |
+pattern VK_F14 :: VK
+pattern VK_F14 = 0x7D
+-- |
+pattern VK_F15 :: VK
+pattern VK_F15 = 0x7E
+-- |
+pattern VK_F16 :: VK
+pattern VK_F16 = 0x7F
+-- |
+pattern VK_F17 :: VK
+pattern VK_F17 = 0x80
+-- |
+pattern VK_F18 :: VK
+pattern VK_F18 = 0x81
+-- |
+pattern VK_F19 :: VK
+pattern VK_F19 = 0x82
+-- |
+pattern VK_F20 :: VK
+pattern VK_F20 = 0x83
+-- |
+pattern VK_F21 :: VK
+pattern VK_F21 = 0x84
+-- |
+pattern VK_F22 :: VK
+pattern VK_F22 = 0x85
+-- |
+pattern VK_F23 :: VK
+pattern VK_F23 = 0x86
+-- |
+pattern VK_F24 :: VK
+pattern VK_F24 = 0x87
+
+-- |
+pattern VK_NUMLOCK :: VK
+pattern VK_NUMLOCK = 0x90
+-- |
+pattern VK_SCROLL :: VK
+pattern VK_SCROLL = 0x91
+
+-- NEC PC-9800 kbd definitions
+
+-- @=@ | key on numpad
+pattern VK_OEM_NEC_EQUAL :: VK
+pattern VK_OEM_NEC_EQUAL = 0x92
+
+-- Fujitsu/OASYS kbd definitions
+
+-- | @Dictionary@ key
+pattern VK_OEM_FJ_JISHO :: VK
+pattern VK_OEM_FJ_JISHO = 0x92
+-- | @Unregister word@ key
+-- |
+pattern VK_OEM_FJ_MASSHOU :: VK
+pattern VK_OEM_FJ_MASSHOU = 0x93
+-- | @Register word@ key
+-- |
+pattern VK_OEM_FJ_TOUROKU :: VK
+pattern VK_OEM_FJ_TOUROKU = 0x94
+-- | @Left OYAYUBI@ key
+-- |
+pattern VK_OEM_FJ_LOYA :: VK
+pattern VK_OEM_FJ_LOYA = 0x95
+-- | @Right OYAYUBI@ key
+-- |
+pattern VK_OEM_FJ_ROYA :: VK
+pattern VK_OEM_FJ_ROYA = 0x96
+
+-- VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
+-- Used only as parameters to GetAsyncKeyState() and GetKeyState().
+-- No other API or message will distinguish left and right keys in this way.
+
+-- |
+pattern VK_LSHIFT :: VK
+pattern VK_LSHIFT = 0xA0
+-- |
+pattern VK_RSHIFT :: VK
+pattern VK_RSHIFT = 0xA1
+-- |
+pattern VK_LCONTROL :: VK
+pattern VK_LCONTROL = 0xA2
+-- |
+pattern VK_RCONTROL :: VK
+pattern VK_RCONTROL = 0xA3
+-- |
+pattern VK_LMENU :: VK
+pattern VK_LMENU = 0xA4
+-- |
+pattern VK_RMENU :: VK
+pattern VK_RMENU = 0xA5
+
+-- |
+pattern VK_BROWSER_BACK :: VK
+pattern VK_BROWSER_BACK = 0xA6
+-- |
+pattern VK_BROWSER_FORWARD :: VK
+pattern VK_BROWSER_FORWARD = 0xA7
+-- |
+pattern VK_BROWSER_REFRESH :: VK
+pattern VK_BROWSER_REFRESH = 0xA8
+-- |
+pattern VK_BROWSER_STOP :: VK
+pattern VK_BROWSER_STOP = 0xA9
+-- |
+pattern VK_BROWSER_SEARCH :: VK
+pattern VK_BROWSER_SEARCH = 0xAA
+-- |
+pattern VK_BROWSER_FAVORITES :: VK
+pattern VK_BROWSER_FAVORITES = 0xAB
+-- |
+pattern VK_BROWSER_HOME :: VK
+pattern VK_BROWSER_HOME = 0xAC
+
+-- |
+pattern VK_VOLUME_MUTE :: VK
+pattern VK_VOLUME_MUTE = 0xAD
+-- |
+pattern VK_VOLUME_DOWN :: VK
+pattern VK_VOLUME_DOWN = 0xAE
+-- |
+pattern VK_VOLUME_UP :: VK
+pattern VK_VOLUME_UP = 0xAF
+-- |
+pattern VK_MEDIA_NEXT_TRACK :: VK
+pattern VK_MEDIA_NEXT_TRACK = 0xB0
+-- |
+pattern VK_MEDIA_PREV_TRACK :: VK
+pattern VK_MEDIA_PREV_TRACK = 0xB1
+-- |
+pattern VK_MEDIA_STOP :: VK
+pattern VK_MEDIA_STOP = 0xB2
+-- |
+pattern VK_MEDIA_PLAY_PAUSE :: VK
+pattern VK_MEDIA_PLAY_PAUSE = 0xB3
+-- |
+pattern VK_LAUNCH_MAIL :: VK
+pattern VK_LAUNCH_MAIL = 0xB4
+-- |
+pattern VK_LAUNCH_MEDIA_SELECT :: VK
+pattern VK_LAUNCH_MEDIA_SELECT = 0xB5
+-- |
+pattern VK_LAUNCH_APP1 :: VK
+pattern VK_LAUNCH_APP1 = 0xB6
+-- |
+pattern VK_LAUNCH_APP2 :: VK
+pattern VK_LAUNCH_APP2 = 0xB7
+
+-- | @;:@ for the US
+pattern VK_OEM_1 :: VK
+pattern VK_OEM_1 = 0xBA
+-- | @+@ any country (@=+@ for the US)
+pattern VK_OEM_PLUS :: VK
+pattern VK_OEM_PLUS = 0xBB
+-- | @,@ | any country
+pattern VK_OEM_COMMA :: VK
+pattern VK_OEM_COMMA = 0xBC
+-- | @-@ | any country
+pattern VK_OEM_MINUS :: VK
+pattern VK_OEM_MINUS = 0xBD
+-- | @.@ | any country
+pattern VK_OEM_PERIOD :: VK
+pattern VK_OEM_PERIOD = 0xBE
+-- | @/?@ | for the US
+pattern VK_OEM_2 :: VK
+pattern VK_OEM_2 = 0xBF
+-- | @`~@ | for the US
+pattern VK_OEM_3 :: VK
+pattern VK_OEM_3 = 0xC0
+
+-- | @[{@ | for the US
+pattern VK_OEM_4 :: VK
+pattern VK_OEM_4 = 0xDB
+-- | @\|@ | for the US
+pattern VK_OEM_5 :: VK
+pattern VK_OEM_5 = 0xDC
+-- | @]}@ | for the US
+pattern VK_OEM_6 :: VK
+pattern VK_OEM_6 = 0xDD
+-- | @"@ for the US
+pattern VK_OEM_7 :: VK
+pattern VK_OEM_7 = 0xDE
+-- |
+pattern VK_OEM_8 :: VK
+pattern VK_OEM_8 = 0xDF
+
+-- Various extended or enhanced keyboards
+
+-- | AX key on Japanese AX kbd
+--
+pattern VK_OEM_AX :: VK
+pattern VK_OEM_AX = 0xE1
+-- | @"<>"@ or @"\|"@ on RT 102-key kbd.
+--
+pattern VK_OEM_102 :: VK
+pattern VK_OEM_102 = 0xE2
+-- | "Help key on ICO"
+pattern VK_ICO_HELP :: VK
+pattern VK_ICO_HELP = 0xE3
+-- | "00 key on ICO"
+--
+pattern VK_ICO_00 :: VK
+pattern VK_ICO_00 = 0xE4
+
+-- |
+pattern VK_PROCESSKEY :: VK
+pattern VK_PROCESSKEY = 0xE5
+
+-- |
+pattern VK_ICO_CLEAR :: VK
+pattern VK_ICO_CLEAR = 0xE6
+
+-- | "Windows 2000: Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods. The Unicode character is the high word."
+pattern VK_PACKET :: VK
+pattern VK_PACKET = 0xE7
+
+-- |
+pattern VK_OEM_RESET :: VK
+pattern VK_OEM_RESET = 0xE9
+-- |
+pattern VK_OEM_JUMP :: VK
+pattern VK_OEM_JUMP = 0xEA
+-- |
+pattern VK_OEM_PA1 :: VK
+pattern VK_OEM_PA1 = 0xEB
+-- |
+pattern VK_OEM_PA2 :: VK
+pattern VK_OEM_PA2 = 0xEC
+-- |
+pattern VK_OEM_PA3 :: VK
+pattern VK_OEM_PA3 = 0xED
+-- |
+pattern VK_OEM_WSCTRL :: VK
+pattern VK_OEM_WSCTRL = 0xEE
+-- |
+pattern VK_OEM_CUSEL :: VK
+pattern VK_OEM_CUSEL = 0xEF
+-- |
+pattern VK_OEM_ATTN :: VK
+pattern VK_OEM_ATTN = 0xF0
+-- |
+pattern VK_OEM_FINISH :: VK
+pattern VK_OEM_FINISH = 0xF1
+-- |
+pattern VK_OEM_COPY :: VK
+pattern VK_OEM_COPY = 0xF2
+-- |
+pattern VK_OEM_AUTO :: VK
+pattern VK_OEM_AUTO = 0xF3
+-- |
+pattern VK_OEM_ENLW :: VK
+pattern VK_OEM_ENLW = 0xF4
+-- |
+pattern VK_OEM_BACKTAB :: VK
+pattern VK_OEM_BACKTAB = 0xF5
+
+-- |
+pattern VK_ATTN :: VK
+pattern VK_ATTN = 0xF6
+-- |
+pattern VK_CRSEL :: VK
+pattern VK_CRSEL = 0xF7
+-- |
+pattern VK_EXSEL :: VK
+pattern VK_EXSEL = 0xF8
+-- |
+pattern VK_EREOF :: VK
+pattern VK_EREOF = 0xF9
+-- |
+pattern VK_PLAY :: VK
+pattern VK_PLAY = 0xFA
+-- |
+pattern VK_ZOOM :: VK
+pattern VK_ZOOM = 0xFB
+-- |
+pattern VK_NONAME :: VK
+pattern VK_NONAME = 0xFC
+-- |
+pattern VK_PA1 :: VK
+pattern VK_PA1 = 0xFD
+-- |
+pattern VK_OEM_CLEAR :: VK
+pattern VK_OEM_CLEAR = 0xFE
+
+-- | @Fn@ key "on most laptops" (undocumented)
+--
+-- http://stackoverflow.com/questions/4718069/what-is-win32-virtual-key-code-0xff-used-for-and-is-it-documented-somewhere
+pattern VK_FN :: VK
+pattern VK_FN = 0xFF
+
+--------------------------------------------------------------------------------
+
+pattern ERROR_INVALID_WINDOW_HANDLE :: SystemErrorCode
+pattern ERROR_INVALID_WINDOW_HANDLE = 1400
+
+--------------------------------------------------------------------------------
+ sources/Workflow/Windows/Example.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings, NegativeLiterals #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Workflow.Windows.Example where
+import Workflow.Windows
+import Workflow.Windows.Extra
+
+import Data.StateVar
+
+reverseClipboard = do
+ clipboard $~ reverse
+
+moveCursorToTopLeft = do
+ cursor $= POINT 0 0
+
+testVariables = do
+  putStrLn "\n- vars...\n"
+
+  reverseClipboard
+  print =<< get clipboard
+
+  moveCursorToTopLeft
+  print =<< get cursor
+
+{-
+stack build && stack exec workflow-windows-example
+-}
+testWorkflow = do
+ contents <- getClipboard
+ setClipboard (reverse contents)
+ print contents
+ sendChar 'c'
+ sendText "sendText"
+ pressKeyChord [VK_CONTROL] VK_A -- press "C-a"
+ openApplication "cmd.exe"
+ openUrl "http://google.com"
+ --clickMouseAt windowsMouse (POINT (maxBound `div` 2) minBound) 2 MOUSEEVENTF_LEFTDOWN MOUSEEVENTF_LEFTUP
+ clickMouseAt (POINT 800 10) 2 MOUSEEVENTF_LEFTDOWN MOUSEEVENTF_LEFTUP
+ scrollMouse MOUSEEVENTF_WHEEL 1 120 -- up (with my trackpad, "natural" scrolling disabled)
+ delayMilliseconds 1000
+ scrollMouse MOUSEEVENTF_WHEEL -1 60 -- down (with my trackpad, "natural" scrolling disabled)
+
+testWindow s = do
+ putStrLn $ "\nwindowClass: " ++ s
+ w <- findWindow (aWindowClass s)
+ e <- c_GetLastError
+ putStr "GetLastError: "
+ print e
+ putStr "non-null: "
+ print $ not (isNull (getHWND w))
+ getWindowRectangle w >>= print
+
+main = do
+ putStrLn "\nworkflow-windows-example...\n"
+
+ putStr "\ndebug Privileges:"
+ print =<< c_EnableDebugPriv -- doesnt seem to be necessary
+
+ testVariables
+
+ -- delayMilliseconds 4000
+ --testWorkflow
+ --pressKeyChord [] VK_VOLUME_MUTE
+ -- pressKeyChord [] VK_MEDIA_PLAY_PAUSE
+ -- pressKeyChord [] VK_MEDIA_PLAY_PAUSE
+ -- replicateM_ 2 $ pressKeyChord [VK_MENU] VK_F -- press "A-f"
+
+ -- traverse_ testWindow ["OpusApp", "Emacs", "ConsoleWindowClass", "Chrome_WidgetWin_1"]
+  -- "OpusApp" no, "Emacs" no, "ConsoleWindowClass" no, "Chrome_WidgetWin_1"  yes -- (Window "" "Chrome_WidgetWin_1" "")
+
+ -- pressKeyChord [] VK_OEM_PLUS  -- "="
+ -- pressKeyChord [VK_SHIFT] VK_OEM_PLUS -- "+"
+
+{- when minimized, negs:
+
+windowClass: Chrome_WidgetWin_1
+non-null: True
+RECT {leftRECT = -31992, topRECT = -31941, rightRECT = -31928, bottomRECT = -31877}
+
+-}
+ sources/Workflow/Windows/Execute.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables, FlexibleContexts, ViewPatterns #-}
+{-|
+
+high-level bindings.
+
+Glue between "Workflow.Types" and "Workflow.Windows.Types".
+
+-}
+module Workflow.Windows.Execute where
+import Workflow.Windows.Constants
+import Workflow.Windows.Bindings as Win32
+import Workflow.Windows.Types
+import Workflow.Windows.Extra
+import Workflow.Types hiding (Application,URL)
+
+import Control.Monad.Free
+import Control.Monad.Trans.Free hiding (Pure, Free, iterM) -- TODO
+
+import Numeric.Natural
+import Control.Monad.IO.Class
+
+
+runWorkflow :: Workflow a -> IO a
+runWorkflow = runWorkflowT . toFreeT
+
+{-| eliminate a 'WorkflowT' layer.
+
+e.g. some custom monad:
+
+@
+newtype W a = W
+ { getW :: WorkflowT IO a
+ } deriving
+ ( MonadWorkflow
+ , MonadIO
+ , Monad
+ , Applicative
+ , Functor
+ )
+@
+
+specializing:
+
+@
+runW :: W a -> IO a
+runW = 'runWorkflowT' . getW
+@
+
+-}
+runWorkflowT :: forall m a. (MonadIO m) => WorkflowT m a -> m a
+runWorkflowT = iterT go
+ where
+ go :: WorkflowF (m a) -> m a
+ go = \case
+
+  SendKeyChord    modifiers key k  -> sendKeyChord_Win32 modifiers key >> k
+  SendText        s k              -> Win32.sendText s >> k
+  -- TODO support Unicode by inserting "directly"
+  -- terminates because sendTextAsKeypresses is exclusively a sequence of SendKeyChord'es
+  -- TODO SendMouseClick  flags n button k ->
+  SendMouseClick    flags n button k -> clickMouse_Win32 flags n button >> k
+  SendMouseScroll   flags scroll n k -> scrollMouse_Win32 flags scroll n >> k
+
+  GetClipboard    f                -> Win32.getClipboard >>= f
+  SetClipboard    s k              -> Win32.setClipboard s >> k
+
+  CurrentApplication f             -> Win32.currentApplication >>= (getApplication >>> f)
+  OpenApplication app k            -> Win32.openApplication (Application app) >> k
+  OpenURL         url k            -> Win32.openUrl (URL url) >> k
+
+  Delay           t k              -> delayMilliseconds t >> k
+ -- 1,000 µs is 1ms
+
+-----------------------------------------------------------------------------------------
+
+clickMouse_Win32
+ :: (MonadIO m) => [Modifier] -> Natural -> MouseButton -> m ()
+clickMouse_Win32 modifiers n button = liftIO $ do
+  POINT x y <- getCursorPosition --TODO Point has Cursor case
+  holdingKeys (fromModifier <$> modifiers) $ do
+      clickMouseAt_Win32 button n (x,y)
+
+clickMouseAt_Win32
+ :: (MonadIO m) => MouseButton -> Natural -> (LONG,LONG) -> m ()
+clickMouseAt_Win32 (encodeMouseButton -> (down, up)) n (x,y)
+ = Win32.clickMouseAt (POINT x y) n down up
+--TODO type for screen coordinates. more than point. abs/rel. (bounded instance for rel).
+
+scrollMouse_Win32
+ :: (MonadIO m) => [Modifier] -> MouseScroll -> Natural -> m ()
+scrollMouse_Win32 modifiers (encodeMouseScroll -> (wheel, direction)) n
+ = liftIO $ holdingKeys (fromModifier <$> modifiers) $ do
+     Win32.scrollMouse wheel direction n
+
+{-|
+
+@
+(wheel, direction) = encodeMouseScroll
+@
+
+-}
+encodeMouseScroll :: MouseScroll -> (MOUSEEVENTF, DWORD)
+encodeMouseScroll = \case
+    ScrollTowards -> (MOUSEEVENTF_WHEEL,   1)
+    ScrollAway    -> (MOUSEEVENTF_WHEEL,  -1)
+    ScrollRight   -> (MOUSEEVENTF_HWHEEL,  1)
+    ScrollLeft    -> (MOUSEEVENTF_HWHEEL, -1)
+
+{-|
+
+@
+(downEvent, upEvent) = encodeMouseButton
+@
+
+-}
+encodeMouseButton :: MouseButton -> (MOUSEEVENTF,MOUSEEVENTF)
+encodeMouseButton = \case
+ LeftButton   -> (MOUSEEVENTF_LEFTDOWN   , MOUSEEVENTF_LEFTUP)
+ MiddleButton -> (MOUSEEVENTF_MIDDLEDOWN , MOUSEEVENTF_MIDDLEUP)
+ RightButton  -> (MOUSEEVENTF_RIGHTDOWN  , MOUSEEVENTF_RIGHTUP)
+ -- XButton      -> (MOUSEEVENTF_XDOWN      , MOUSEEVENTF_XUP)
+
+-----------------------------------------------------------------------------------------
+
+sendKeyChord_Win32 :: (MonadIO m) => [Modifier] -> Key -> m ()
+sendKeyChord_Win32 modifiers key
+ = Win32.pressKeyChord (fromModifier <$> modifiers) (fromKey key)
+
+{-|
+
+-}
+fromModifier :: Modifier -> VK
+fromModifier = \case
+-- "virtual, virtual" modifiers
+ MetaModifier     -> VK_MENU
+ HyperModifier    -> VK_CONTROL
+ -- "actual, virtual" modifiers
+ ControlModifier  -> VK_CONTROL
+ OptionModifier   -> VK_MENU
+ ShiftModifier    -> VK_SHIFT
+ FunctionModifier -> VK_FN
+
+{-|
+
+-}
+fromKey :: Key -> VK
+fromKey = \case
+
+ -- "virtual, virtual" keys
+
+ MetaKey -> VK_MENU
+ HyperKey -> VK_CONTROL
+
+ -- "actual, virtual" keys
+
+ ControlKey -> VK_CONTROL
+ CapsLockKey -> VK_CAPITAL
+ ShiftKey -> VK_SHIFT
+ OptionKey -> VK_MENU
+ FunctionKey -> VK_FN
+
+ GraveKey -> VK_OEM_3
+ MinusKey -> VK_OEM_MINUS
+ EqualKey -> VK_OEM_PLUS
+ DeleteKey -> VK_BACK
+ ForwardDeleteKey -> VK_DELETE
+ LeftBracketKey -> VK_OEM_4
+ RightBracketKey -> VK_OEM_6
+ BackslashKey -> VK_OEM_5
+ SemicolonKey -> VK_OEM_1
+ QuoteKey -> VK_OEM_7
+ CommaKey -> VK_OEM_COMMA
+ PeriodKey -> VK_OEM_PERIOD
+ SlashKey -> VK_OEM_2
+
+ TabKey -> VK_TAB
+ SpaceKey -> VK_SPACE
+ ReturnKey -> VK_RETURN
+
+ LeftArrowKey -> VK_LEFT
+ RightArrowKey -> VK_RIGHT
+ DownArrowKey -> VK_DOWN
+ UpArrowKey -> VK_UP
+
+ AKey -> VK_A
+ BKey -> VK_B
+ CKey -> VK_C
+ DKey -> VK_D
+ EKey -> VK_E
+ FKey -> VK_F
+ GKey -> VK_G
+ HKey -> VK_H
+ IKey -> VK_I
+ JKey -> VK_J
+ KKey -> VK_K
+ LKey -> VK_L
+ MKey -> VK_M
+ NKey -> VK_N
+ OKey -> VK_O
+ PKey -> VK_P
+ QKey -> VK_Q
+ RKey -> VK_R
+ SKey -> VK_S
+ TKey -> VK_T
+ UKey -> VK_U
+ VKey -> VK_V
+ WKey -> VK_W
+ XKey -> VK_X
+ YKey -> VK_Y
+ ZKey -> VK_Z
+
+ ZeroKey -> VK_0
+ OneKey -> VK_1
+ TwoKey -> VK_2
+ ThreeKey -> VK_3
+ FourKey -> VK_4
+ FiveKey -> VK_5
+ SixKey -> VK_6
+ SevenKey -> VK_7
+ EightKey -> VK_8
+ NineKey -> VK_9
+
+ EscapeKey -> VK_ESCAPE
+ F1Key -> VK_F1
+ F2Key -> VK_F2
+ F3Key -> VK_F3
+ F4Key -> VK_F4
+ F5Key -> VK_F5
+ F6Key -> VK_F6
+ F7Key -> VK_F7
+ F8Key -> VK_F8
+ F9Key -> VK_F9
+ F10Key -> VK_F10
+ F11Key -> VK_F11
+ F12Key -> VK_F12
+ F13Key -> VK_F13
+ F14Key -> VK_F14
+ F15Key -> VK_F15
+ F16Key -> VK_F16
+ F17Key -> VK_F17
+ F18Key -> VK_F18
+ F19Key -> VK_F19
+ F20Key -> VK_F20
+
+--------------------------------------------------------------------------------
+ sources/Workflow/Windows/Extra.hs view
@@ -0,0 +1,39 @@+module Workflow.Windows.Extra
+ ( module Workflow.Windows.Extra
+ , module Control.Arrow
+ , module Data.Data
+ , module GHC.Generics
+ , module Data.Function
+ , module Data.Foldable
+ , module Export_
+ ) where
+
+import Control.Arrow ((>>>))
+import Control.Concurrent (threadDelay)
+import Data.Data (Data)
+import GHC.Generics (Generic)
+import Data.Function ((&),on)
+import Data.Foldable (traverse_)
+import Control.Monad.IO.Class
+import Control.Monad as Export_
+import Foreign (Ptr,nullPtr)
+
+nothing :: IO ()
+nothing = return ()
+
+delayMilliseconds :: (MonadIO m) => Int -> m ()
+delayMilliseconds = liftIO . threadDelay . (*1000)
+
+{-|
+
+(NOTE truncates large integral types).
+
+-}
+toInt :: (Integral a) => a -> Int
+toInt = toInteger >>> (id :: Integer -> Integer) >>> fromIntegral
+
+todo :: a --TODO call stack
+todo = error "TODO"
+
+isNull :: Ptr a -> Bool
+isNull = (== nullPtr)
+ sources/Workflow/Windows/Foreign.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+{-|
+
+low-level bindings.
+
+-}
+module Workflow.Windows.Foreign where
+import Workflow.Windows.Types
+
+import Foreign.C.Types
+import Foreign.C.String (CWString)
+import Foreign.Ptr (Ptr)
+
+#include "calling_convention.h"
+
+#define SAFETY safe
+
+{-
+
+{-|
+@
+@
+
+see <>
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h "
+ c_ :: IO ()
+
+-}
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h GetClipboard"
+ c_GetClipboard :: IO CWString
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h SetClipboard"
+ c_SetClipboard :: CWString -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h SendUnicodeChar"
+ c_SendUnicodeChar :: WCHAR_T -> IO UINT
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h PressKeyDown"
+ c_PressKeyDown :: WORD -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h PressKeyUp"
+ c_PressKeyUp :: WORD -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h ClickMouseAt"
+ c_ClickMouseAt :: Int -> Int -> Int -> DWORD -> DWORD -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h ScrollMouseWheel"
+ c_ScrollMouseWheel :: DWORD -> DWORD -> DWORD -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h OpenApplication"
+ c_OpenApplication :: CWString -> IO ()
+
+foreign import CALLING_CONVENTION SAFETY "Workflow.h OpenUrl"
+ c_OpenUrl :: CWString -> IO ()
+
+{-|
+
+(reference parameter).
+
+@
+BOOL WINAPI GetCursorPos(
+  _Out_ LPPOINT lpPoint
+);
+@
+
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h GetCursorPos"
+ c_GetCursorPos :: Ptr POINT -> IO ()
+
+{-|
+
+@
+ BOOL WINAPI SetCursorPos(
+   _In_ int X,
+   _In_ int Y
+ );
+@
+
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h SetCursorPos"
+ c_SetCursorPos :: CInt -> CInt -> IO ()
+
+{-|
+@
+@
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h GetWindowRect"
+ c_GetWindowRect :: VoidStar -> Ptr RECT -> IO ()
+
+-- {-|
+--
+-- @
+-- BOOL WINAPI SetWindowPos(
+--   _In_     HWND hWnd,
+--   _In_opt_ HWND hWndInsertAfter,
+--   _In_     int  X,
+--   _In_     int  Y,
+--   _In_     int  cx,
+--   _In_     int  cy,
+--   _In_     UINT uFlags
+-- );
+-- @
+--
+-- see <https://msdn.microsoft.com/en-us/library/ms633545.aspx>
+--
+-- -}
+-- foreign import CALLING_CONVENTION SAFETY "Windows.h SetWindowPos"
+--  c_SetWindowPos :: IO ()
+
+-- {-|
+-- @
+-- @
+--
+-- see <>
+-- -}
+-- foreign import CALLING_CONVENTION SAFETY "Workflow.h ShowHWND"
+--  c_ShowHWND :: HWND -> IO String
+--
+
+{-|
+
+@
+HWND WINAPI FindWindowW(
+    _In_opt_ LPCWSTR lpClassName,
+    _In_opt_ LPCWSTR lpWindowName);
+@
+
+see
+<https://msdn.microsoft.com/en-us/library/windows/desktop/ms633499(v=vs.85).aspx>
+
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h FindWindowW" --TODO FindWindow causes "ld 1: undefined reference"
+ c_FindWindow :: CWString -> CWString -> IO VoidStar
+
+{-|
+
+@
+DWORD WINAPI GetLastError(void);
+@
+
+see
+<https://msdn.microsoft.com/en-us/library/windows/desktop/ms679360(v=vs.85).aspx>
+
+see 'SystemErrorCode'
+
+-}
+foreign import CALLING_CONVENTION SAFETY "Windows.h GetLastError"
+ c_GetLastError :: IO DWORD
+
+{-|
+
+see <https://msdn.microsoft.com/en-us/library/windows/hardware/ff541528(v=vs.85).aspx
+Debug Privilege>
+
+-}
+foreign import CALLING_CONVENTION SAFETY "Workflow.h EnableDebugPriv"
+ c_EnableDebugPriv :: IO BOOL
+ sources/Workflow/Windows/Types.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, RecordWildCards, EmptyDataDecls #-}
+{-|
+
+Uppercased types are
+<https://msdn.microsoft.com/en-us/library/windows/desktop/aa383751(v=vs.85).aspx
+Windows Data Types>
+
+-}
+module Workflow.Windows.Types where
+import Workflow.Windows.Extra
+
+import Foreign.CStorable
+
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+import GHC.Exts
+import Data.Ix (Ix)
+
+--TODO foreign-var-0.1
+
+type LPCWSTR = CWString
+
+type WCHAR_T = CWchar
+
+type UINT = Word32 -- CUInt
+
+type WORD = Word16
+
+type DWORD = Word32
+
+-- | (may overflow)
+toDWORD :: (Integral a) => a -> DWORD
+toDWORD = fromIntegral
+
+{-|
+
+@
+LONG
+A 32-bit signed integer. The range is –2147483648 through 2147483647 decimal.
+This type is declared in WinNT.h as follows:
+typedef long LONG;
+@
+
+-}
+type LONG = Int32
+
+-- | @void*@
+type VoidStar = Ptr ()
+
+{-| an abstract handle to a window.
+
+-}
+-- data HWND = HWND
+-- newtype HWND = HWND (Ptr ())
+-- type HWND = Ptr ()
+newtype HWND = HWND VoidStar
+
+getHWND :: HWND -> VoidStar
+getHWND (HWND p) = p
+
+{-|
+
+-}
+type BOOL = CInt
+
+{-|
+
+see
+<https://msdn.microsoft.com/en-us/library/windows/desktop/ms681381(v=vs.85).aspx
+System Error Codes>
+
+-}
+newtype SystemErrorCode = SystemErrorCode DWORD
+ deriving (Bounded, Enum, Eq, Integral, Data, Num, Ord, Read, Real, Show, Ix, FiniteBits, Bits, Storable)
+
+{-|
+
+see
+<https://msdn.microsoft.com/en-us/library/windows/desktop/ms646273(v=vs.85).aspx Mouse Events>
+
+-}
+newtype MOUSEEVENTF = MOUSEEVENTF DWORD
+ deriving (Bounded, Enum, Eq, Integral, Data, Num, Ord, Read, Real, Show, Ix, FiniteBits, Bits, Storable)
+
+getMOUSEEVENTF :: MOUSEEVENTF -> DWORD
+getMOUSEEVENTF (MOUSEEVENTF n) = n
+-- manual accessor doesn't pollute Show instance
+
+{-|
+
+see
+<https://msdn.microsoft.com/en-us/library/windows/desktop/dd375731(v=vs.85).aspx Virtual-Key Codes>
+
+(no display brightness, no @Fn@ modifier key).
+
+-}
+newtype VK = VK WORD
+ deriving (Bounded, Enum, Eq, Integral, Data, Num, Ord, Read, Real, Show, Ix, FiniteBits, Bits, Storable)
+
+getVK :: VK -> WORD
+getVK (VK n) = n
+-- manual accessor doesn't pollute Show instance
+
+--------------------------------------------------------------------------------
+
+-- type LPPOINT = Ptr POINT
+
+-- type POINT =
+--   ( LONG  -- x
+--   , LONG  -- y
+--   )
+--
+-- pattern POINT x y = (x,y)
+
+-- {-|
+--
+-- TODO vinyl record
+-- GetCursorPos
+--
+--  with malloc $ \p -> do
+--   GetCursorPos p
+--   sequence [peek p 0, peek p 4]
+--
+-- -}
+
+{-|
+
+@
+struct POINT
+{
+    LONG  x;
+    LONG  y;
+}
+@
+
+-}
+data POINT = POINT
+ { xPOINT :: LONG
+ , yPOINT :: LONG
+ } deriving (Show,Read,Eq,Ord,Generic,Data)--,NFData,Semigroup,Monoid)
+
+instance CStorable POINT
+instance Storable  POINT where
+ peek      = cPeek
+ poke      = cPoke
+ alignment = cAlignment
+ sizeOf    = cSizeOf
+
+--------------------------------------------------------------------------------
+
+{-|
+
+@
+struct RECT
+{
+    LONG    left;
+    LONG    top;
+    LONG    right;
+    LONG    bottom;
+}
+@
+
+-}
+data RECT = RECT
+ { leftRECT   :: LONG
+ , topRECT    :: LONG
+ , rightRECT  :: LONG
+ , bottomRECT :: LONG
+ } deriving (Show,Read,Eq,Ord,Generic,Data)--,NFData,Semigroup,Monoid)
+
+instance CStorable RECT
+instance Storable  RECT where
+ peek      = cPeek
+ poke      = cPoke
+ alignment = cAlignment
+ sizeOf    = cSizeOf
+
+-----------------------------------------------------------------------------------------
+
+newtype Application = Application String
+ deriving (Show,IsString,Read,Eq,Ord,Generic,Data)--,NFData,Semigroup,Monoid)
+
+-- | (accessor)
+getApplication :: Application -> String
+getApplication (Application s) = s
+
+newtype URL = URL String
+ deriving (Show,IsString,Read,Eq,Ord,Generic,Data)--,NFData,Semigroup,Monoid)
+
+-- | (accessor)
+getURL :: URL -> String
+getURL (URL s) = s
+
+{-|
+
+Non-unique. e.g. open two blank (chrome) browser windows, both will match:
+
+@
+Window{..}
+ where
+ windowExecutable = "chrome.exe"
+ windowClass      = "Chrome_WidgetWin_1"
+ windowTitle      = "New Tab - Google Chrome"
+@
+
+-}
+data Window = Window
+ { windowExecutable :: String
+ , windowClass      :: String
+ , windowTitle      :: String
+ } deriving (Show) --TODO
+
+-- | only the 'windowTitle'
+instance IsString Window where -- TODO Maybe String? Vinyl? Rec Id and Rec Maybe.
+ fromString = aWindowTitle
+
+aWindowExecutable :: String -> Window
+aWindowExecutable s = Window{..}
+  where
+  windowExecutable = s
+  windowClass      = ""
+  windowTitle      = ""
+
+aWindowClass :: String -> Window
+aWindowClass s = Window{..}
+  where
+  windowExecutable = ""
+  windowClass      = s
+  windowTitle      = ""
+
+aWindowTitle :: String -> Window
+aWindowTitle s = Window{..}
+  where
+  windowExecutable = ""
+  windowClass      = ""
+  windowTitle      = s
+
+-----------------------------------------------------------------------------------------
+ sources/Workflow/Windows/Variables.hs view
@@ -0,0 +1,34 @@+{-|
+
+integration with the `StateVar` package.
+
+e.g.
+
+@
+import Foreign.Var
+
+reverseClipboard = do
+ 'clipboard' '$~' reverse
+
+moveCursorToTopLeft = do
+ 'cursor' '$=' POINT 0 0
+@
+
+-}
+module Workflow.Windows.Variables where
+import Workflow.Windows.Types
+import Workflow.Windows.Bindings
+
+import Data.StateVar
+
+clipboard :: StateVar String
+clipboard = StateVar getClipboard setClipboard
+
+cursor :: StateVar POINT
+cursor = StateVar getCursorPosition setCursorPosition -- moveMouse
+
+-- application :: StateVar String
+-- application = currentApplication launchApplication
+--
+-- window :: StateVar Window
+-- window = currentWindow activateWindow
+ tests/DocTest.hs view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+import Test.DocTest
+
+main = do
+ doctest
+  [ "Workflow.Windows.Main"
+  ]
+ tests/UnitTest.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/Workflow/Test.hs view
@@ -0,0 +1,5 @@+module Workflow.Windows.Test where
+import Workflow.Windows
+
+main = do
+ print "Workflow"
+ workflow-windows.cabal view
@@ -0,0 +1,101 @@+name:                workflow-windows
+version:             0.0.0
+synopsis:            Automate keyboard/mouse/clipboard/application interaction.
+description:         see http://github.com/sboosali/workflow-windows#readme for
+                     documentation and examples.
+homepage:            http://github.com/sboosali/workflow-windows#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Spiros Boosalis
+maintainer:          samboosalis@gmail.com
+copyright:           2016 Spiros Boosalis
+category:            Development
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+source-repository head
+  type:     git
+  location: https://github.com/sboosali/workflow-windows
+
+
+library
+ if !os(windows)
+    buildable: False
+
+ hs-source-dirs:      sources
+ default-language:    Haskell2010
+ ghc-options:         -Wall
+ default-extensions:  LambdaCase
+
+ c-sources:        native/Workflow.c
+ includes:         native/Workflow.h
+ install-includes: native/Workflow.h
+ include-dirs:     native
+
+ exposed-modules:
+  Workflow.Windows
+  Workflow.Windows.Types
+  Workflow.Windows.Constants
+  Workflow.Windows.Foreign
+  Workflow.Windows.Bindings
+  Workflow.Windows.Execute
+  Workflow.Windows.Variables
+
+-- other-modules:
+  Workflow.Windows.Example
+  Workflow.Windows.Extra
+
+ build-depends:
+    base >=4.7 && <5
+  , transformers
+
+  -- TODO other package?
+  , workflow-types
+  , free
+
+  -- minimal dependencies
+  , c-storable-deriving
+  , StateVar
+
+-- $ stack build && stack exec workflow-windows-example
+executable workflow-windows-example
+ hs-source-dirs:      executables
+ main-is:             Main.hs
+ default-language:    Haskell2010
+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+
+ build-depends:
+    base >=4.7 && <5
+  , workflow-windows
+
+
+-- $ stack test doctest
+test-suite doctest
+ hs-source-dirs:      tests
+ main-is:             DocTest.hs
+ type:                exitcode-stdio-1.0
+ default-language:    Haskell2010
+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+
+ build-depends:
+    base >=4.7 && <5
+  , workflow-windows
+  , doctest ==0.10.*
+
+-- $ stack test unittest
+test-suite unittest
+ hs-source-dirs:      tests
+ main-is:             UnitTest.hs
+ type:                exitcode-stdio-1.0
+ default-language:    Haskell2010
+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+
+ other-modules:
+  Workflow.Test
+
+ build-depends:
+    base >=4.7 && <5
+  , workflow-windows
+  , hspec ==2.2.*
+  , QuickCheck ==2.8.*