Apply hlint hints

.hlint.yaml

@@ -0,0 +1,2 @@
+# Ignore these warnings.
+- ignore: {name: "Use camelCase"}

src/KMonad/App/Main.hs

@@ -77,7 +77,7 @@ initAppEnv cfg = do
  lgf <- view logFuncL
 
  -- Wait a bit for the user to release the 'Return' key with which they started KMonad
- threadDelay $ (fromIntegral $ cfg^.startDelay) * 1000
+ threadDelay $ fromIntegral (cfg^.startDelay) * 1000
 
  -- Acquire the keysource and keysink
  snk <- using $ cfg^.keySinkDev
@@ -92,7 +92,7 @@ initAppEnv cfg = do
  phl <- Km.mkKeymap (cfg^.firstLayer) (cfg^.keymapCfg)
 
  -- Initialize output components
- otv <- lift . atomically $ newEmptyTMVar
+ otv <- lift newEmptyTMVarIO
  ohk <- Hs.mkHooks . atomically . takeTMVar $ otv
 
  -- Setup thread to read from outHooks and emit to keysink
@@ -130,13 +130,11 @@ pressKey c =
  -- If the keycode does not occur in our keymap
  Nothing -> do
  ft <- view fallThrough
- if ft
- then do
+ when ft $ do
  emit $ mkPress c
  await (isReleaseOf c) $ \_ -> do
  emit $ mkRelease c
  pure Catch
- else pure ()
 
  -- If the keycode does occur in our keymap
  Just b -> runBEnv b Press >>= \case
@@ -174,4 +172,4 @@ startApp c = do
  -- Ignore SIGCHLD to avoid zombie processes.
  liftIO . void $ installHandler sigCHLD Ignore Nothing
 #endif
- runContT (initAppEnv c) (flip runRIO loop)
+ runContT (initAppEnv c) (`runRIO` loop)

src/KMonad/Args.hs

@@ -76,7 +76,7 @@ joinCLI cmd = traverse._KDefCfg %~ insertCliOption cliList
  insertCliOption cliSettings cfgSettings =
  foldr (\s cfgs ->
  if s `elem` cfgs
- then foldr (\x xs -> (if s == x then s else x) : xs) [] cfgs
+ then map (\x -> if s == x then s else x) cfgs
  else s : cfgs)
  cfgSettings
  cliSettings

src/KMonad/Args/Joiner.hs

@@ -129,7 +129,7 @@ joinConfigIO es = case runJ joinConfig $ defJCfg es of
 
 -- | Extract anything matching a particular prism from a list
 extract :: Prism' a b -> [a] -> [b]
-extract p = catMaybes . map (preview p)
+extract p = mapMaybe (preview p)
 
 data SingletonError
  = None
@@ -144,14 +144,14 @@ onlyOne xs = case uncons xs of
 
 -- | Take the one and only block matching the prism from the expressions
 oneBlock :: Text -> Prism' KExpr a -> J a
-oneBlock t l = onlyOne . extract l <$> view kes >>= \case
+oneBlock t l = (view kes <&> (extract l >>> onlyOne)) >>= \case
  Right x -> pure x
  Left None -> throwError $ MissingBlock t
  Left Duplicate -> throwError $ DuplicateBlock t
 
 -- | Update the JCfg and then run the entire joining process
 joinConfig :: J CfgToken
-joinConfig = getOverride >>= \cfg -> (local (const cfg) joinConfig')
+joinConfig = getOverride >>= \cfg -> local (const cfg) joinConfig'
 
 -- | Join an entire 'CfgToken' from the current list of 'KExpr'.
 joinConfig' :: J CfgToken
@@ -166,8 +166,8 @@ joinConfig' = do
  al <- getAllow
 
  -- Extract the other blocks and join them into a keymap
- let als = extract _KDefAlias  $ es
- let lys = extract _KDefLayer  $ es
+ let als = extract _KDefAlias es
+ let lys = extract _KDefLayer es
  src <- oneBlock "defsrc" _KDefSrc
  (km, fl) <- joinKeymap src als lys
 
@@ -310,15 +310,15 @@ joinAliases :: LNames -> [DefAlias] -> J Aliases
 joinAliases ns als = foldM f M.empty $ concat als
  where f mp (t, b) = if t `M.member` mp
  then throwError $ DuplicateAlias t
- else flip (M.insert t) mp <$> (unnest $ joinButton ns mp b)
+ else flip (M.insert t) mp <$> unnest (joinButton ns mp b)
 
 --------------------------------------------------------------------------------
 -- $but
 
 -- | Turn 'Nothing's (caused by joining a KTrans) into the appropriate error.
 -- KTrans buttons may only occur in 'DefLayer' definitions.
 unnest :: J (Maybe Button) -> J Button
-unnest = join . fmap (maybe (throwError NestedTrans) (pure . id))
+unnest = (maybe (throwError NestedTrans) pure =<<)
 
 -- | Turn a button token into an actual KMonad `Button` value
 joinButton :: LNames -> Aliases -> DefButton -> J (Maybe Button)
@@ -403,7 +403,7 @@ joinKeymap src als lys = do
  als' <- joinAliases nms als -- Join aliases into 1 hashmap
  lys' <- mapM (joinLayer als' nms src) lys -- Join all layers
  -- Return the layerstack and the name of the first layer
- pure $ (L.mkLayerStack lys', _layerName . fromJust . headMaybe $ lys)
+ pure (L.mkLayerStack lys', _layerName . fromJust . headMaybe $ lys)
 
 -- | Check and join 1 deflayer.
 joinLayer ::

src/KMonad/Args/Parser.hs

@@ -61,7 +61,7 @@ parseTokens t = case runParser configP "" t of
 
 -- | Load a set of tokens from file, throw an error on parse-fail
 loadTokens :: FilePath -> RIO e [KExpr]
-loadTokens pth = parseTokens <$> readFileUtf8 pth >>= \case
+loadTokens pth = (readFileUtf8 pth <&> parseTokens) >>= \case
  Left e -> throwM e
  Right xs -> pure xs
 
@@ -109,7 +109,7 @@ fromNamed = choice . map mkOne . srt
  x -> x
 
  -- | Make a parser that matches a terminated symbol or fails
- mkOne (s, x) = terminated (string s) *> pure x
+ mkOne (s, x) = terminated (string s) $> x
 
 -- | Run a parser between 2 sets of parentheses
 paren :: Parser a -> Parser a
@@ -121,8 +121,8 @@ statement s = paren . (symbol s *>)
 
 -- | Run a parser that parser a bool value
 bool :: Parser Bool
-bool = symbol "true" *> pure True
- <|> symbol "false" *> pure False
+bool = (symbol "true"  $> True)
+ <|> (symbol "false" $> False)
 
 -- | Parse a LISP-like keyword of the form @:keyword value@
 keywordP :: Text -> Parser p -> Parser p
@@ -217,7 +217,7 @@ moddedP = KAround <$> prfx <*> buttonP
  , ("A-", KeyLeftAlt), ("M-", KeyLeftMeta)
  , ("RS-", KeyRightShift), ("RC-", KeyRightCtrl)
  , ("RA-", KeyRightAlt), ("RM-", KeyRightMeta)]
- prfx = choice $ map (\(t, p) -> prefix (string t) *> pure (KEmit p)) mods
+ prfx = choice $ map (\(t, p) -> prefix (string t) $> KEmit p) mods
 
 -- | Parse Pxxx as pauses (useful in macros)
 pauseP :: Parser DefButton
@@ -234,7 +234,7 @@ composeSeqP :: Parser [DefButton]
 composeSeqP = do
  -- Lookup 1 character in the compose-seq list
  c <- anySingle <?> "special character"
- s <- case find (\(_, c', _) -> (c' == c)) ssComposed of
+ s <- case find (\(_, c', _) -> c' == c) ssComposed of
  Nothing -> fail "Unrecognized compose-char"
  Just b -> pure $ b^._1
 
@@ -336,7 +336,7 @@ otokenP = choice $ map (try . uncurry statement) otokens
 otokens :: [(Text, Parser OToken)]
 otokens =
  [ ("uinput-sink" , KUinputSink <$> lexeme textP <*> optional textP)
- , ("send-event-sink", KSendEventSink <$> (optional $ (,) <$> lexeme numP <*> numP))
+ , ("send-event-sink", KSendEventSink <$> optional ((,) <$> lexeme numP <*> numP))
  , ("kext" , pure KKextSink)]
 
 -- | Parse the DefCfg token

src/KMonad/Keyboard/IO.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-|
 Module : KMonad.Keyboard.IO
 Description : The logic behind sending and receiving key events to the OS

src/KMonad/Keyboard/IO/Linux/DeviceSource.hs

@@ -77,7 +77,7 @@ defEventParser = KeyEventParser 24 decode64
 
 -- | The KeyEventParser that works on my 64-bit Linux environment
 decode64 :: B.ByteString -> Either String LinuxKeyEvent
-decode64 bs = (linuxKeyEvent . fliptup) <$> result
+decode64 bs = linuxKeyEvent . fliptup <$> result
  where
  result :: Either String (Int32, Word16, Word16, Word64, Word64)
  result = B.decode . B.reverse $ bs
@@ -134,7 +134,7 @@ lsOpen pr pt = do
  h <- liftIO . openFd pt ReadOnly Nothing $
  OpenFileFlags False False False False False
  hd <- liftIO $ fdToHandle h
- logInfo $ "Initiating ioctl grab"
+ logInfo "Initiating ioctl grab"
  ioctl_keyboard h True `onErr` IOCtlGrabError pt
  return $ DeviceFile (DeviceSourceCfg pt pr) h hd
 
@@ -143,7 +143,7 @@ lsOpen pr pt = do
 -- 'IOCtlReleaseError' if the ioctl release could not be properly performed.
 lsClose :: (HasLogFunc e) => DeviceFile -> RIO e ()
 lsClose src = do
- logInfo $ "Releasing ioctl grab"
+ logInfo "Releasing ioctl grab"
  ioctl_keyboard (src^.fd) False `onErr` IOCtlReleaseError (src^.pth)
  liftIO . closeFd $ src^.fd
 
@@ -153,7 +153,7 @@ lsClose src = do
 lsRead :: (HasLogFunc e) => DeviceFile -> RIO e KeyEvent
 lsRead src = do
  bts <- B.hGet (src^.hdl) (src^.nbytes)
- case (src^.prs $ bts) of
+ case src^.prs $ bts of
  Right p -> case fromLinuxKeyEvent p of
  Just e -> return e
  Nothing -> lsRead src

src/KMonad/Keyboard/IO/Linux/Types.hs

@@ -119,4 +119,4 @@ toLinuxKeyEvent e (MkSystemTime s ns)
  = LinuxKeyEvent (fi s, fi ns, 1, c, val)
  where
  c = fi . fromEnum $ e^.keycode
- val = if (e^.switch == Press) then 1 else 0
+ val = if e^.switch == Press then 1 else 0

src/KMonad/Keyboard/IO/Linux/UinputSink.hs

@@ -131,7 +131,7 @@ send_event :: ()
  -> LinuxKeyEvent
  -> RIO e ()
 send_event u (Fd h) e@(LinuxKeyEvent (s', ns', typ, c, val)) = do
- (liftIO $ c_send_event h typ c val s' ns')
+ liftIO (c_send_event h typ c val s' ns')
  `onErr` SinkEncodeError (u^.cfg.keyboardName) e
 
 
@@ -155,18 +155,18 @@ usClose :: HasLogFunc e => UinputSink -> RIO e ()
 usClose snk = withMVar (snk^.st) $ \h -> finally (release h) (close h)
  where
  release h = do
- logInfo $ "Unregistering Uinput device"
+ logInfo "Unregistering Uinput device"
  release_uinput_keysink h
  `onErr` UinputReleaseError (snk^.cfg.keyboardName)
 
  close h = do
- logInfo $ "Closing Uinput device file"
+ logInfo "Closing Uinput device file"
  liftIO $ closeFd h
 
 -- | Write a keyboard event to the sink and sync the driver state. Using an MVar
 -- ensures that we can never have 2 threads try to write at the same time.
 usWrite :: HasLogFunc e => UinputSink -> KeyEvent -> RIO e ()
 usWrite u e = withMVar (u^.st) $ \fd -> do
- now <- liftIO $ getSystemTime
+ now <- liftIO getSystemTime
  send_event u fd . toLinuxKeyEvent e $ now
  send_event u fd . sync $ now

src/KMonad/Keyboard/IO/Mac/IOKitSource.hs

@@ -30,14 +30,14 @@ foreign import ccall "wait_key"
  wait_key :: Ptr MacKeyEvent -> IO Word8
 
 
-data EvBuf = EvBuf
- { _buffer :: !(Ptr MacKeyEvent)
+newtype EvBuf = EvBuf
+ { _buffer :: Ptr MacKeyEvent
  }
 makeLenses ''EvBuf
 
 -- | Return a KeySource using the Mac IOKit approach
 iokitSource :: HasLogFunc e
- => (Maybe String)
+ => Maybe String
  -> RIO e (Acquire KeySource)
 iokitSource name = mkKeySource (iokitOpen name) iokitClose iokitRead
 
@@ -46,7 +46,7 @@ iokitSource name = mkKeySource (iokitOpen name) iokitClose iokitRead
 
 -- | Ask IOKit to open keyboards matching the specified name
 iokitOpen :: HasLogFunc e
- => (Maybe String)
+ => Maybe String
  -> RIO e EvBuf
 iokitOpen m = do
  logInfo "Opening IOKit devices"

src/KMonad/Keyboard/IO/Mac/KextSink.hs

@@ -16,7 +16,7 @@ import KMonad.Keyboard.IO.Mac.Types
 foreign import ccall "send_key"
  send_key :: Ptr MacKeyEvent -> IO ()
 
-data EvBuf = EvBuf
+newtype EvBuf = EvBuf
  { _buffer :: Ptr MacKeyEvent -- ^ The pointer we write events to
  }
 makeClassy ''EvBuf

src/KMonad/Keyboard/IO/Mac/Types.hs

@@ -83,7 +83,7 @@ fromMacKeycode = flip M.lookup kcMap
 -- | Lookup the correspondig 'MacKeycode' for this 'Keycode'
 toMacKeycode :: Keycode -> Maybe MacKeycode
 toMacKeycode = flip M.lookup revMap
- where revMap = M.fromList $ (M.toList kcMap) ^.. folded . swapped
+ where revMap = M.fromList $ M.toList kcMap ^.. folded . swapped
 
 -- | Convert a 'KeyEvent' to a 'MacKeyEvent'
 --
@@ -117,7 +117,7 @@ fromMacKeyEvent (MacKeyEvent (s, (p, u)))
 -- See https://opensource.apple.com/source/IOHIDFamily/IOHIDFamily-315.7.16/IOHIDFamily/IOHIDUsageTables.h
 -- See https://opensource.apple.com/source/IOHIDFamily/IOHIDFamily-700/IOHIDFamily/AppleHIDUsageTables.h.auto.html
 kcMap :: M.HashMap MacKeycode Keycode
-kcMap = M.fromList $
+kcMap = M.fromList
  [ ((0x7,0x4), KeyA)
  , ((0x7,0x5), KeyB)
  , ((0x7,0x6), KeyC)

src/KMonad/Keyboard/IO/Windows/Types.hs

@@ -124,7 +124,7 @@ fromWinKeyEvent (WinKeyEvent (s, c)) = case fromWinKeycode c of
 -- FIXME: There are loads of missing correspondences, mostly for rare-keys. How
 -- do these line up? Ideally this mapping would be total.
 winCodeToKeyCode :: M.HashMap WinKeycode Keycode
-winCodeToKeyCode = M.fromList $
+winCodeToKeyCode = M.fromList
  [ (0x00, Missing254) -- Not documented, but happens often. Why??
  -- , (0x01, ???) -- Defined as VK_LBUTTON
  -- , (0x02, ???) -- Defined as VK_RBUTTON
@@ -319,12 +319,12 @@ winCodeToKeyCode = M.fromList $
  ]
 
 -- | Translate a KMonad KeyCode to the corresponding Windows virtual-key code
--- 
+--
 -- We cannot simply reverse the above map for the opposite direction, because
 -- there will be duplicates where more than one virtual-key code produces the
 -- same KMonad KeyCode. See https://github.com/kmonad/kmonad/issues/326
 keyCodeToWinCode :: M.HashMap Keycode WinKeycode
-keyCodeToWinCode = M.fromList $
+keyCodeToWinCode = M.fromList
  [ -- (KeyReserved, ???)
  (KeyEsc, 0x1B)
  , (Key1, 0x31)
@@ -581,4 +581,4 @@ keyCodeToWinCode = M.fromList $
  -- , (Missing253, ???)
  -- , (Missing254, ???)
  -- , (Missing255, ???)
- ] 
+ ]

src/KMonad/Keyboard/Keycode.hs

@@ -325,7 +325,7 @@ instance Display Keycode where
 
 -- | The set of all existing 'Keycode'
 kcAll :: S.HashSet Keycode
-kcAll = S.fromList $ [minBound .. maxBound]
+kcAll = S.fromList [minBound .. maxBound]
 
 -- | The set of all 'Keycode' that are not of the MissingXX pattern
 kcNotMissing :: S.HashSet Keycode

src/KMonad/Model/Action.hs

@@ -209,7 +209,7 @@ matchMy s = (==) <$> my s
 await :: MonadKIO m => KeyPred -> (KeyEvent -> m Catch) -> m ()
 await p a = hookF InputHook $ \e -> if p e
  then a e
- else await p a *> pure NoCatch
+ else await p a $> NoCatch
 
 -- | Execute an action on the detection of the Switch of the active button.
 awaitMy :: MonadK m => Switch -> m Catch -> m ()
@@ -228,7 +228,7 @@ within d p a f = do
  -- define f' to run action on predicate match, or rehook on predicate mismatch
  let f' t = if p' (t^.event)
  then f t
- else within (d - t^.elapsed) p a f *> pure NoCatch
+ else within (d - t^.elapsed) p a f $> NoCatch
  tHookF InputHook d a f'
 
 -- | Like `within`, but acquires a hold when starting, and releases when done

src/KMonad/Model/Button.hs

@@ -471,7 +471,7 @@ layerNext t = onPress $ do
 -- pressed for the button after it if that button was pressed in the
 -- given timeframe.
 stickyKey :: Milliseconds -> Button -> Button
-stickyKey ms b = onPress $ go
+stickyKey ms b = onPress go
  where
  go :: MonadK m => m ()
  go = hookF InputHook $ \e -> do

src/KMonad/Model/Dispatch.hs

@@ -65,8 +65,8 @@ makeLenses ''Dispatch
 -- | Create a new 'Dispatch' environment
 mkDispatch' :: MonadUnliftIO m => m KeyEvent -> m Dispatch
 mkDispatch' s = withRunInIO $ \u -> do
- rpc <- atomically $ newEmptyTMVar
- rrb <- atomically $ newTVar Seq.empty
+ rpc <- newEmptyTMVarIO
+ rrb <- newTVarIO Seq.empty
  pure $ Dispatch (u s) rpc rrb
 
 -- | Create a new 'Dispatch' environment in a 'ContT' environment