workflow-types 0.0.0 → 0.0.1
raw patch · 13 files changed
+1377/−1538 lines, 13 filesdep +spirosdep +textdep −Earleydep −comonaddep −deepseqsetup-changednew-component:exe:example-workflow-types
Dependencies added: spiros, text
Dependencies removed: Earley, comonad, deepseq, hashable, semigroups
Files
- LICENSE +22/−22
- Setup.hs +3/−3
- executables/Main.hs +4/−4
- sources/Workflow/Core.hs +33/−31
- sources/Workflow/Example.hs +11/−12
- sources/Workflow/Execute.hs +131/−126
- sources/Workflow/Extra.hs +17/−26
- sources/Workflow/Keys.hs +488/−486
- sources/Workflow/Lens.hs +44/−0
- sources/Workflow/Parser.hs +0/−146
- sources/Workflow/Reexports.hs +7/−7
- sources/Workflow/Types.hs +537/−606
- workflow-types.cabal +80/−69
LICENSE view
@@ -1,22 +1,22 @@-The MIT License (MIT) - -Copyright (c) 2015 Sam Boosalis - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - +The MIT License (MIT)++Copyright (c) 2015 Sam Boosalis++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+
Setup.hs view
@@ -1,3 +1,3 @@-import Distribution.Simple -main = defaultMain - +import Distribution.Simple+main = defaultMain+
executables/Main.hs view
@@ -1,4 +1,4 @@-import qualified Workflow.Example - -main = do - Workflow.Example.main +import qualified Workflow.Example++main = do+ Workflow.Example.main
sources/Workflow/Core.hs view
@@ -1,31 +1,33 @@-{-| Automate keyboard\/mouse\/clipboard\/application interaction. - -the core types that define platform-diagnostic workflows, -as well as helpers for parsing keychords and implementing backends. - -(see 'WorkflowF', 'MonadWorkflow', 'Key', 'press', 'WorkflowD') - --} -module Workflow.Core - ( module Workflow.Types - , module Workflow.Execute - , module Workflow.Keys - , module Workflow.Reexports - ) - where -import Workflow.Types -import Workflow.Execute -import Workflow.Keys -import Workflow.Reexports - -{-TODO (Doesn't work) - -Re-exports "Control.Monad.Catch", instances only. -By re-exporting these instances ourselves (e.g. @instance MonadThrow IO@), -we save clients from explicitly depending on the @exceptions@ package -in their @build-depends@. - - , module Control.Monad.Catch -import qualified Control.Monad.Catch () - --} +{-| Automate keyboard\/mouse\/clipboard\/application interaction.++the core types that define platform-diagnostic workflows,+as well as helpers for parsing keychords and implementing backends.++(see 'WorkflowF', 'MonadWorkflow', 'Key', 'press', 'WorkflowD')++-}+module Workflow.Core+ ( module Workflow.Types+ , module Workflow.Lens+ , module Workflow.Execute+ , module Workflow.Keys+ , module Workflow.Reexports+ )+ where+import Workflow.Types+import Workflow.Lens+import Workflow.Execute+import Workflow.Keys++{-TODO (Doesn't work)++Re-exports "Control.Monad.Catch", instances only.+By re-exporting these instances ourselves (e.g. @instance MonadThrow IO@),+we save clients from explicitly depending on the @exceptions@ package+in their @build-depends@.++ , module Control.Monad.Catch+import qualified Control.Monad.Catch ()++-}+import Workflow.Reexports
sources/Workflow/Example.hs view
@@ -1,12 +1,11 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -module Workflow.Example where -import Workflow.Core -import qualified Workflow.Parser - -{- -stack build && stack exec -- workflow-types-example --} - -main = do - print $ readEmacsKeySequence "H-S-t H-l" -- "re-open tab", then "jump to url bar" - +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module Workflow.Example where+import Workflow.Core++{-+stack build && stack exec -- example-workflow-types+-}++main = do+ print $ readEmacsKeySequence "H-S-t H-l" -- "re-open tab", then "jump to url bar"+
sources/Workflow/Execute.hs view
@@ -1,126 +1,131 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RecordWildCards #-} -{-# LANGUAGE RankNTypes #-} -module Workflow.Execute where -import Workflow.Types - -import Control.Monad.Trans.Free (iterT) - -import Control.Monad.IO.Class -import Control.Concurrent (threadDelay) -import Numeric.Natural - - -{-| An explicit "typeclass dictionary" for interpreting a 'MonadWorkflow'. - -i.e. a generic handler/interpreter (product type) -for 'WorkflowF' effects (a sum type). - -e.g. - -@ -WorkflowD IO -@ - -template: - -@ -myDictionary :: (MonadIO m) => WorkflowD m -myDictionary = WorkflowD{..} - where - _sendKeyChord = - _sendText = - - _sendMouseClick = - _sendMouseScroll = - - _getClipboard = - _setClipboard = - - _currentApplication = - _openApplication = - _openURL = - -runWorkflowByMy :: (MonadIO m) => WorkflowT m a -> m a -runWorkflowByMy = runWorkflowByT myDictionary -@ - -'Delay' is elided, as its implementation can use -cross-platform 'IO' ('threadDelay'). - -see 'runWorkflowByT' - --} -data WorkflowD m = WorkflowD - { _sendKeyChord :: [Modifier] -> Key -> m () - , _sendText :: String -> m () - - , _sendMouseClick :: [Modifier] -> Natural -> MouseButton -> m () - , _sendMouseScroll :: [Modifier] -> MouseScroll -> Natural -> m () - - , _getClipboard :: m Clipboard - , _setClipboard :: (Clipboard -> m ()) - - , _currentApplication :: m Application - , _openApplication :: Application -> m () - - , _openURL :: URL -> m () - - -- , _delay :: MilliSeconds -> m () - } -- deriving (Functor) - --------------------------------------------------------------------------------- - -{-| - -e.g. - -@ -shellDictionary :: WorkflowD IO -shellDictionary = WorkflowD{..} - where - '_getClipboard' = shell $ "pbpaste" - '_setClipboard' s = shell $ "echo "++(shellEscape s)++"| pbcopy" >> return () - ... - -runWorkflowByShell :: (MonadIO m) => 'WorkflowT' m a -> m a -runWorkflowByShell = runWorkflowByT shellDictionary - --- specializeable: --- runWorkflowByShell :: 'Workflow' a -> IO a -@ - --} -runWorkflowByT - :: forall m a. (MonadIO m) - -- => CoWorkflowT (m a) - => WorkflowD m - -> WorkflowT m a - -> m a --- runWorkflowByT CoWorkflowF{..} = iterT go -runWorkflowByT WorkflowD{..} = iterT go - where - - go :: WorkflowF (m a) -> m a - go = \case - - SendKeyChord flags key k -> _sendKeyChord flags key >> k - SendText s k -> _sendText s >> k - - SendMouseClick flags n button k -> _sendMouseClick flags n button >> k - SendMouseScroll flags scrolling n k -> _sendMouseScroll flags scrolling n >> k - - GetClipboard f -> _getClipboard >>= f - SetClipboard s k -> _setClipboard s >> k - - CurrentApplication f -> _currentApplication >>= f - OpenApplication app k -> _openApplication app >> k - OpenURL url k -> _openURL url >> k - - Delay t k -> delayMilliseconds t >> k - -- 1,000 µs is 1ms - -delayMilliseconds :: (MonadIO m) => Int -> m () -delayMilliseconds = liftIO . threadDelay . (*1000) - -delaySeconds :: (MonadIO m) => Int -> m () -delaySeconds = delayMilliseconds . (*1000) +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+module Workflow.Execute where+import Workflow.Types++import Control.Monad.Trans.Free (iterT)++import Control.Monad.IO.Class+import Control.Concurrent (threadDelay)+import Numeric.Natural++{-| a function that can exectue any workflow, via IO.+-}+newtype ExecuteWorkflow = ExecuteWorkflow { getExecuteWorkflow ::+ (forall n x. (MonadIO n) => WorkflowT n x -> n x)+}++{-| An explicit "typeclass dictionary" for interpreting a 'MonadWorkflow'.++i.e. a generic handler/interpreter (product type)+for 'WorkflowF' effects (a sum type).++e.g.++@+WorkflowD IO+@++template:++@+myDictionary :: (MonadIO m) => WorkflowD m+myDictionary = WorkflowD{..}+ where+ _sendKeyChord =+ _sendText =++ _sendMouseClick =+ _sendMouseScroll =++ _getClipboard =+ _setClipboard =++ _currentApplication =+ _openApplication =+ _openURL =++runWorkflowByMy :: (MonadIO m) => WorkflowT m a -> m a+runWorkflowByMy = runWorkflowByT myDictionary+@++'Delay' is elided, as its implementation can use+cross-platform 'IO' ('threadDelay').++see 'runWorkflowByT'++-}+data WorkflowD m = WorkflowD+ { _sendKeyChord :: [Modifier] -> Key -> m ()+ , _sendText :: String -> m ()++ , _sendMouseClick :: [Modifier] -> Natural -> MouseButton -> m ()+ , _sendMouseScroll :: [Modifier] -> MouseScroll -> Natural -> m ()++ , _getClipboard :: m Clipboard+ , _setClipboard :: (Clipboard -> m ())++ , _currentApplication :: m Application+ , _openApplication :: Application -> m ()++ , _openURL :: URL -> m ()++ -- , _delay :: MilliSeconds -> m ()+ } -- deriving (Functor)++--------------------------------------------------------------------------------++{-|++e.g.++@+shellDictionary :: WorkflowD IO+shellDictionary = WorkflowD{..}+ where+ '_getClipboard' = shell $ "pbpaste"+ '_setClipboard' s = shell $ "echo "++(shellEscape s)++"| pbcopy" >> return ()+ ...++runWorkflowByShell :: (MonadIO m) => 'WorkflowT' m a -> m a+runWorkflowByShell = runWorkflowByT shellDictionary++-- specializeable:+-- runWorkflowByShell :: 'Workflow' a -> IO a+@++-}+runWorkflowByT+ :: forall m a. (MonadIO m)+ -- => CoWorkflowT (m a)+ => WorkflowD m+ -> WorkflowT m a+ -> m a+-- runWorkflowByT CoWorkflowF{..} = iterT go+runWorkflowByT WorkflowD{..} = iterT go+ where++ go :: WorkflowF (m a) -> m a+ go = \case++ SendKeyChord flags key k -> _sendKeyChord flags key >> k+ SendText s k -> _sendText s >> k++ SendMouseClick flags n button k -> _sendMouseClick flags n button >> k+ SendMouseScroll flags scrolling n k -> _sendMouseScroll flags scrolling n >> k++ GetClipboard f -> _getClipboard >>= f+ SetClipboard s k -> _setClipboard s >> k++ CurrentApplication f -> _currentApplication >>= f+ OpenApplication app k -> _openApplication app >> k+ OpenURL url k -> _openURL url >> k++ Delay t k -> delayMilliseconds t >> k+ -- 1,000 µs is 1ms++delayMilliseconds :: (MonadIO m) => Int -> m ()+delayMilliseconds = liftIO . threadDelay . (*1000)++delaySeconds :: (MonadIO m) => Int -> m ()+delaySeconds = delayMilliseconds . (*1000) --TODO rm
sources/Workflow/Extra.hs view
@@ -1,26 +1,17 @@-module Workflow.Extra - ( module Workflow.Extra - , module X - ) where - -import Control.DeepSeq as X (NFData) -import Data.Hashable as X (Hashable) -import Data.Semigroup as X (Semigroup) -import Control.Monad.Catch as X (MonadThrow(..)) - -import Data.Data as X (Data) -import GHC.Generics as X (Generic) -import Control.Arrow as X ((>>>)) -import Control.Monad as X ((>=>)) -import Data.Function as X ((&),on) -import Data.Foldable as X (traverse_) - -import Control.Exception (ErrorCall(..)) - -(-:) :: a -> b -> (a,b) -(-:) = (,) -infix 1 -: - -failed :: (MonadThrow m) => String -> m a -failed = ErrorCall >>> throwM - +{-# LANGUAGE NoImplicitPrelude #-}+module Workflow.Extra+ ( module Workflow.Extra+ , module Prelude.Spiros+ , module X+ ) where++import Control.Monad.Catch as X (MonadThrow(..))++import Control.Exception (ErrorCall(..))+import Control.Monad as X++import Prelude.Spiros++failed :: (MonadThrow m) => String -> m a+failed = ErrorCall >>> throwM+
sources/Workflow/Keys.hs view
@@ -1,486 +1,488 @@-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} -module Workflow.Keys where --TODO mv to workflow-derived -import Workflow.Types -import Workflow.Extra - -import Data.List.Split - -import qualified Data.Map.Strict as Map -import Data.Map.Strict (Map) - --------------------------------------------------------------------------------- - -{-| Parses and executes a keyboard shortcut. (via 'readKeySequence' and 'sendKeyChord'). - -* more convenient than manually constructing 'Modifier's and 'Key's. -* but, (safely) partial - -e.g. compare: - -@ -press "H-S-t H-l" -@ - -to: - -@ -'traverse_' 'sendKeyChord'' - [ 'KeyChord' ['HyperModifier', 'ShiftModifier'] 'TKey' - , 'KeyChord' ['HyperModifier') 'LKey' - ] -@ - -(a keyboard shortcut to "re-open tab, then jump to url bar") - -'throwM's on a "syntax error" - -The default syntax is inspired by Emacs: - -@ -press = 'press'' 'defaultKeyChordSyntax' -@ - --} -press :: (MonadWorkflow m, MonadThrow m) => String -> m () -press = press' defaultKeyChordSyntax - -{-| - ->>> readEmacsKeySequence "H-S-t H-l" -Just [([HyperModifier,ShiftModifier],TKey),([HyperModifier],LKey)] - -@='readEmacsKeySequence' 'emacsKeyChordSyntax'@ - --} -readEmacsKeySequence :: String -> Maybe KeySequence -readEmacsKeySequence = readKeySequence emacsKeyChordSyntax - -{-| - ->>> readEmacsKeyChord "H-S-t" -Just ([HyperModifier,ShiftModifier],TKey) - -@='readEmacsKeyChord' 'emacsKeyChordSyntax'@ - --} -readEmacsKeyChord :: String -> Maybe KeySequence -readEmacsKeyChord = readKeySequence emacsKeyChordSyntax - -{- | - ->>> readEmacsModifier "H" -Just HyperModifier - -@='readModifier' 'emacsModifierSyntax'@ - --} -readEmacsModifier :: String -> Maybe Modifier -readEmacsModifier = readModifier emacsModifierSyntax - -{- | - ->>> readEmacsKey "<tab>" -Just TabKey - -@='readKey' 'emacsKeySyntax'@ - --} -readEmacsKey :: String -> Maybe KeyChord -readEmacsKey = readKey emacsKeySyntax - --------------------------------------------------------------------------------- - -{-| Build your own 'press'. e.g. - -@ -import "Workflow.Core" hiding (press) - -press = press' KeyChordSyntax{..} - -modifierSyntax :: ModifierSyntax -modifierSyntax = defaultModifierSyntax -- defaulting - -keySyntax :: KeySyntax -- overriding -keySyntax = Map.fromList - [ ... - ] - -@ --} -press' :: (MonadWorkflow m, MonadThrow m) => KeyChordSyntax -> String -> m () -press' syntax s = go s - - where - go = (readKeySequence syntax >>> __cast__) >=> traverse_ sendKeyChord' - __cast__ = \case - Nothing -> __fail__ - Just [] -> __fail__ --TODO? readKeySequence :: MonadThrow m => String -> m KeySequence - Just ks -> return ks --TODO NonEmpty - - __fail__ = failed $ "syntax error: {{Workflow.Keys.press "++(show s)++"}}" - -- TODO? Control.Monad.Fail (MonadFail(..)) - -readKeySequence :: KeyChordSyntax -> String -> Maybe KeySequence --TODO Either ReadKeySequenceError / ErrorReadingKeySequence -readKeySequence syntax --TODO plural? --TODO make extensible with Map Char Key and Map String Modifier and inner-div and outer-div - = splitOn " " >>> fmap (splitOn "-") >>> traverse (readKeyChord syntax) - -- >>> fmap concat - -readKeyChord :: KeyChordSyntax -> [String] -> Maybe KeyChord -readKeyChord KeyChordSyntax{..} = \case - [] -> Nothing - s@(_:_) -> do - ms <- traverse (readModifier modifierSyntax) (init s) --NOTE total, TODO prove with NonEmpty.init - k <- (readKey keySyntax) (last s) --NOTE total --TODO munch uppercase until lwoer - return $ addMods ms k - --- | surjective, non-injective. -readModifier :: ModifierSyntax -> String -> Maybe Modifier -readModifier = (flip Map.lookup) - --- | -readKey :: KeySyntax -> String -> Maybe KeyChord --TODO string for non-alphanums like <spc> -readKey = (flip Map.lookup) - --------------------------------------------------------------------------------- - -{-| A table for parsing strings of modifiers and keys. - --} -data KeyChordSyntax = KeyChordSyntax - { modifierSyntax :: ModifierSyntax - , keySyntax :: KeySyntax - } deriving (Show,Read,Eq,Ord,Data,Generic) -instance NFData KeyChordSyntax - --- | '<>' overrides (i.e. right-biased i.e. pick the last). -instance Monoid KeyChordSyntax where - mempty = KeyChordSyntax mempty mempty - mappend (KeyChordSyntax m1 k1) (KeyChordSyntax m2 k2) = KeyChordSyntax{..} - where - modifierSyntax = Map.unionWith (curry snd) m1 m2 - keySyntax = Map.unionWith (curry snd) k1 k2 - -type ModifierSyntax = Map String Modifier - -type KeySyntax = Map String KeyChord - --- | @= 'emacsKeyChordSyntax'@ -defaultKeyChordSyntax :: KeyChordSyntax -defaultKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax - --- | @= 'emacsModifierSyntax'@ -defaultModifierSyntax :: ModifierSyntax -defaultModifierSyntax = emacsModifierSyntax - --- | @= 'emacsKeySyntax'@ -defaultKeySyntax :: KeySyntax -defaultKeySyntax = emacsKeySyntax - --- | @= 'KeyChordSyntax' 'defaultModifierSyntax' 'defaultKeySyntax'@ -emacsKeyChordSyntax :: KeyChordSyntax -emacsKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax - --- | (see source) -emacsModifierSyntax :: ModifierSyntax -emacsModifierSyntax = Map.fromList - [ "M" -: MetaModifier - , "H" -: HyperModifier --TODO C - , "C" -: ControlModifier --TODO N / R / L - , "O" -: OptionModifier --TODO A - , "A" -: OptionModifier - , "S" -: ShiftModifier - , "F" -: FunctionModifier - ] - -{- | - -follows <http://emacswiki.org/emacs/EmacsKeyNotation Emacs keybinding syntax>, with some differences: - -* non-modifier uppercase alphabetic characters are not shifted, for consistency: - - * e.g. use @"M-S-a"@, not @"M-A"@ - * e.g. but @"M-:"@ and @"M-S-;"@ can both be used - -* non-alphanumeric characters can be in angle brackets: - - * e.g. use @"C-<tab>"@, not @"C-TAB"@ - * e.g. but @"C-\t"@ can be used - -(see source) - --} -emacsKeySyntax :: KeySyntax --TODO newtype, def, IsList --TODO modules, neither explicit nor implicit param -emacsKeySyntax = Map.fromList - [ "a" -: KeyChord [ ] AKey - , "A" -: KeyChord [ShiftModifier] AKey - , "b" -: KeyChord [ ] BKey - , "B" -: KeyChord [ShiftModifier] BKey - , "c" -: KeyChord [ ] CKey - , "C" -: KeyChord [ShiftModifier] CKey - , "d" -: KeyChord [ ] DKey - , "D" -: KeyChord [ShiftModifier] DKey - , "e" -: KeyChord [ ] EKey - , "E" -: KeyChord [ShiftModifier] EKey - , "f" -: KeyChord [ ] FKey - , "F" -: KeyChord [ShiftModifier] FKey - , "g" -: KeyChord [ ] GKey - , "G" -: KeyChord [ShiftModifier] GKey - , "h" -: KeyChord [ ] HKey - , "H" -: KeyChord [ShiftModifier] HKey - , "i" -: KeyChord [ ] IKey - , "I" -: KeyChord [ShiftModifier] IKey - , "j" -: KeyChord [ ] JKey - , "J" -: KeyChord [ShiftModifier] JKey - , "k" -: KeyChord [ ] KKey - , "K" -: KeyChord [ShiftModifier] KKey - , "l" -: KeyChord [ ] LKey - , "L" -: KeyChord [ShiftModifier] LKey - , "m" -: KeyChord [ ] MKey - , "M" -: KeyChord [ShiftModifier] MKey - , "n" -: KeyChord [ ] NKey - , "N" -: KeyChord [ShiftModifier] NKey - , "o" -: KeyChord [ ] OKey - , "O" -: KeyChord [ShiftModifier] OKey - , "p" -: KeyChord [ ] PKey - , "P" -: KeyChord [ShiftModifier] PKey - , "q" -: KeyChord [ ] QKey - , "Q" -: KeyChord [ShiftModifier] QKey - , "r" -: KeyChord [ ] RKey - , "R" -: KeyChord [ShiftModifier] RKey - , "s" -: KeyChord [ ] SKey - , "S" -: KeyChord [ShiftModifier] SKey - , "t" -: KeyChord [ ] TKey - , "T" -: KeyChord [ShiftModifier] TKey - , "u" -: KeyChord [ ] UKey - , "U" -: KeyChord [ShiftModifier] UKey - , "v" -: KeyChord [ ] VKey - , "V" -: KeyChord [ShiftModifier] VKey - , "w" -: KeyChord [ ] WKey - , "W" -: KeyChord [ShiftModifier] WKey - , "x" -: KeyChord [ ] XKey - , "X" -: KeyChord [ShiftModifier] XKey - , "y" -: KeyChord [ ] YKey - , "Y" -: KeyChord [ShiftModifier] YKey - , "z" -: KeyChord [ ] ZKey - , "Z" -: KeyChord [ShiftModifier] ZKey - - , "0" -: KeyChord [ ] ZeroKey - , ")" -: KeyChord [ShiftModifier] ZeroKey - , "1" -: KeyChord [ ] OneKey - , "!" -: KeyChord [ShiftModifier] OneKey - , "2" -: KeyChord [ ] TwoKey - , "@" -: KeyChord [ShiftModifier] TwoKey - , "3" -: KeyChord [ ] ThreeKey - , "#" -: KeyChord [ShiftModifier] ThreeKey - , "4" -: KeyChord [ ] FourKey - , "$" -: KeyChord [ShiftModifier] FourKey - , "5" -: KeyChord [ ] FiveKey - , "%" -: KeyChord [ShiftModifier] FiveKey - , "6" -: KeyChord [ ] SixKey - , "^" -: KeyChord [ShiftModifier] SixKey - , "7" -: KeyChord [ ] SevenKey - , "&" -: KeyChord [ShiftModifier] SevenKey - , "8" -: KeyChord [ ] EightKey - , "*" -: KeyChord [ShiftModifier] EightKey - , "9" -: KeyChord [ ] NineKey - , "(" -: KeyChord [ShiftModifier] NineKey - - , "`" -: KeyChord [ ] GraveKey - , "~" -: KeyChord [ShiftModifier] GraveKey - , "<dash>" -: KeyChord [ ] MinusKey - , "-" -: KeyChord [ ] MinusKey --TODO fails - , "_" -: KeyChord [ShiftModifier] MinusKey - , "=" -: KeyChord [ ] EqualKey - , "+" -: KeyChord [ShiftModifier] EqualKey - , "[" -: KeyChord [ ] LeftBracketKey - , "{" -: KeyChord [ShiftModifier] LeftBracketKey - , "]" -: KeyChord [ ] RightBracketKey - , "}" -: KeyChord [ShiftModifier] RightBracketKey - , "\\" -: KeyChord [ ] BackslashKey - , "|" -: KeyChord [ShiftModifier] BackslashKey - , ";" -: KeyChord [ ] SemicolonKey - , ":" -: KeyChord [ShiftModifier] SemicolonKey - , "'" -: KeyChord [ ] QuoteKey - , "\"" -: KeyChord [ShiftModifier] QuoteKey - , "," -: KeyChord [ ] CommaKey - , "<" -: KeyChord [ShiftModifier] CommaKey - , "." -: KeyChord [ ] PeriodKey - , ">" -: KeyChord [ShiftModifier] PeriodKey - , "/" -: KeyChord [ ] SlashKey - , "?" -: KeyChord [ShiftModifier] SlashKey - , " " -: KeyChord [ ] SpaceKey - , "\t" -: KeyChord [ ] TabKey - , "\n" -: KeyChord [ ] ReturnKey - - , "<spc>"-: SimpleKeyChord SpaceKey - , "<tab>"-: SimpleKeyChord TabKey - , "<ret>"-: SimpleKeyChord ReturnKey - , "<del>"-: SimpleKeyChord DeleteKey - , "<esc>"-: SimpleKeyChord EscapeKey - - , "<up>" -: SimpleKeyChord UpArrowKey - , "<down>" -: SimpleKeyChord DownArrowKey - , "<left>" -: SimpleKeyChord LeftArrowKey - , "<right>"-: SimpleKeyChord RightArrowKey - - , "<f1>" -: SimpleKeyChord F1Key - , "<f2>" -: SimpleKeyChord F2Key - , "<f3>" -: SimpleKeyChord F3Key - , "<f4>" -: SimpleKeyChord F4Key - , "<f5>" -: SimpleKeyChord F5Key - , "<f6>" -: SimpleKeyChord F6Key - , "<f7>" -: SimpleKeyChord F7Key - , "<f8>" -: SimpleKeyChord F8Key - , "<f9>" -: SimpleKeyChord F9Key - , "<f10>"-: SimpleKeyChord F10Key - , "<f11>"-: SimpleKeyChord F11Key - , "<f12>"-: SimpleKeyChord F12Key - , "<f13>"-: SimpleKeyChord F13Key - , "<f14>"-: SimpleKeyChord F14Key - , "<f15>"-: SimpleKeyChord F15Key - , "<f16>"-: SimpleKeyChord F16Key - , "<f17>"-: SimpleKeyChord F17Key - , "<f18>"-: SimpleKeyChord F18Key - , "<f19>"-: SimpleKeyChord F19Key - , "<f20>"-: SimpleKeyChord F20Key - ] - --------------------------------------------------------------------------------- - --- | appends modifiers -addMods :: [Modifier] -> KeyChord -> KeyChord -addMods ms kc = foldr addMod kc ms - --- | appends a modifier -addMod :: Modifier -> KeyChord -> KeyChord -addMod m (ms, k) = (m:ms, k) --- false positive nonexhaustive warning with the KeyChord pattern. fixed in ghc8? --- addMod m (KeyChord ms k) = KeyChord (m:ms) k - --------------------------------------------------------------------------------- - -{-TODO - -Is The benefit of avoiding a parser library as a dependency worth the awkwardness? - --} - -{- the keychord that would insert the character into the application. - ->>> char2keychord '@' :: Maybe KeyChord -Just ([ShiftModifier], TwoKey) - -some characters cannot be represented as keypresses, like some non-printable characters -(in arbitrary applications, not just the terminal emulator): - ->>> char2keychord '\0' :: Maybe KeyChord -Nothing - -prop> case char2keychord c of { Just ([],_) -> True; Just ([ShiftModifier],_) -> True; Nothing -> True; _ -> False } - --} -char2keychord :: (MonadThrow m) => Char -> m KeyChord -char2keychord c = case c of - - 'a' -> return $ KeyChord [ ] AKey - 'A' -> return $ KeyChord [ShiftModifier] AKey - 'b' -> return $ KeyChord [ ] BKey - 'B' -> return $ KeyChord [ShiftModifier] BKey - 'c' -> return $ KeyChord [ ] CKey - 'C' -> return $ KeyChord [ShiftModifier] CKey - 'd' -> return $ KeyChord [ ] DKey - 'D' -> return $ KeyChord [ShiftModifier] DKey - 'e' -> return $ KeyChord [ ] EKey - 'E' -> return $ KeyChord [ShiftModifier] EKey - 'f' -> return $ KeyChord [ ] FKey - 'F' -> return $ KeyChord [ShiftModifier] FKey - 'g' -> return $ KeyChord [ ] GKey - 'G' -> return $ KeyChord [ShiftModifier] GKey - 'h' -> return $ KeyChord [ ] HKey - 'H' -> return $ KeyChord [ShiftModifier] HKey - 'i' -> return $ KeyChord [ ] IKey - 'I' -> return $ KeyChord [ShiftModifier] IKey - 'j' -> return $ KeyChord [ ] JKey - 'J' -> return $ KeyChord [ShiftModifier] JKey - 'k' -> return $ KeyChord [ ] KKey - 'K' -> return $ KeyChord [ShiftModifier] KKey - 'l' -> return $ KeyChord [ ] LKey - 'L' -> return $ KeyChord [ShiftModifier] LKey - 'm' -> return $ KeyChord [ ] MKey - 'M' -> return $ KeyChord [ShiftModifier] MKey - 'n' -> return $ KeyChord [ ] NKey - 'N' -> return $ KeyChord [ShiftModifier] NKey - 'o' -> return $ KeyChord [ ] OKey - 'O' -> return $ KeyChord [ShiftModifier] OKey - 'p' -> return $ KeyChord [ ] PKey - 'P' -> return $ KeyChord [ShiftModifier] PKey - 'q' -> return $ KeyChord [ ] QKey - 'Q' -> return $ KeyChord [ShiftModifier] QKey - 'r' -> return $ KeyChord [ ] RKey - 'R' -> return $ KeyChord [ShiftModifier] RKey - 's' -> return $ KeyChord [ ] SKey - 'S' -> return $ KeyChord [ShiftModifier] SKey - 't' -> return $ KeyChord [ ] TKey - 'T' -> return $ KeyChord [ShiftModifier] TKey - 'u' -> return $ KeyChord [ ] UKey - 'U' -> return $ KeyChord [ShiftModifier] UKey - 'v' -> return $ KeyChord [ ] VKey - 'V' -> return $ KeyChord [ShiftModifier] VKey - 'w' -> return $ KeyChord [ ] WKey - 'W' -> return $ KeyChord [ShiftModifier] WKey - 'x' -> return $ KeyChord [ ] XKey - 'X' -> return $ KeyChord [ShiftModifier] XKey - 'y' -> return $ KeyChord [ ] YKey - 'Y' -> return $ KeyChord [ShiftModifier] YKey - 'z' -> return $ KeyChord [ ] ZKey - 'Z' -> return $ KeyChord [ShiftModifier] ZKey - - '0' -> return $ KeyChord [ ] ZeroKey - ')' -> return $ KeyChord [ShiftModifier] ZeroKey - '1' -> return $ KeyChord [ ] OneKey - '!' -> return $ KeyChord [ShiftModifier] OneKey - '2' -> return $ KeyChord [ ] TwoKey - '@' -> return $ KeyChord [ShiftModifier] TwoKey - '3' -> return $ KeyChord [ ] ThreeKey - '#' -> return $ KeyChord [ShiftModifier] ThreeKey - '4' -> return $ KeyChord [ ] FourKey - '$' -> return $ KeyChord [ShiftModifier] FourKey - '5' -> return $ KeyChord [ ] FiveKey - '%' -> return $ KeyChord [ShiftModifier] FiveKey - '6' -> return $ KeyChord [ ] SixKey - '^' -> return $ KeyChord [ShiftModifier] SixKey - '7' -> return $ KeyChord [ ] SevenKey - '&' -> return $ KeyChord [ShiftModifier] SevenKey - '8' -> return $ KeyChord [ ] EightKey - '*' -> return $ KeyChord [ShiftModifier] EightKey - '9' -> return $ KeyChord [ ] NineKey - '(' -> return $ KeyChord [ShiftModifier] NineKey - - '`' -> return $ KeyChord [ ] GraveKey - '~' -> return $ KeyChord [ShiftModifier] GraveKey - '-' -> return $ KeyChord [ ] MinusKey - '_' -> return $ KeyChord [ShiftModifier] MinusKey - '=' -> return $ KeyChord [ ] EqualKey - '+' -> return $ KeyChord [ShiftModifier] EqualKey - '[' -> return $ KeyChord [ ] LeftBracketKey - '{' -> return $ KeyChord [ShiftModifier] LeftBracketKey - ']' -> return $ KeyChord [ ] RightBracketKey - '}' -> return $ KeyChord [ShiftModifier] RightBracketKey - '\\' -> return $ KeyChord [ ] BackslashKey - '|' -> return $ KeyChord [ShiftModifier] BackslashKey - ';' -> return $ KeyChord [ ] SemicolonKey - ':' -> return $ KeyChord [ShiftModifier] SemicolonKey - '\'' -> return $ KeyChord [ ] QuoteKey - '"' -> return $ KeyChord [ShiftModifier] QuoteKey - ',' -> return $ KeyChord [ ] CommaKey - '<' -> return $ KeyChord [ShiftModifier] CommaKey - '.' -> return $ KeyChord [ ] PeriodKey - '>' -> return $ KeyChord [ShiftModifier] PeriodKey - '/' -> return $ KeyChord [ ] SlashKey - '?' -> return $ KeyChord [ShiftModifier] SlashKey - ' ' -> return $ KeyChord [ ] SpaceKey - '\t' -> return $ KeyChord [ ] TabKey - '\n' -> return $ KeyChord [ ] ReturnKey - - _ -> failed $ "{{ char2keychord "++(show c)++" }} not an ASCII, printable character" - +{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}+module Workflow.Keys where --TODO mv to workflow-derived+import Workflow.Extra+import Workflow.Types+import Workflow.Lens++import Data.List.Split++import qualified Data.Map.Strict as Map+import Data.Map.Strict (Map)++--------------------------------------------------------------------------------++{-| Parses and executes a keyboard shortcut. (via 'readKeySequence' and 'sendKeyChord').++* more convenient than manually constructing 'Modifier's and 'Key's.+* but, (safely) partial++e.g. compare:++@+press "H-S-t H-l"+@++to:++@+'traverse_' 'sendKeyChord''+ [ 'KeyChord' ['HyperModifier', 'ShiftModifier'] 'TKey'+ , 'KeyChord' ['HyperModifier') 'LKey'+ ]+@++(a keyboard shortcut to "re-open tab, then jump to url bar")++'throwM's on a "syntax error"++The default syntax is inspired by Emacs:++@+press = 'press'' 'defaultKeyChordSyntax'+@++-}+press :: (MonadWorkflow m, MonadThrow m) => String -> m ()+press = press' defaultKeyChordSyntax++{-|++>>> readEmacsKeySequence "H-S-t H-l"+Just [([HyperModifier,ShiftModifier],TKey),([HyperModifier],LKey)]++@='readEmacsKeySequence' 'emacsKeyChordSyntax'@++-}+readEmacsKeySequence :: String -> Maybe KeySequence+readEmacsKeySequence = readKeySequence emacsKeyChordSyntax++{-|++>>> readEmacsKeyChord "H-S-t"+Just ([HyperModifier,ShiftModifier],TKey)++@='readEmacsKeyChord' 'emacsKeyChordSyntax'@++-}+readEmacsKeyChord :: String -> Maybe KeySequence+readEmacsKeyChord = readKeySequence emacsKeyChordSyntax++{- |++>>> readEmacsModifier "H"+Just HyperModifier++@='readModifier' 'emacsModifierSyntax'@++-}+readEmacsModifier :: String -> Maybe Modifier+readEmacsModifier = readModifier emacsModifierSyntax++{- |++>>> readEmacsKey "<tab>"+Just TabKey++@='readKey' 'emacsKeySyntax'@++-}+readEmacsKey :: String -> Maybe KeyChord+readEmacsKey = readKey emacsKeySyntax++--------------------------------------------------------------------------------++{-| Build your own 'press'. e.g.++@+import "Workflow.Core" hiding (press)++press = press' KeyChordSyntax{..}++modifierSyntax :: ModifierSyntax+modifierSyntax = defaultModifierSyntax -- defaulting++keySyntax :: KeySyntax -- overriding+keySyntax = Map.fromList+ [ ...+ ]++@+-}+press' :: (MonadWorkflow m, MonadThrow m) => KeyChordSyntax -> String -> m ()+press' syntax s = go s++ where+ go = (readKeySequence syntax >>> __cast__) >=> traverse_ sendKeyChord'+ __cast__ = \case+ Nothing -> __fail__+ Just [] -> __fail__ --TODO? readKeySequence :: MonadThrow m => String -> m KeySequence+ Just ks -> return ks --TODO NonEmpty++ __fail__ = failed $ "syntax error: {{Workflow.Keys.press "++(show s)++"}}"+ -- TODO? Control.Monad.Fail (MonadFail(..))++readKeySequence :: KeyChordSyntax -> String -> Maybe KeySequence --TODO Either ReadKeySequenceError / ErrorReadingKeySequence+readKeySequence syntax --TODO plural? --TODO make extensible with Map Char Key and Map String Modifier and inner-div and outer-div+ = splitOn " " >>> fmap (splitOn "-") >>> traverse (readKeyChord syntax)+ -- >>> fmap concat++readKeyChord :: KeyChordSyntax -> [String] -> Maybe KeyChord+readKeyChord KeyChordSyntax{..} = \case+ [] -> Nothing+ s@(_:_) -> do+ ms <- traverse (readModifier modifierSyntax) (init s) --NOTE total, TODO prove with NonEmpty.init+ k <- (readKey keySyntax) (last s) --NOTE total --TODO munch uppercase until lwoer+ return $ addMods ms k++-- | surjective, non-injective.+readModifier :: ModifierSyntax -> String -> Maybe Modifier+readModifier = (flip Map.lookup)++-- |+readKey :: KeySyntax -> String -> Maybe KeyChord --TODO string for non-alphanums like <spc>+readKey = (flip Map.lookup)++--------------------------------------------------------------------------------++{-| A table for parsing strings of modifiers and keys.++-}+data KeyChordSyntax = KeyChordSyntax+ { modifierSyntax :: ModifierSyntax+ , keySyntax :: KeySyntax+ } deriving (Show,Read,Eq,Ord,Data,Generic)+instance NFData KeyChordSyntax++-- | '<>' overrides (i.e. right-biased i.e. pick the last).+instance Monoid KeyChordSyntax where+ mempty = KeyChordSyntax mempty mempty+ mappend (KeyChordSyntax m1 k1) (KeyChordSyntax m2 k2) = KeyChordSyntax{..}+ where+ modifierSyntax = Map.unionWith (curry snd) m1 m2+ keySyntax = Map.unionWith (curry snd) k1 k2++type ModifierSyntax = Map String Modifier++type KeySyntax = Map String KeyChord++-- | @= 'emacsKeyChordSyntax'@+defaultKeyChordSyntax :: KeyChordSyntax+defaultKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax++-- | @= 'emacsModifierSyntax'@+defaultModifierSyntax :: ModifierSyntax+defaultModifierSyntax = emacsModifierSyntax++-- | @= 'emacsKeySyntax'@+defaultKeySyntax :: KeySyntax+defaultKeySyntax = emacsKeySyntax++-- | @= 'KeyChordSyntax' 'defaultModifierSyntax' 'defaultKeySyntax'@+emacsKeyChordSyntax :: KeyChordSyntax+emacsKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax++-- | (see source)+emacsModifierSyntax :: ModifierSyntax+emacsModifierSyntax = Map.fromList+ [ "M" -: MetaModifier+ , "H" -: HyperModifier --TODO C+ , "C" -: ControlModifier --TODO N / R / L+ , "O" -: OptionModifier --TODO A+ , "A" -: OptionModifier+ , "S" -: ShiftModifier+ , "F" -: FunctionModifier+ ]++{- |++follows <http://emacswiki.org/emacs/EmacsKeyNotation Emacs keybinding syntax>, with some differences:++* non-modifier uppercase alphabetic characters are not shifted, for consistency:++ * e.g. use @"M-S-a"@, not @"M-A"@+ * e.g. but @"M-:"@ and @"M-S-;"@ can both be used++* non-alphanumeric characters can be in angle brackets:++ * e.g. use @"C-<tab>"@, not @"C-TAB"@+ * e.g. but @"C-\t"@ can be used++(see source)++-}+emacsKeySyntax :: KeySyntax --TODO newtype, def, IsList --TODO modules, neither explicit nor implicit param+emacsKeySyntax = Map.fromList+ [ "a" -: KeyChord [ ] AKey+ , "A" -: KeyChord [ShiftModifier] AKey+ , "b" -: KeyChord [ ] BKey+ , "B" -: KeyChord [ShiftModifier] BKey+ , "c" -: KeyChord [ ] CKey+ , "C" -: KeyChord [ShiftModifier] CKey+ , "d" -: KeyChord [ ] DKey+ , "D" -: KeyChord [ShiftModifier] DKey+ , "e" -: KeyChord [ ] EKey+ , "E" -: KeyChord [ShiftModifier] EKey+ , "f" -: KeyChord [ ] FKey+ , "F" -: KeyChord [ShiftModifier] FKey+ , "g" -: KeyChord [ ] GKey+ , "G" -: KeyChord [ShiftModifier] GKey+ , "h" -: KeyChord [ ] HKey+ , "H" -: KeyChord [ShiftModifier] HKey+ , "i" -: KeyChord [ ] IKey+ , "I" -: KeyChord [ShiftModifier] IKey+ , "j" -: KeyChord [ ] JKey+ , "J" -: KeyChord [ShiftModifier] JKey+ , "k" -: KeyChord [ ] KKey+ , "K" -: KeyChord [ShiftModifier] KKey+ , "l" -: KeyChord [ ] LKey+ , "L" -: KeyChord [ShiftModifier] LKey+ , "m" -: KeyChord [ ] MKey+ , "M" -: KeyChord [ShiftModifier] MKey+ , "n" -: KeyChord [ ] NKey+ , "N" -: KeyChord [ShiftModifier] NKey+ , "o" -: KeyChord [ ] OKey+ , "O" -: KeyChord [ShiftModifier] OKey+ , "p" -: KeyChord [ ] PKey+ , "P" -: KeyChord [ShiftModifier] PKey+ , "q" -: KeyChord [ ] QKey+ , "Q" -: KeyChord [ShiftModifier] QKey+ , "r" -: KeyChord [ ] RKey+ , "R" -: KeyChord [ShiftModifier] RKey+ , "s" -: KeyChord [ ] SKey+ , "S" -: KeyChord [ShiftModifier] SKey+ , "t" -: KeyChord [ ] TKey+ , "T" -: KeyChord [ShiftModifier] TKey+ , "u" -: KeyChord [ ] UKey+ , "U" -: KeyChord [ShiftModifier] UKey+ , "v" -: KeyChord [ ] VKey+ , "V" -: KeyChord [ShiftModifier] VKey+ , "w" -: KeyChord [ ] WKey+ , "W" -: KeyChord [ShiftModifier] WKey+ , "x" -: KeyChord [ ] XKey+ , "X" -: KeyChord [ShiftModifier] XKey+ , "y" -: KeyChord [ ] YKey+ , "Y" -: KeyChord [ShiftModifier] YKey+ , "z" -: KeyChord [ ] ZKey+ , "Z" -: KeyChord [ShiftModifier] ZKey++ , "0" -: KeyChord [ ] ZeroKey+ , ")" -: KeyChord [ShiftModifier] ZeroKey+ , "1" -: KeyChord [ ] OneKey+ , "!" -: KeyChord [ShiftModifier] OneKey+ , "2" -: KeyChord [ ] TwoKey+ , "@" -: KeyChord [ShiftModifier] TwoKey+ , "3" -: KeyChord [ ] ThreeKey+ , "#" -: KeyChord [ShiftModifier] ThreeKey+ , "4" -: KeyChord [ ] FourKey+ , "$" -: KeyChord [ShiftModifier] FourKey+ , "5" -: KeyChord [ ] FiveKey+ , "%" -: KeyChord [ShiftModifier] FiveKey+ , "6" -: KeyChord [ ] SixKey+ , "^" -: KeyChord [ShiftModifier] SixKey+ , "7" -: KeyChord [ ] SevenKey+ , "&" -: KeyChord [ShiftModifier] SevenKey+ , "8" -: KeyChord [ ] EightKey+ , "*" -: KeyChord [ShiftModifier] EightKey+ , "9" -: KeyChord [ ] NineKey+ , "(" -: KeyChord [ShiftModifier] NineKey++ , "`" -: KeyChord [ ] GraveKey+ , "~" -: KeyChord [ShiftModifier] GraveKey+ , "<dash>" -: KeyChord [ ] MinusKey + , "-" -: KeyChord [ ] MinusKey --TODO fails+ , "_" -: KeyChord [ShiftModifier] MinusKey+ , "=" -: KeyChord [ ] EqualKey+ , "+" -: KeyChord [ShiftModifier] EqualKey+ , "[" -: KeyChord [ ] LeftBracketKey+ , "{" -: KeyChord [ShiftModifier] LeftBracketKey+ , "]" -: KeyChord [ ] RightBracketKey+ , "}" -: KeyChord [ShiftModifier] RightBracketKey+ , "\\" -: KeyChord [ ] BackslashKey+ , "|" -: KeyChord [ShiftModifier] BackslashKey+ , ";" -: KeyChord [ ] SemicolonKey+ , ":" -: KeyChord [ShiftModifier] SemicolonKey+ , "'" -: KeyChord [ ] QuoteKey+ , "\"" -: KeyChord [ShiftModifier] QuoteKey+ , "," -: KeyChord [ ] CommaKey+ , "<" -: KeyChord [ShiftModifier] CommaKey+ , "." -: KeyChord [ ] PeriodKey+ , ">" -: KeyChord [ShiftModifier] PeriodKey+ , "/" -: KeyChord [ ] SlashKey+ , "?" -: KeyChord [ShiftModifier] SlashKey+ , " " -: KeyChord [ ] SpaceKey+ , "\t" -: KeyChord [ ] TabKey+ , "\n" -: KeyChord [ ] ReturnKey++ , "<spc>"-: SimpleKeyChord SpaceKey+ , "<tab>"-: SimpleKeyChord TabKey+ , "<ret>"-: SimpleKeyChord ReturnKey+ , "<del>"-: SimpleKeyChord DeleteKey+ , "<esc>"-: SimpleKeyChord EscapeKey++ , "<up>" -: SimpleKeyChord UpArrowKey+ , "<down>" -: SimpleKeyChord DownArrowKey+ , "<left>" -: SimpleKeyChord LeftArrowKey+ , "<right>"-: SimpleKeyChord RightArrowKey++ , "<f1>" -: SimpleKeyChord F1Key+ , "<f2>" -: SimpleKeyChord F2Key+ , "<f3>" -: SimpleKeyChord F3Key+ , "<f4>" -: SimpleKeyChord F4Key+ , "<f5>" -: SimpleKeyChord F5Key+ , "<f6>" -: SimpleKeyChord F6Key+ , "<f7>" -: SimpleKeyChord F7Key+ , "<f8>" -: SimpleKeyChord F8Key+ , "<f9>" -: SimpleKeyChord F9Key+ , "<f10>"-: SimpleKeyChord F10Key+ , "<f11>"-: SimpleKeyChord F11Key+ , "<f12>"-: SimpleKeyChord F12Key+ , "<f13>"-: SimpleKeyChord F13Key+ , "<f14>"-: SimpleKeyChord F14Key+ , "<f15>"-: SimpleKeyChord F15Key+ , "<f16>"-: SimpleKeyChord F16Key+ , "<f17>"-: SimpleKeyChord F17Key+ , "<f18>"-: SimpleKeyChord F18Key+ , "<f19>"-: SimpleKeyChord F19Key+ , "<f20>"-: SimpleKeyChord F20Key+ ]++--------------------------------------------------------------------------------++-- | appends modifiers+addMods :: [Modifier] -> KeyChord -> KeyChord+addMods ms kc = foldr addMod kc ms++-- | appends a modifier+addMod :: Modifier -> KeyChord -> KeyChord+addMod m (ms, k) = (m:ms, k)+-- false positive nonexhaustive warning with the KeyChord pattern. fixed in ghc8?+-- addMod m (KeyChord ms k) = KeyChord (m:ms) k++--------------------------------------------------------------------------------++{-TODO++Is The benefit of avoiding a parser library as a dependency worth the awkwardness?++-}++{- the keychord that would insert the character into the application.++>>> char2keychord '@' :: Maybe KeyChord+Just ([ShiftModifier], TwoKey)++some characters cannot be represented as keypresses, like some non-printable characters+(in arbitrary applications, not just the terminal emulator):++>>> char2keychord '\0' :: Maybe KeyChord+Nothing++prop> case char2keychord c of { Just ([],_) -> True; Just ([ShiftModifier],_) -> True; Nothing -> True; _ -> False }++-}+char2keychord :: (MonadThrow m) => Char -> m KeyChord+char2keychord c = case c of++ 'a' -> return $ KeyChord [ ] AKey+ 'A' -> return $ KeyChord [ShiftModifier] AKey+ 'b' -> return $ KeyChord [ ] BKey+ 'B' -> return $ KeyChord [ShiftModifier] BKey+ 'c' -> return $ KeyChord [ ] CKey+ 'C' -> return $ KeyChord [ShiftModifier] CKey+ 'd' -> return $ KeyChord [ ] DKey+ 'D' -> return $ KeyChord [ShiftModifier] DKey+ 'e' -> return $ KeyChord [ ] EKey+ 'E' -> return $ KeyChord [ShiftModifier] EKey+ 'f' -> return $ KeyChord [ ] FKey+ 'F' -> return $ KeyChord [ShiftModifier] FKey+ 'g' -> return $ KeyChord [ ] GKey+ 'G' -> return $ KeyChord [ShiftModifier] GKey+ 'h' -> return $ KeyChord [ ] HKey+ 'H' -> return $ KeyChord [ShiftModifier] HKey+ 'i' -> return $ KeyChord [ ] IKey+ 'I' -> return $ KeyChord [ShiftModifier] IKey+ 'j' -> return $ KeyChord [ ] JKey+ 'J' -> return $ KeyChord [ShiftModifier] JKey+ 'k' -> return $ KeyChord [ ] KKey+ 'K' -> return $ KeyChord [ShiftModifier] KKey+ 'l' -> return $ KeyChord [ ] LKey+ 'L' -> return $ KeyChord [ShiftModifier] LKey+ 'm' -> return $ KeyChord [ ] MKey+ 'M' -> return $ KeyChord [ShiftModifier] MKey+ 'n' -> return $ KeyChord [ ] NKey+ 'N' -> return $ KeyChord [ShiftModifier] NKey+ 'o' -> return $ KeyChord [ ] OKey+ 'O' -> return $ KeyChord [ShiftModifier] OKey+ 'p' -> return $ KeyChord [ ] PKey+ 'P' -> return $ KeyChord [ShiftModifier] PKey+ 'q' -> return $ KeyChord [ ] QKey+ 'Q' -> return $ KeyChord [ShiftModifier] QKey+ 'r' -> return $ KeyChord [ ] RKey+ 'R' -> return $ KeyChord [ShiftModifier] RKey+ 's' -> return $ KeyChord [ ] SKey+ 'S' -> return $ KeyChord [ShiftModifier] SKey+ 't' -> return $ KeyChord [ ] TKey+ 'T' -> return $ KeyChord [ShiftModifier] TKey+ 'u' -> return $ KeyChord [ ] UKey+ 'U' -> return $ KeyChord [ShiftModifier] UKey+ 'v' -> return $ KeyChord [ ] VKey+ 'V' -> return $ KeyChord [ShiftModifier] VKey+ 'w' -> return $ KeyChord [ ] WKey+ 'W' -> return $ KeyChord [ShiftModifier] WKey+ 'x' -> return $ KeyChord [ ] XKey+ 'X' -> return $ KeyChord [ShiftModifier] XKey+ 'y' -> return $ KeyChord [ ] YKey+ 'Y' -> return $ KeyChord [ShiftModifier] YKey+ 'z' -> return $ KeyChord [ ] ZKey+ 'Z' -> return $ KeyChord [ShiftModifier] ZKey++ '0' -> return $ KeyChord [ ] ZeroKey+ ')' -> return $ KeyChord [ShiftModifier] ZeroKey+ '1' -> return $ KeyChord [ ] OneKey+ '!' -> return $ KeyChord [ShiftModifier] OneKey+ '2' -> return $ KeyChord [ ] TwoKey+ '@' -> return $ KeyChord [ShiftModifier] TwoKey+ '3' -> return $ KeyChord [ ] ThreeKey+ '#' -> return $ KeyChord [ShiftModifier] ThreeKey+ '4' -> return $ KeyChord [ ] FourKey+ '$' -> return $ KeyChord [ShiftModifier] FourKey+ '5' -> return $ KeyChord [ ] FiveKey+ '%' -> return $ KeyChord [ShiftModifier] FiveKey+ '6' -> return $ KeyChord [ ] SixKey+ '^' -> return $ KeyChord [ShiftModifier] SixKey+ '7' -> return $ KeyChord [ ] SevenKey+ '&' -> return $ KeyChord [ShiftModifier] SevenKey+ '8' -> return $ KeyChord [ ] EightKey+ '*' -> return $ KeyChord [ShiftModifier] EightKey+ '9' -> return $ KeyChord [ ] NineKey+ '(' -> return $ KeyChord [ShiftModifier] NineKey++ '`' -> return $ KeyChord [ ] GraveKey+ '~' -> return $ KeyChord [ShiftModifier] GraveKey+ '-' -> return $ KeyChord [ ] MinusKey+ '_' -> return $ KeyChord [ShiftModifier] MinusKey+ '=' -> return $ KeyChord [ ] EqualKey+ '+' -> return $ KeyChord [ShiftModifier] EqualKey+ '[' -> return $ KeyChord [ ] LeftBracketKey+ '{' -> return $ KeyChord [ShiftModifier] LeftBracketKey+ ']' -> return $ KeyChord [ ] RightBracketKey+ '}' -> return $ KeyChord [ShiftModifier] RightBracketKey+ '\\' -> return $ KeyChord [ ] BackslashKey+ '|' -> return $ KeyChord [ShiftModifier] BackslashKey+ ';' -> return $ KeyChord [ ] SemicolonKey+ ':' -> return $ KeyChord [ShiftModifier] SemicolonKey+ '\'' -> return $ KeyChord [ ] QuoteKey+ '"' -> return $ KeyChord [ShiftModifier] QuoteKey+ ',' -> return $ KeyChord [ ] CommaKey+ '<' -> return $ KeyChord [ShiftModifier] CommaKey+ '.' -> return $ KeyChord [ ] PeriodKey+ '>' -> return $ KeyChord [ShiftModifier] PeriodKey+ '/' -> return $ KeyChord [ ] SlashKey+ '?' -> return $ KeyChord [ShiftModifier] SlashKey+ ' ' -> return $ KeyChord [ ] SpaceKey+ '\t' -> return $ KeyChord [ ] TabKey+ '\n' -> return $ KeyChord [ ] ReturnKey++ _ -> failed $ "{{ char2keychord "++(show c)++" }} not an ASCII, printable character"+
+ sources/Workflow/Lens.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+-- {-# OPTIONS_GHC -ddump-splices #-} -- for `makeFree`++{-|++-}+module Workflow.Lens where+import Workflow.Extra+import Workflow.Types++import Control.Monad.Free.TH (makeFree)+import Control.Monad.Free (MonadFree, liftF)++--------------------------------------------------------------------------------+makeFree ''WorkflowF+-- th staging: the spilce can only access previous declarations++-- | @= 'traverse_' 'sendKeyChord''@+sendKeySequence :: (MonadWorkflow m) => KeySequence -> m ()+sendKeySequence = traverse_ sendKeyChord'++-- | uncurried 'sendKeyChord'+sendKeyChord' :: (MonadWorkflow m) => KeyChord -> m ()+sendKeyChord' (ms,k) = sendKeyChord ms k++--------------------------------------------------------------------------------++fromWorkflows_ :: (MonadWorkflow m) => [Workflow_] -> m ()+fromWorkflows_ = traverse_ (liftF . fromWorkflow_)++fromWorkflow_ :: Workflow_ -> WorkflowF ()+-- fromWorkflow_ :: (MonadWorkflow m) => Workflow_ -> m ()+fromWorkflow_ = \case+ SendKeyChord_ flags key -> SendKeyChord flags key ()+ SendText_ s -> SendText s ()+ SendMouseClick_ flags n button -> SendMouseClick flags n button ()+ SendMouseScroll_ flags scroll n -> SendMouseScroll flags scroll n ()+ SetClipboard_ s -> SetClipboard s ()+ OpenApplication_ app -> OpenApplication app ()+ OpenURL_ url -> OpenURL url ()+ Delay_ t -> Delay t ()+
− sources/Workflow/Parser.hs
@@ -1,146 +0,0 @@-{-# LANGUAGE LambdaCase, ScopedTypeVariables, RankNTypes #-} - -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - -{-| A command line interface for manual integration testing. - - --} -module Workflow.Parser where -import Workflow.Core - -import Text.Earley as E - -import Control.Applicative -import Control.Arrow -import Data.Char -import Data.Function -import System.IO -import Control.Monad.IO.Class - - -{-| - --} -type ExecuteWorkflow = forall x. WorkflowT IO x -> IO x - -- forall x. Workflow x -> IO x - -- No instance for (MonadThrow (Control.Monad.Free.Free WorkflowF)) arising from a use of ‘press’ - -type Workflow' = WorkflowT IO () - -data Action - = Quit - | Help - | Stay (Workflow') - | Pause Int (Workflow') - | Action (Workflow') - --- Maybe (IO ()) - -{- | - -prefix with a number to pause (for that many seconds) before execution. - -prefix with "stay" to disable "alt-tab"ing before execution. - -e.g. - -@ -> help -... -> stay paste -> copy # (Having selected some text topmost (besides the current) window) -> 1000 paste # Wait a second before pasting -> quit -@ - --} -cmdln :: ExecuteWorkflow -> IO () -cmdln runWorkflow = do - hSetBuffering stdout NoBuffering - go - - where - - go = do - putStr prompt - s <- getLine - (evalAction runWorkflow) s & \case - Nothing -> return () - Just io -> do - io - go - - prompt = "> " - -evalAction :: ExecuteWorkflow -> String -> Maybe (IO ()) -evalAction runWorkflow = parseAction >>> runAction runWorkflow - -runAction :: ExecuteWorkflow -> Action -> Maybe (IO ()) -runAction runWorkflow = \case - Quit -> Nothing - Help -> Just help - - Stay w -> Just $ runWorkflow $ do - w - - Pause t w -> Just $ runWorkflow $ do - delay (t*1000) - w - - Action w -> Just $ runWorkflow $ do - press "H-<tab>" - delay 300 - w - -help = do - putStrLn "help" --TODO - -parseAction :: String -> Action -parseAction s = case fst (p (words s)) of - (a:_) -> a - _ -> Help - where - p = E.fullParses (E.parser gAction) ---parseAction s = case fst (E.parser (E.fullParses gAction) s) of - ---gAction :: E.Grammar r Action -gAction = do - - let pWord = E.satisfy (const True) - pWords :: E.Prod r e String String <- E.rule $ - unwords <$> some pWord - - int <- E.rule $ - read <$> E.satisfy (all isDigit) - - pWorkflow :: E.Prod r e String Workflow' <- E.rule $ empty - - <|> (readEmacsKeySequence >>> maybe (return()) sendKeySequence) <$ E.token "press" <*> pWords - <|> (sendText) <$ E.token "insert" <*> pWords - - <|> (getClipboard >>= (liftIO . putStrLn)) <$ E.token "getClipboard" - <|> (setClipboard) <$ E.token "setClipboard" <*> pWords - - -- <|> () <$> E.token "" - -- <|> () <$> E.token "" - - <|> (currentApplication >>= (liftIO . putStrLn)) <$ E.token "currentApplication" - <|> (openApplication) <$ E.token "open" <*> pWords - <|> (openURL) <$ E.token "url" <*> pWords - - <|> (getClipboard >>= sendText) <$ E.token "paste" --- <|> () <$> E.token "" - - -- <|> pure (E.token "paste") *> do - -- getClipboard >>= sendText - - -- pAction :: E.Prod r e String Action <- E.rule $ empty - pAction <- E.rule $ empty - <|> Quit <$ E.token "quit" - <|> Help <$ E.token "help" - <|> Stay <$ E.token "stay" <*> pWorkflow - <|> Pause <$> int <*> pWorkflow - <|> Action <$> pWorkflow - - return pAction
sources/Workflow/Reexports.hs view
@@ -1,7 +1,7 @@--- | -module Workflow.Reexports - ( MonadThrow - , MonadFree - ) where -import Control.Monad.Catch (MonadThrow) -import Control.Monad.Free (MonadFree) +-- | +module Workflow.Reexports+ ( MonadThrow+ , MonadFree+ ) where+import Control.Monad.Catch (MonadThrow)+import Control.Monad.Free (MonadFree)
sources/Workflow/Types.hs view
@@ -1,606 +1,537 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, PatternSynonyms #-} -{-# LANGUAGE TemplateHaskell #-} --- {-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- {-# OPTIONS_GHC -ddump-splices #-} --- for `makeFree` - -{-| - --} -module Workflow.Types where -import Workflow.Extra - -import Control.Monad.Trans.Free (FreeT) -import Control.Comonad.Trans.Cofree (CofreeT) --- import Control.Monad.Free.Church (F) -import Control.Monad.Free (MonadFree, Free, liftF) -import Control.Monad.Free.TH (makeFree) -import Control.Comonad.Cofree (Cofree) --- import Control.Comonad - -import Numeric.Natural ---import GHC.Exts - --------------------------------------------------------------------------------- -{-$ WorkflowF --} - -{-| - --} - -{- | platform-agnostic workflows, -which can be interpreted by platform-specific bindings. - -Naming: "WorkflowF" for "Workflow Functor". - -NOTE: currently, no error codes are returned (only @()@)). -this (1) simplifies bindings and -(2) saves the user from explicitly ignoring action results (e.g. @_ <- getClipboard@). -later, they can be supported, -alongside wrappers that return @()@ and throw @SomeException@ -and provide the same simple API. -since the intented usage of workflows are as user-facing -(often user-written) scripts, and -the monad that satisifes MonadWorkflow will often satisify MonadIO too, -convenient partial functions that throw a helpful error message to stdout -(the error codes should be converted to their error messages) should suffice. -and either way, is strictly better for the user than ignoring, -as the exceptions can always be caught, or not displayed. - --} -data WorkflowF k - = SendKeyChord [Modifier] Key k -- ^ press the 'Key' while the 'Modifier's are held down. sent to the current application. - --TODO | SendKeyChordTo Application [Modifier] Key k -- ^ - --TODO | SendKeyChordTo Window [Modifier] Key k -- ^ - -- versus unary: ([Modifier], Key) - -- rn SendChord - - | SendText String k -- ^ a logical grouping for: (1) unicode support (2) efficiency and (3) debugging. sent to the current application. - - --TODO | SendTextTo Application String k -- ^ - --TODO | SendTextTo Window String k -- ^ - -- sendText = sendTextTo =<< currentApplication - - | SendMouseClick [Modifier] Natural MouseButton k -- ^ click the button, some number of times, holding down the modifiers - -- derived, make method, not constructor. sent to the current application. - - - --TODO | SendMouseClickTo Application [Modifier] Int MouseButton k ^ -- sent to the current application. - -- versus unary: ([Modifier], Natural, MouseButton) - | SendMouseScroll [Modifier] MouseScroll Natural k -- ^ spin the wheel, some number of units*, holding down the modifiers - - | GetClipboard (Clipboard -> k) - | SetClipboard Clipboard k - - | CurrentApplication (Application -> k) -- ^ like getter - | OpenApplication Application k -- ^ like setter - - --TODO | GetApplications ([Application] -> k) - - --TODO | CurrentWindow (Window -> k) - --TODO | ReachWindow Window k - --TODO | GetWindows Application ([Window] -> k) -- ^ an 'Application' has some 'Window's (zero or more on OSX, one or more on Windows/Linux, I think). - - | OpenURL URL k - - | Delay MilliSeconds k -- ^ interpreted as 'threadDelay' on all platforms; included for convenience - - deriving (Functor) - -- deriving (Functor,Data) - --------------------------------------------------------------------------------- - -{-| the non-monadic subset of 'WorkflowF'. -i.e. all cases that return @()@, preserving the previous continuation. - -Naming: "unit workflow", like "traverse_". - --} -data Workflow_ - = SendKeyChord_ [Modifier] Key - | SendText_ String - | SendMouseClick_ [Modifier] Natural MouseButton - | SendMouseScroll_ [Modifier] MouseScroll Natural - | SetClipboard_ Clipboard - | OpenApplication_ Application - | OpenURL_ URL - | Delay_ MilliSeconds - - deriving (Show,Read,Eq,Ord,Data,Generic) -instance NFData Workflow_ - --------------------------------------------------------------------------------- - -{- | abstract interface. - -a monad constraint for "workflow effects" -(just like @MonadState@ is for "state effects"). -Can be used in any monad transformer stack that handles them. - -'WorkflowF' holds the effects. - -'MonadThrow' supports: - -* 'Workflow.Keys.press', if the user's syntax is wrong -* error messages from the underlying system calls (TODO e.g. Win32's @GetLastError()@) - --} -type MonadWorkflow m = (MonadFree WorkflowF m, MonadThrow m) - --- | (without failability) -type MonadWorkflow_ = MonadFree WorkflowF - -{-old -type MonadWorkflow_ m = (MonadFree WorkflowF m) - -without eta-contract: - Illegal deriving item ‘MonadWorkflow_’ --} - ---NOTE MonadThrow for `press`. --- but, does instance MonadThrow (FreeT f m) exist? depends on f? --- yes! depends on m. instance (Functor f, MonadThrow m) => MonadThrow (FreeT f m) - --- class (MonadFree WorkflowF m, MonadThrow m) => MonadWorkflow where --- like `newtype` for constraints --- less automatic - --- {- | for convenience. --- without loss of generality (I don't think) when declaring simple monadic effects (like Kleisli arrows). - --- e.g. - --- @ --- getClipboard :: 'AMonadWorkflow' String -- generalized --- getClipboard :: ('MonadWorkflow' m) => m String -- generalized --- getClipboard :: Free 'WorkflowF' String -- specialized --- @ - --- -} --- type AMonadWorkflow a = forall m. (MonadWorkflow m) => m a - --- {-| Naming: "a unit monad workflow". --- -} --- type AMonadWorkflow_ = (forall m. (MonadWorkflow m) => m ()) - --- | concrete transformer. -type WorkflowT = FreeT WorkflowF - --- | concrete monad. -type Workflow = Free WorkflowF - --------------------------------------------------------------------------------- - -type Clipboard = String - -type Application = String - -type URL = String - -type MilliSeconds = Int --- newtype Time = Time Int deriving (Show,Eq,Ord,Num) --- units package --- milliseconds - --- class IsString TODO needs Free WorkflowF, which must be lifted, --- which isn't better than an explicit insert - - --- {-| --- --- >>> :set -XOverloadedStrings --- >>> "contents" :: Clipboard --- "contents" --- --- -} ---newtype Clipboard_ = Clipboard String - --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData) --- data Clipboard = Clipboard { cbContents :: String, cbFormat :: ClipboardFormat } --- instance IsString UnicodeTextFormat where fromString s = Clipboard s UnicodeTextFormat --- GetClipboardContents --- getClipboard = getClipboardContents<&>cbContents --- runWorkflow must take a mapping (ClipboardFormat -> something) --- maybe: phantom data RawClipboard (format :: ClipboardFormat) = Bytestring --- with reflection class KnownClipboardFormat - --- {-| --- --- >>> :set -XOverloadedStrings --- >>> "Emacs" :: Application --- "Emacs" --- --- -} ---newtype Application_ = Application String - --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData) - --- {-| --- --- >>> :set -XOverloadedStrings --- >>> "https://google.com/" :: URL --- "https://google.com/" --- --- -} ---newtype URL_ = URL String - --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData) ---TODO refined - --------------------------------------------------------------------------------- - -{-| Operating systems always (?) support at least these mouse events. - -Most mice have these three buttons, trackpads have left/right. - --} -data MouseButton - = LeftButton - | MiddleButton - | RightButton - --TODO | XButton -- https://msdn.microsoft.com/en-us/library/windows/desktop/gg153549(v=vs.85).aspx - deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Generic) -instance NFData MouseButton - -{-| Mouse wheel scrolling, vertically and horizontally. - -'ScrollTowards': - -* scrolls up when "natural scrolling" is disabled -* scrolls down when "natural scrolling" is enabled - -TODO check - --} -data MouseScroll - = ScrollTowards -- ScrollUp (from user) - | ScrollAway -- ScrollDown (from user) - | ScrollLeft - | ScrollRight - deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Generic) -instance NFData MouseScroll - --------------------------------------------------------------------------------- - --- {-| Represents @a@ being bound to a keyboard shortcut. --- --- Naming: --- <https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Commands.html> --- --- -} --- data KeyBinding a = KeyBinding KeySequence a ---TODO mv to commands-core or something - -{-| a sequence of key chords make up a keyboard shortcut - -Naming: -<https://www.emacswiki.org/emacs/KeySequence> - --} -type KeySequence = [KeyChord] --- newtype KeySequence = KeySequence (NonEmpty KeyChord) --- ---TODO newtype for non-overlapping IsString --- instance IsString KCs where fromString = --- --TODO refined --- --- press :: KCs -> m() --- - --- an (unordered, no-duplicates) sequence of key --- chords make up a keyboard shortcut --- not a Set for simplicity (e.g. to avoid imports and Ord constraints). ---really? - -{- | represents joitly holding down all the modifiers -while individually press each key down and back up. - -Naming: https://www.emacswiki.org/emacs/Chord - --} -type KeyChord = ([Modifier], Key) --- data KeyChord = KeyChord [Modifier] Key -{- data KeyChord = KeyChord - { kcModifiers :: [Modifier] - , kcKey :: Key - } --} - --- | @pattern KeyChord ms k = (ms,k)@ -pattern KeyChord :: [Modifier] -> Key -> KeyChord -pattern KeyChord ms k = (ms, k) - -pattern SimpleKeyChord :: Key -> KeyChord -pattern SimpleKeyChord k = ([], k) - -{- | modifier keys are keys that can be "held". - -NOTE the escape key tends to be "pressed", not "held", it seems. -(possibly explains its behavior in your terminal emulator?) - -@alt@ is 'OptionModifier'. - --} -data Modifier - = MetaModifier -- ^ fake modifier: Alt on Linux\/Windows, Command on OSX - | HyperModifier -- ^ fake modifier: Control on Linux\/Windows, Command on OSX - | ControlModifier - | OptionModifier --TODO rn Option Alt - | ShiftModifier - | FunctionModifier - deriving (Show,Read,Eq,Ord,Bounded,Enum,Data,Generic) -instance NFData Modifier - -{- | a "cross-platform" keyboard, that has: - -* all keys that exist on standard keyboards. -* plus, 'MetaKey' and 'HyperKey': virtual modifiers to abstract over -common keyboard shortcuts. - -(let me know if you want a type to support cross-platform international keyboards, -i haven't looked into it. you can still use the -platform-specific virtual-key-codes in the dependent packages: -@workflow-linux@, @workflow-osx@, and @workflow-windows@) - --} -data Key - - = MetaKey -- ^ fake key: Alt on Linux\/Windows, Command on OSX - | HyperKey -- ^ fake key: Control on Linux\/Windows, Command on OSX --- Control/Command both have C\/O\/N - - | ControlKey - | CapsLockKey - | ShiftKey - | OptionKey - | FunctionKey - - | GraveKey - | MinusKey - | EqualKey - | DeleteKey - | ForwardDeleteKey - | LeftBracketKey - | RightBracketKey - | BackslashKey - | SemicolonKey - | QuoteKey - | CommaKey - | PeriodKey - | SlashKey - - | TabKey - | SpaceKey - | ReturnKey - - | LeftArrowKey - | RightArrowKey - | DownArrowKey - | UpArrowKey - - | AKey - | BKey - | CKey - | DKey - | EKey - | FKey - | GKey - | HKey - | IKey - | JKey - | KKey - | LKey - | MKey - | NKey - | OKey - | PKey - | QKey - | RKey - | SKey - | TKey - | UKey - | VKey - | WKey - | XKey - | YKey - | ZKey - - | ZeroKey - | OneKey - | TwoKey - | ThreeKey - | FourKey - | FiveKey - | SixKey - | SevenKey - | EightKey - | NineKey - - | EscapeKey - | F1Key - | F2Key - | F3Key - | F4Key - | F5Key - | F6Key - | F7Key - | F8Key - | F9Key - | F10Key - | F11Key - | F12Key - | F13Key - | F14Key - | F15Key - | F16Key - | F17Key - | F18Key - | F19Key - | F20Key - - deriving (Show,Read,Eq,Ord,Bounded,Enum,Data,Generic) -instance NFData Key - --- | All modifiers are keys. -modifier2key :: Modifier -> Key -modifier2key = \case - MetaModifier -> MetaKey - HyperModifier -> HyperKey - ShiftModifier -> ShiftKey - OptionModifier -> OptionKey - ControlModifier -> ControlKey - FunctionModifier -> FunctionKey - --------------------------------------------------------------------------------- -makeFree ''WorkflowF --- th staging: the spilce can only access previous declarations - --- | @= 'traverse_' 'sendKeyChord''@ -sendKeySequence :: (MonadWorkflow m) => KeySequence -> m () -sendKeySequence = traverse_ sendKeyChord' - --- | uncurried 'sendKeyChord' -sendKeyChord' :: (MonadWorkflow m) => KeyChord -> m () -sendKeyChord' (ms,k) = sendKeyChord ms k - --------------------------------------------------------------------------------- - -fromWorkflows_ :: (MonadWorkflow m) => [Workflow_] -> m () -fromWorkflows_ = traverse_ (liftF . fromWorkflow_) - -fromWorkflow_ :: Workflow_ -> WorkflowF () --- fromWorkflow_ :: (MonadWorkflow m) => Workflow_ -> m () -fromWorkflow_ = \case - SendKeyChord_ flags key -> SendKeyChord flags key () - SendText_ s -> SendText s () - SendMouseClick_ flags n button -> SendMouseClick flags n button () - SendMouseScroll_ flags scroll n -> SendMouseScroll flags scroll n () - SetClipboard_ s -> SetClipboard s () - OpenApplication_ app -> OpenApplication app () - OpenURL_ url -> OpenURL url () - Delay_ t -> Delay t () - --------------------------------------------------------------------------------- -{-$ CoWorkflowF - -provides generic helper functions for defining interpreters. - --} - -{-| - -Naming: induces a @CoMonad@, see -<http://dlaing.org/cofun/posts/free_and_cofree.html> - -'WorkflowF', 'CoWorkflowF', and 'runWorkflowWithT' are analogous to: - -* @Either (a -> c) (b,c)@, -"get an @a@, or set a @b@" -* @((a,c), (b -> c))@, -"a handler for the getting of an @a@, and a handler for the setting of a @b@" -* @ -handle - :: ((a,c), (b -> c)) - -> (Either (a -> c) (b,c)) - -> c -handle (aHasBeenGotten, bHasBeenSet) = either TODO -@ - -background: see -<http://dlaing.org/cofun/posts/free_and_cofree.html> - --} -data CoWorkflowF k = CoWorkflowF - { _SendKeyChord :: ([Modifier] -> Key -> k) - , _SendText :: (String -> k) - - , _SendMouseClick :: ([Modifier] -> Natural -> MouseButton -> k) - , _SendMouseScroll :: ([Modifier] -> MouseScroll -> Natural -> k) - - , _GetClipboard :: (Clipboard , k) - , _SetClipboard :: (Clipboard -> k) - - , _CurrentApplication :: (Application , k) - , _OpenApplication :: (Application -> k) - - , _OpenURL :: (URL -> k) - - , _Delay :: (MilliSeconds -> k) - - } deriving (Functor) - -{- - -class (Functor f, Functor g) => Pairing f g where - pair :: (a -> b -> r) -> (f a -> g b -> r) - -instance Pairing CoWorkflowF WorkflowF where - pair :: (a -> b -> r) -> (CoWorkflowF a -> WorkflowF b -> r) - - pair u CoWorkflowF{..} = \case - - GetClipboard f -> let (s,a) = _getClipboard in - u a (f s) - - SetClipboard s b -> u (_setClipboard s) b - - ... - - - pairEffect :: (Pairing f g, Comonad w, Monad m) - => (a -> b -> r) -> CofreeT f w a -> FreeT g m b -> m r - pairEffect p s c = do - - - --} - -{-| - -e.g. - -@ -@ - -expansion: - -@ -CoWorkflowT w a -~ -CofreeT CoWorkflowF w a -~ -w (CofreeF CoWorkflowF a (CofreeT CoWorkflowF w a)) -~ -w (a, CoWorkflowF (CofreeT CoWorkflowF w a)) -@ - -since: - -@ -data CofreeT f w a = w (CofreeF f a (CofreeT f w a)) -@ - --} -type CoWorkflowT = CofreeT CoWorkflowF - -{-| - -expansion: - -@ -CoWorkflow a -~ -Cofree CoWorkflowF a -~ -(a, CoWorkflow (Cofree CoWorkflowF a)) -@ - -since: - -@ -data Cofree f a = a :< f (Cofree f a) -@ - --} -type CoWorkflow = Cofree CoWorkflowF - --------------------------------------------------------------------------------- +{-# LANGUAGE ConstraintKinds, FlexibleContexts, PatternSynonyms #-}+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+-- {-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- {-# OPTIONS_GHC -ddump-splices #-}+-- for `makeFree`++{-|++-}+module Workflow.Types where+import Workflow.Extra++import Control.Monad.Trans.Free (FreeT)+import Control.Monad.Free (MonadFree, Free)+import qualified Data.Text as T -- TODO++import Data.Char++--------------------------------------------------------------------------------+{-$ WorkflowF+-}++{-|++-}++{- | platform-agnostic workflows,+which can be interpreted by platform-specific bindings.++Naming: "WorkflowF" for "Workflow Functor".++NOTE: currently, no error codes are returned (only @()@)).+this (1) simplifies bindings and+(2) saves the user from explicitly ignoring action results (e.g. @_ <- getClipboard@).+later, they can be supported,+alongside wrappers that return @()@ and throw @SomeException@+and provide the same simple API.+since the intented usage of workflows are as user-facing+(often user-written) scripts, and+the monad that satisifes MonadWorkflow will often satisify MonadIO too,+convenient partial functions that throw a helpful error message to stdout+(the error codes should be converted to their error messages) should suffice.+and either way, is strictly better for the user than ignoring,+as the exceptions can always be caught, or not displayed.++-}+data WorkflowF k+ = SendKeyChord [Modifier] Key k -- ^ press the 'Key' while the 'Modifier's are held down. sent to the current application.+ --TODO | SendKeyChordTo Application [Modifier] Key k -- ^+ --TODO | SendKeyChordTo Window [Modifier] Key k -- ^+ -- versus unary: ([Modifier], Key)+ -- rn SendChord++ | SendText String k -- ^ a logical grouping for: (1) unicode support (2) efficiency and (3) debugging. sent to the current application.++ --TODO | SendTextTo Application String k -- ^+ --TODO | SendTextTo Window String k -- ^+ -- sendText = sendTextTo =<< currentApplication++ | SendMouseClick [Modifier] Natural MouseButton k -- ^ click the button, some number of times, holding down the modifiers+ -- derived, make method, not constructor. sent to the current application.+++ --TODO | SendMouseClickTo Application [Modifier] Int MouseButton k ^ -- sent to the current application.+ -- versus unary: ([Modifier], Natural, MouseButton)+ | SendMouseScroll [Modifier] MouseScroll Natural k -- ^ spin the wheel, some number of units*, holding down the modifiers++ | GetClipboard (Clipboard -> k)+ | SetClipboard Clipboard k++ | CurrentApplication (Application -> k) -- ^ like a getter.+ | OpenApplication Application k -- ^ idempotent. like a setter.++ --TODO | GetApplications ([Application] -> k)++ --TODO | CurrentWindow (Window -> k)+ --TODO | ReachWindow Window k+ --TODO | GetWindows Application ([Window] -> k) -- ^ an 'Application' has some 'Window's (zero or more on OSX, one or more on Windows/Linux, I think).++ | OpenURL URL k++ | Delay MilliSeconds k -- ^ interpreted as 'threadDelay' on all platforms; included for convenience++ deriving (Functor)+ -- deriving (Functor,Data)++--------------------------------------------------------------------------------++newtype Application' = Application { getApplication :: ApplicationName' }+ deriving (Semigroup,Monoid)++type ApplicationName' = Text+type ApplicationExecutable' = Text -- FilePath+ +type ApplicationName = String+type ApplicationExecutable = FilePath++{-++data Application = Application { applicationName :: ApplicationName, applicationExecutable :: ApplicationExecutable }++ currentApplication :: m ApplicationName+ openApplication :: Application -> m()++ getOpenApplications :: m [ApplicationName] + focusApplication :: ApplicationName -> m()+ startApplication :: ApplicationExecutable -> m()++-- with delay, if x was already open+forall x. do; focusApplication x; y <- currentApplication; return$ x == y++-}++--------------------------------------------------------------------------------++{-| the non-monadic subset of 'WorkflowF'.+i.e. all cases that return @()@, preserving the previous continuation.++Naming: "unit workflow", like "traverse_".++-}+data Workflow_+ = SendKeyChord_ [Modifier] Key+ | SendText_ String+ | SendMouseClick_ [Modifier] Natural MouseButton+ | SendMouseScroll_ [Modifier] MouseScroll Natural+ | SetClipboard_ Clipboard+ | OpenApplication_ Application+ | OpenURL_ URL+ | Delay_ MilliSeconds++ deriving (Show,Read,Eq,Ord,Data,Generic)+instance NFData Workflow_++--------------------------------------------------------------------------------++{- | abstract interface.++a monad constraint for "workflow effects"+(just like @MonadState@ is for "state effects").+Can be used in any monad transformer stack that handles them.++'WorkflowF' holds the effects.++'MonadThrow' supports:++* 'Workflow.Keys.press', if the user's syntax is wrong+* error messages from the underlying system calls (TODO e.g. Win32's @GetLastError()@)++-}+type MonadWorkflow m = (MonadFree WorkflowF m, MonadThrow m)++-- | (without failability)+type MonadWorkflow_ = MonadFree WorkflowF++{-old+type MonadWorkflow_ m = (MonadFree WorkflowF m)++without eta-contract:+ Illegal deriving item ‘MonadWorkflow_’+-}++--NOTE MonadThrow for `press`.+-- but, does instance MonadThrow (FreeT f m) exist? depends on f?+-- yes! depends on m. instance (Functor f, MonadThrow m) => MonadThrow (FreeT f m)++-- class (MonadFree WorkflowF m, MonadThrow m) => MonadWorkflow where+-- like `newtype` for constraints+-- less automatic++-- {- | for convenience.+-- without loss of generality (I don't think) when declaring simple monadic effects (like Kleisli arrows).++-- e.g.++-- @+-- getClipboard :: 'AMonadWorkflow' String -- generalized+-- getClipboard :: ('MonadWorkflow' m) => m String -- generalized+-- getClipboard :: Free 'WorkflowF' String -- specialized+-- @++-- -}+-- type AMonadWorkflow a = forall m. (MonadWorkflow m) => m a++-- {-| Naming: "a unit monad workflow".+-- -}+-- type AMonadWorkflow_ = (forall m. (MonadWorkflow m) => m ())++-- | concrete transformer.+type WorkflowT = FreeT WorkflowF++-- | concrete monad.+type Workflow = Free WorkflowF++--------------------------------------------------------------------------------++type Clipboard = String++type Application = String++type URL = String++type MilliSeconds = Int+-- newtype Time = Time Int deriving (Show,Eq,Ord,Num)+-- units package+-- milliseconds++-- class IsString TODO needs Free WorkflowF, which must be lifted,+-- which isn't better than an explicit insert+++-- {-|+--+-- >>> :set -XOverloadedStrings+-- >>> "contents" :: Clipboard+-- "contents"+--+-- -}+--newtype Clipboard_ = Clipboard String+ --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData)+-- data Clipboard = Clipboard { cbContents :: String, cbFormat :: ClipboardFormat }+-- instance IsString UnicodeTextFormat where fromString s = Clipboard s UnicodeTextFormat+-- GetClipboardContents+-- getClipboard = getClipboardContents<&>cbContents+-- runWorkflow must take a mapping (ClipboardFormat -> something)+-- maybe: phantom data RawClipboard (format :: ClipboardFormat) = Bytestring+-- with reflection class KnownClipboardFormat++-- {-|+--+-- >>> :set -XOverloadedStrings+-- >>> "Emacs" :: Application+-- "Emacs"+--+-- -}+--newtype Application_ = Application String+ --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData)++-- {-|+--+-- >>> :set -XOverloadedStrings+-- >>> "https://google.com/" :: URL+-- "https://google.com/"+--+-- -}+--newtype URL_ = URL String+ --deriving (Show,Read,Eq,Ord,IsString,Data,Generic,Semigroup,NFData)+--TODO refined++--------------------------------------------------------------------------------++{-| Operating systems always (?) support at least these mouse events.++Most mice have these three buttons, trackpads have left/right.++-}+data MouseButton+ = LeftButton+ | MiddleButton+ | RightButton+ --TODO | XButton -- https://msdn.microsoft.com/en-us/library/windows/desktop/gg153549(v=vs.85).aspx+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Generic)+instance NFData MouseButton++{-| Mouse wheel scrolling, vertically and horizontally.++'ScrollTowards':++* scrolls up when "natural scrolling" is disabled+* scrolls down when "natural scrolling" is enabled++TODO check++-}+data MouseScroll+ = ScrollTowards -- ScrollUp (from user)+ | ScrollAway -- ScrollDown (from user)+ | ScrollLeft+ | ScrollRight+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Generic)+instance NFData MouseScroll++--------------------------------------------------------------------------------++-- {-| Represents @a@ being bound to a keyboard shortcut.+--+-- Naming:+-- <https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Commands.html>+--+-- -}+-- data KeyBinding a = KeyBinding KeySequence a+--TODO mv to commands-core or something++{-| a sequence of key chords make up a keyboard shortcut++Naming:+<https://www.emacswiki.org/emacs/KeySequence>++-}+type KeySequence = [KeyChord]+-- newtype KeySequence = KeySequence (NonEmpty KeyChord)+--+--TODO newtype for non-overlapping IsString+-- instance IsString KCs where fromString =+-- --TODO refined+--+-- press :: KCs -> m()+--++-- an (unordered, no-duplicates) sequence of key+-- chords make up a keyboard shortcut+-- not a Set for simplicity (e.g. to avoid imports and Ord constraints).+--really?++{- | represents joitly holding down all the modifiers+while individually press each key down and back up.++Naming: https://www.emacswiki.org/emacs/Chord++-}+type KeyChord = ([Modifier], Key)+-- data KeyChord = KeyChord [Modifier] Key+{- data KeyChord = KeyChord+ { kcModifiers :: [Modifier]+ , kcKey :: Key+ }+-}++-- | @pattern KeyChord ms k = (ms,k)@+pattern KeyChord :: [Modifier] -> Key -> KeyChord+pattern KeyChord ms k = (ms, k)++pattern SimpleKeyChord :: Key -> KeyChord+pattern SimpleKeyChord k = ([], k)++{- | modifier keys are keys that can be "held".++NOTE the escape key tends to be "pressed", not "held", it seems.+(possibly explains its behavior in your terminal emulator?)++@alt@ is 'OptionModifier'.++-}+data Modifier+ = MetaModifier -- ^ fake modifier: Alt on Linux\/Windows, Command on OSX+ | HyperModifier -- ^ fake modifier: Control on Linux\/Windows, Command on OSX+ | ControlModifier+ | OptionModifier --TODO rn Option Alt+ | ShiftModifier+ | FunctionModifier+ deriving (Show,Read,Eq,Ord,Bounded,Enum,Data,Generic)+instance NFData Modifier++-- | (really, a @Set@)+type Modifiers = [Modifier]+ +{- | a "cross-platform" keyboard, that has:++* all keys that exist on standard keyboards.+* plus, 'MetaKey' and 'HyperKey': virtual modifiers to abstract over+common keyboard shortcuts.++(let me know if you want a type to support cross-platform international keyboards,+i haven't looked into it. you can still use the+platform-specific virtual-key-codes in the dependent packages:+@workflow-linux@, @workflow-osx@, and @workflow-windows@)++-}+data Key++ = MetaKey -- ^ fake key: Alt on Linux\/Windows, Command on OSX+ | HyperKey -- ^ fake key: Control on Linux\/Windows, Command on OSX+-- Control/Command both have C\/O\/N++ | ControlKey+ | CapsLockKey+ | ShiftKey+ | OptionKey+ | FunctionKey++ | GraveKey+ | MinusKey+ | EqualKey+ | DeleteKey+ | ForwardDeleteKey+ | LeftBracketKey+ | RightBracketKey+ | BackslashKey+ | SemicolonKey+ | QuoteKey+ | CommaKey+ | PeriodKey+ | SlashKey++ | TabKey+ | SpaceKey+ | ReturnKey++ | LeftArrowKey+ | RightArrowKey+ | DownArrowKey+ | UpArrowKey++ | AKey+ | BKey+ | CKey+ | DKey+ | EKey+ | FKey+ | GKey+ | HKey+ | IKey+ | JKey+ | KKey+ | LKey+ | MKey+ | NKey+ | OKey+ | PKey+ | QKey+ | RKey+ | SKey+ | TKey+ | UKey+ | VKey+ | WKey+ | XKey+ | YKey+ | ZKey++ | ZeroKey+ | OneKey+ | TwoKey+ | ThreeKey+ | FourKey+ | FiveKey+ | SixKey+ | SevenKey+ | EightKey+ | NineKey++ | EscapeKey+ | F1Key+ | F2Key+ | F3Key+ | F4Key+ | F5Key+ | F6Key+ | F7Key+ | F8Key+ | F9Key+ | F10Key+ | F11Key+ | F12Key+ | F13Key+ | F14Key+ | F15Key+ | F16Key+ | F17Key+ | F18Key+ | F19Key+ | F20Key++ deriving (Show,Read,Eq,Ord,Bounded,Enum,Data,Generic)+instance NFData Key++-- | All modifiers are keys.+modifier2key :: Modifier -> Key+modifier2key = \case+ MetaModifier -> MetaKey+ HyperModifier -> HyperKey+ ShiftModifier -> ShiftKey+ OptionModifier -> OptionKey+ ControlModifier -> ControlKey+ FunctionModifier -> FunctionKey++isModifierKey :: Key -> Maybe Modifier+isModifierKey = \case+ MetaKey -> Just MetaModifier+ HyperKey -> Just HyperModifier+ ShiftKey -> Just ShiftModifier+ OptionKey -> Just OptionModifier+ ControlKey -> Just ControlModifier+ FunctionKey -> Just FunctionModifier+ _ -> Nothing++isAlphaNumKey :: Key -> Bool+isAlphaNumKey x = isAlphabeticKey x || isNumericKey x++isAlphabeticKey :: Key -> Bool+isAlphabeticKey = \case+ AKey -> True+ BKey -> True+ CKey -> True+ DKey -> True+ EKey -> True+ FKey -> True+ GKey -> True+ HKey -> True+ IKey -> True+ JKey -> True+ KKey -> True+ LKey -> True+ MKey -> True+ NKey -> True+ OKey -> True+ PKey -> True+ QKey -> True+ RKey -> True+ SKey -> True+ TKey -> True+ UKey -> True+ VKey -> True+ WKey -> True+ XKey -> True+ YKey -> True+ ZKey -> True+ _ -> False++isNumericKey :: Key -> Bool+isNumericKey = \case+ ZeroKey -> True+ OneKey -> True+ TwoKey -> True+ ThreeKey -> True+ FourKey -> True+ FiveKey -> True+ SixKey -> True+ SevenKey -> True+ EightKey -> True+ NineKey -> True+ _ -> False++displayKey :: Key -> String+displayKey = show >>> (T.pack >>> T.stripSuffix "Key" >>> maybe (error "workflow-types:Workflow.Types.displayKey") id >>> T.unpack) >>> fmap toLower -- NOTE partial+
workflow-types.cabal view
@@ -1,69 +1,80 @@-name: workflow-types -version: 0.0.0 -synopsis: Automate keyboard\/mouse\/clipboard\/application interaction. -description: TODO -homepage: http://github.com/sboosali/workflow-types#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-types - - -library - hs-source-dirs: sources - default-language: Haskell2010 - ghc-options: - -Wall - -fno-warn-unticked-promoted-constructors - default-extensions: AutoDeriveTypeable DeriveDataTypeable DeriveGeneric - DeriveFunctor DeriveFoldable DeriveTraversable - LambdaCase EmptyDataDecls TypeOperators BangPatterns Arrows - MultiWayIf DoAndIfThenElse PostfixOperators TupleSections - MultiParamTypeClasses FlexibleContexts FlexibleInstances - TypeFamilies FunctionalDependencies - ExplicitForAll StandaloneDeriving - - exposed-modules: - Workflow.Core - Workflow.Types - Workflow.Execute - Workflow.Keys - Workflow.Reexports - - -- other-modules: - Workflow.Extra - Workflow.Example - Workflow.Parser - - build-depends: - base >=4.7 && <5 - , transformers - , containers - - , deepseq - , hashable - , semigroups - , split - , free - , comonad - , exceptions - - , Earley - - -executable workflow-types-example - main-is: Main.hs - hs-source-dirs: executables - default-language: Haskell2010 - build-depends: - base - , workflow-types +name: workflow-types+version: 0.0.1+synopsis: Automate keyboard\/mouse\/clipboard\/application interaction.+description: + .+ a platform-independent interface for scripting your manual computer workflows. + .+ documention at "Workflow.Core".+ . + see the source of "Workflow.Example" for an example.+ .+ transitive dependencies:+ .+ <<workflow-types.png>>++homepage: http://github.com/sboosali/workflow-types#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-types+++library+ hs-source-dirs: sources+ default-language: Haskell2010+ ghc-options:+ -Wall+ -fno-warn-unticked-promoted-constructors+ default-extensions: AutoDeriveTypeable DeriveDataTypeable DeriveGeneric+ DeriveFunctor DeriveFoldable DeriveTraversable+ LambdaCase EmptyDataDecls TypeOperators BangPatterns Arrows+ MultiWayIf DoAndIfThenElse PostfixOperators TupleSections+ MultiParamTypeClasses FlexibleContexts FlexibleInstances+ TypeFamilies FunctionalDependencies+ ExplicitForAll StandaloneDeriving++ exposed-modules:+ Workflow.Core+ Workflow.Types+ Workflow.Lens + Workflow.Execute+ Workflow.Keys+ Workflow.Reexports++ -- other-modules:+ Workflow.Extra+ Workflow.Example++ build-depends:+ base >=4.7 && <5+ , spiros++ , transformers+ , containers++ , split+ , text+++ , free+ , exceptions+++executable example-workflow-types+ main-is: Main.hs+ hs-source-dirs: executables+ default-language: Haskell2010+ build-depends:+ base+ , workflow-types+