Generate keypresses with my Synth's sustain pedal. Requires `xdotool` in %PATH%

sustain-vim.hs

import System.USB
      ( InterfaceDesc(interfaceEndpoints, interfaceNumber),
	EndpointDesc(endpointAddress),
	DeviceDesc(deviceProductId, deviceVendorId),
	Device,
	Ctx,
	ConfigDesc(configInterfaces),
	withDeviceHandle,
	withDetachedKernelDriver,
	withClaimedInterface,
	readBulk,
	noTimeout,
	newCtx,
	getDevices,
	getDeviceDesc,
	getConfigDesc )

import           Control.Monad         (forever)
import qualified Data.Vector as V     
import           Data.ByteString       (ByteString)
import qualified Data.ByteString as BS
import Data.List                       (intercalate, findIndex)
import Text.Printf                     (printf)
import Control.Concurrent
    ( takeMVar, putMVar, newEmptyMVar, threadDelay, forkFinally )
import System.Process

whenPedalDown = "i"
whenPedalUp   = "Escape"

isMidimanKeystation88es :: DeviceDesc -> Bool
isMidimanKeystation88es desc = deviceVendorId desc == 0x0763
                           && deviceProductId desc == 0x0192

main = newCtx >>= mainLoop

prettyByteString :: ByteString -> String
prettyByteString = intercalate " " . map (printf "%02x") . BS.unpack

mainLoop:: Ctx -> IO ()
mainLoop ctx = do
    devs <- fmap V.toList $ getDevices ctx
    devDescs <- mapM getDeviceDesc devs
    case findIndex isMidimanKeystation88es devDescs of 
        Just i -> performConnection (devs!!i)
        Nothing -> threadDelay 200000 -- 200ms 
    mainLoop ctx
  where
    performConnection device = do
      mvar <- newEmptyMVar
      forkFinally (deviceHandler device) (\_ -> putMVar mvar ())
      takeMVar mvar
    
deviceHandler :: Device -> IO ()
deviceHandler device = do
    deviceDesc <- getDeviceDesc device
    configDesc <- getConfigDesc device 0
    let interface = head . V.toList . (!!1) . V.toList . configInterfaces $ configDesc
        endPoint = (!!0) . V.toList . interfaceEndpoints $ interface
    withDeviceHandle device $ \handle ->
       withDetachedKernelDriver handle 1 $ 
           withClaimedInterface handle (interfaceNumber interface) $ forever $ do 
                result <- fmap fst $ readBulk handle (endpointAddress endPoint) 4 noTimeout
                processMidi result

generateKeyPress :: String -> IO ()
generateKeyPress key = system ("xdotool key " ++ key) >> return ()
  
processMidi :: ByteString -> IO ()
processMidi midi = do
    let down = BS.pack [0x0B, 0xB0, 0x40, 0x7F]
        up   = BS.pack [0x0B, 0xB0, 0x40, 0x00]
    if midi == down
       then generateKeyPress whenPedalDown
       else if midi == up
          then generateKeyPress whenPedalUp
          else return ()