module Workflow.Keys where
import Workflow.Types
import Workflow.Extra
import Data.List.Split
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
press :: (MonadWorkflow m, MonadThrow m) => String -> m ()
press = press' defaultKeyChordSyntax
readEmacsKeySequence :: String -> Maybe KeySequence
readEmacsKeySequence = readKeySequence emacsKeyChordSyntax
readEmacsKeyChord :: String -> Maybe KeySequence
readEmacsKeyChord = readKeySequence emacsKeyChordSyntax
readEmacsModifier :: String -> Maybe Modifier
readEmacsModifier = readModifier emacsModifierSyntax
readEmacsKey :: String -> Maybe KeyChord
readEmacsKey = readKey emacsKeySyntax
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__
Just ks -> return ks
__fail__ = failed $ "syntax error: {{Workflow.Keys.press "++(show s)++"}}"
readKeySequence :: KeyChordSyntax -> String -> Maybe KeySequence
readKeySequence syntax
= splitOn " " >>> fmap (splitOn "-") >>> traverse (readKeyChord syntax)
readKeyChord :: KeyChordSyntax -> [String] -> Maybe KeyChord
readKeyChord KeyChordSyntax{..} = \case
[] -> Nothing
s@(_:_) -> do
ms <- traverse (readModifier modifierSyntax) (init s)
k <- (readKey keySyntax) (last s)
return $ addMods ms k
readModifier :: ModifierSyntax -> String -> Maybe Modifier
readModifier = (flip Map.lookup)
readKey :: KeySyntax -> String -> Maybe KeyChord
readKey = (flip Map.lookup)
data KeyChordSyntax = KeyChordSyntax
{ modifierSyntax :: ModifierSyntax
, keySyntax :: KeySyntax
} deriving (Show,Read,Eq,Ord,Data,Generic)
instance NFData KeyChordSyntax
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
defaultKeyChordSyntax :: KeyChordSyntax
defaultKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax
defaultModifierSyntax :: ModifierSyntax
defaultModifierSyntax = emacsModifierSyntax
defaultKeySyntax :: KeySyntax
defaultKeySyntax = emacsKeySyntax
emacsKeyChordSyntax :: KeyChordSyntax
emacsKeyChordSyntax = KeyChordSyntax defaultModifierSyntax defaultKeySyntax
emacsModifierSyntax :: ModifierSyntax
emacsModifierSyntax = Map.fromList
[ "M" -: MetaModifier
, "H" -: HyperModifier
, "C" -: ControlModifier
, "O" -: OptionModifier
, "A" -: OptionModifier
, "S" -: ShiftModifier
, "F" -: FunctionModifier
]
emacsKeySyntax :: KeySyntax
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
, "_" -: 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
]
addMods :: [Modifier] -> KeyChord -> KeyChord
addMods ms kc = foldr addMod kc ms
addMod :: Modifier -> KeyChord -> KeyChord
addMod m (ms, k) = (m:ms, k)
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"