From 71e86f2233a573fca8b5e6afd0b828d0fd038a0a Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 12 Feb 2023 23:08:05 -0500 Subject: [PATCH] REF update compiler flags --- bin/vbox-start.hs | 3 - bin/xmobar.hs | 9 +-- bin/xmonad.hs | 11 ++-- lib/Data/Internal/DBus.hs | 9 +-- lib/Data/Internal/XIO.hs | 11 +--- lib/XMonad/Internal/Command/DMenu.hs | 8 +-- lib/XMonad/Internal/Command/Desktop.hs | 2 - lib/XMonad/Internal/Command/Power.hs | 39 ++++++------ lib/XMonad/Internal/Concurrent/ACPIEvent.hs | 26 ++++---- .../Internal/Concurrent/ClientMessage.hs | 25 +++++--- .../Internal/Concurrent/DynamicWorkspaces.hs | 2 - lib/XMonad/Internal/Concurrent/VirtualBox.hs | 5 +- .../Internal/DBus/Brightness/ClevoKeyboard.hs | 4 -- lib/XMonad/Internal/DBus/Brightness/Common.hs | 5 -- .../DBus/Brightness/IntelBacklight.hs | 4 -- lib/XMonad/Internal/DBus/Control.hs | 4 +- lib/XMonad/Internal/DBus/Removable.hs | 5 -- lib/XMonad/Internal/DBus/Screensaver.hs | 6 +- lib/XMonad/Internal/IO.hs | 8 +-- lib/XMonad/Internal/Notify.hs | 2 - lib/XMonad/Internal/Shell.hs | 7 +-- lib/XMonad/Internal/Theme.hs | 3 +- lib/Xmobar/Plugins/BacklightCommon.hs | 2 - lib/Xmobar/Plugins/Bluetooth.hs | 2 - lib/Xmobar/Plugins/ClevoKeyboard.hs | 3 +- lib/Xmobar/Plugins/Common.hs | 5 +- lib/Xmobar/Plugins/Device.hs | 3 - lib/Xmobar/Plugins/IntelBacklight.hs | 3 +- lib/Xmobar/Plugins/Screensaver.hs | 3 +- lib/Xmobar/Plugins/VPN.hs | 5 +- package.yaml | 63 +++++++++++++++---- 31 files changed, 128 insertions(+), 159 deletions(-) diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs index b911726..e376141 100644 --- a/bin/vbox-start.hs +++ b/bin/vbox-start.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -- | Start a VirtualBox instance with a sentinel wrapper process. -- -- The only reason why this is needed is because I want to manage virtualboxes diff --git a/bin/xmobar.hs b/bin/xmobar.hs index b1a35e3..d095bc0 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | Xmobar binary -- -- Features: @@ -19,6 +17,7 @@ import qualified RIO.ByteString.Lazy as BL import RIO.List import RIO.Process import qualified RIO.Text as T +import XMonad.Config.Prime (enumFrom) import XMonad.Core hiding (config) import XMonad.Internal.Command.Desktop import XMonad.Internal.Command.Power @@ -308,8 +307,7 @@ iconIO_ iconIO_ = iconSometimes' And_ Only_ iconDBus - :: SafeClient c - => T.Text + :: T.Text -> XPQuery -> (Fontifier -> DBusTree c p -> Root CmdSpec) -> DBusTree c p @@ -317,8 +315,7 @@ iconDBus iconDBus = iconSometimes' And1 $ Only_ . DBusIO iconDBus_ - :: SafeClient c - => T.Text + :: T.Text -> XPQuery -> (Fontifier -> DBusTree_ c -> Root CmdSpec) -> DBusTree_ c diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 917de35..a274b9c 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ImplicitPrelude #-} -------------------------------------------------------------------------------- -- XMonad binary @@ -51,6 +47,7 @@ import XMonad.Internal.DBus.Removable import XMonad.Internal.DBus.Screensaver import XMonad.Internal.Shell hiding (proc) import qualified XMonad.Internal.Theme as XT +import XMonad.Layout.Decoration import XMonad.Layout.MultiToggle import XMonad.Layout.NoBorders import XMonad.Layout.NoFrillsDecoration @@ -464,6 +461,10 @@ myLayouts tt = mkToggle (single HIDE) $ tall ||| fulltab ||| full where + addTopBar + :: (Eq a) + => l a + -> ModifiedLayout (Decoration NoFrillsDecoration DefaultShrinker) l a addTopBar = noFrillsDeco shrinkText tt tall = renamed [Replace "Tall"] $ diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs index 18cc40e..aad1503 100644 --- a/lib/Data/Internal/DBus.hs +++ b/lib/Data/Internal/DBus.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Common internal DBus functions @@ -115,11 +111,11 @@ type DIO env c = RIO (DBusEnv env c) instance HasClient (DBusEnv SimpleApp) where clientL = lens dClient (\x y -> x {dClient = y}) -instance SafeClient c => HasLogFunc (DBusEnv SimpleApp c) where +instance HasLogFunc (DBusEnv SimpleApp c) where logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL withDIO - :: (MonadUnliftIO m, MonadReader env m, SafeClient c) + :: (MonadUnliftIO m, MonadReader env m) => c -> DIO env c a -> m a @@ -204,7 +200,6 @@ type SignalCallback m = [Variant] -> m () addMatchCallback :: ( MonadReader (env c) m - , HasLogFunc (env c) , MonadUnliftIO m , SafeClient c , HasClient env diff --git a/lib/Data/Internal/XIO.hs b/lib/Data/Internal/XIO.hs index d35d0af..8a8c8ca 100644 --- a/lib/Data/Internal/XIO.hs +++ b/lib/Data/Internal/XIO.hs @@ -1,11 +1,4 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImplicitPrelude #-} -------------------------------------------------------------------------------- -- Functions for handling dependencies @@ -425,7 +418,7 @@ data XEnv = XEnv instance HasLogFunc XEnv where logFuncL = lens xLogFun (\x y -> x {xLogFun = y}) -instance SafeClient c => HasLogFunc (DBusEnv XEnv c) where +instance HasLogFunc (DBusEnv XEnv c) where logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL instance HasProcessContext XEnv where diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 946bbd7..a0a7b4a 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Dmenu (Rofi) Commands @@ -210,7 +208,7 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act -- Shortcut menu runShowKeys - :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) + :: (MonadReader env m, MonadUnliftIO m) => Always ([((KeyMask, KeySym), NamedAction)] -> m ()) runShowKeys = Always "keyboard menu" $ @@ -225,7 +223,7 @@ runShowKeys = defNoteError {body = Just $ Text "could not display keymap"} showKeysDMenu - :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) + :: (MonadReader env m, MonadUnliftIO m) => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ()) showKeysDMenu = Subfeature @@ -234,7 +232,7 @@ showKeysDMenu = } showKeys - :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) + :: (MonadReader env m, MonadUnliftIO m) => [((KeyMask, KeySym), NamedAction)] -> m () showKeys kbs = do diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index af27524..37834b9 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- General commands diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index c8ddca6..533aa66 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Commands for controlling power @@ -181,17 +179,20 @@ data PowerMaybeAction | Reboot deriving (Eq) -instance Enum PowerMaybeAction where - toEnum 0 = Poweroff - toEnum 1 = Shutdown - toEnum 2 = Hibernate - toEnum 3 = Reboot - toEnum _ = errorWithoutStackTrace "Main.Enum.PowerMaybeAction.toEnum: bad argument" +fromPMA :: PowerMaybeAction -> Int +fromPMA a = case a of + Poweroff -> 0 + Shutdown -> 1 + Hibernate -> 2 + Reboot -> 3 - fromEnum Poweroff = 0 - fromEnum Shutdown = 1 - fromEnum Hibernate = 2 - fromEnum Reboot = 3 +toPMA :: Int -> Maybe PowerMaybeAction +toPMA x = case x of + 0 -> Just Poweroff + 1 -> Just Shutdown + 2 -> Just Hibernate + 3 -> Just Reboot + _ -> Nothing data PowerPrompt = PowerPrompt @@ -223,9 +224,11 @@ powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction , (xK_Return, quit) , (xK_Escape, quit) ] - sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True - executeMaybeAction a = case toEnum $ read a of - Poweroff -> liftIO runPowerOff - Shutdown -> lock >> liftIO runSuspend - Hibernate -> lock >> liftIO runHibernate - Reboot -> liftIO runReboot + sendMaybeAction a = setInput (show $ fromPMA a) >> setSuccess True >> setDone True + executeMaybeAction a = case toPMA =<< readMaybe a of + Just Poweroff -> liftIO runPowerOff + Just Shutdown -> lock >> liftIO runSuspend + Just Hibernate -> lock >> liftIO runHibernate + Just Reboot -> liftIO runReboot + -- TODO log an error here since this should never happen + Nothing -> skip diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs index a543ade..a428d69 100644 --- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs +++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Concurrent module to handle events from acpid @@ -33,15 +30,18 @@ data ACPIEvent | LidClose deriving (Eq) -instance Enum ACPIEvent where - toEnum 0 = Power - toEnum 1 = Sleep - toEnum 2 = LidClose - toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument" +fromACPIEvent :: ACPIEvent -> Int +fromACPIEvent x = case x of + Power -> 0 + Sleep -> 1 + LidClose -> 2 - fromEnum Power = 0 - fromEnum Sleep = 1 - fromEnum LidClose = 2 +toACPIEvent :: Int -> Maybe ACPIEvent +toACPIEvent x = case x of + 0 -> Just Power + 1 -> Just Sleep + 2 -> Just LidClose + _ -> Nothing -------------------------------------------------------------------------------- -- Internal functions @@ -64,7 +64,7 @@ parseLine line = -- | Send an ACPIEvent to the X server as a ClientMessage sendACPIEvent :: ACPIEvent -> IO () -sendACPIEvent = sendXMsg ACPI . show . fromEnum +sendACPIEvent = sendXMsg ACPI . show . fromACPIEvent isDischarging :: IO (Maybe Bool) isDischarging = do @@ -91,7 +91,7 @@ socketDep = Only_ $ pathR acpiPath [Package Official "acpid"] -- Xmonad's event hook) handleACPI :: FontBuilder -> X () -> String -> X () handleACPI fb lock tag = do - let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent + let acpiTag = toACPIEvent =<< readMaybe tag :: Maybe ACPIEvent forM_ acpiTag $ \case Power -> powerPrompt lock fb Sleep -> suspendPrompt fb diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs index f8c0308..310723c 100644 --- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs +++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs @@ -28,6 +28,7 @@ import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Display import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Extras +import RIO import XMonad.Internal.IO -------------------------------------------------------------------------------- @@ -42,14 +43,18 @@ data XMsgType | Unknown deriving (Eq, Show) -instance Enum XMsgType where - toEnum 0 = ACPI - toEnum 1 = Workspace - toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument" +fromXMsgType :: XMsgType -> Int +fromXMsgType x = case x of + ACPI -> 0 + Workspace -> 1 + Unknown -> 2 - fromEnum ACPI = 0 - fromEnum Workspace = 1 - fromEnum Unknown = 2 +toXMsgType :: Int -> Maybe XMsgType +toXMsgType x = case x of + 0 -> Just ACPI + 1 -> Just Workspace + 2 -> Just Unknown + _ -> Nothing -------------------------------------------------------------------------------- -- Exported API @@ -58,9 +63,9 @@ instance Enum XMsgType where -- type and payload splitXMsg :: (Integral a) => [a] -> (XMsgType, String) splitXMsg [] = (Unknown, "") -splitXMsg (x : xs) = (xtype, tag) +splitXMsg (x : xs) = (fromMaybe Unknown xtype, tag) where - xtype = toEnum $ fromIntegral x + xtype = toXMsgType $ fromIntegral x tag = chr . fromIntegral <$> takeWhile (/= 0) xs -- | Emit a ClientMessage event to the X server with the given type and payloud @@ -86,5 +91,5 @@ sendXMsg xtype tag = withOpenDisplay $ \dpy -> do setClientMessageEvent' e root bITMAP 8 (x : t) sendEvent dpy root False substructureNotifyMask e where - x = fromIntegral $ fromEnum xtype + x = fromIntegral $ fromXMsgType xtype t = fmap (fromIntegral . fromEnum) tag diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs index 3e18c11..60d9241 100644 --- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs +++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Automatically Manage Dynamic Workspaces -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs index 5997478..bd242ca 100644 --- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs +++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -------------------------------------------------------------------------------- -- VirtualBox-specific functions @@ -36,7 +33,7 @@ vmInstanceConfig vmName = do vmDirectory :: IO (Either String String) vmDirectory = do p <- vmConfig - s <- tryIO $ readFile p + s <- tryIO $ readFileUtf8 p return $ case s of (Left _) -> Left "could not read VirtualBox config file" (Right x) -> diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs index a6796c5..6d558a8 100644 --- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs +++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- DBus module for Clevo Keyboard control @@ -142,7 +139,6 @@ callGetBrightnessCK = callGetBrightness clevoKeyboardConfig matchSignalCK :: ( SafeClient c - , HasLogFunc (env c) , HasClient env , MonadReader (env c) m , MonadUnliftIO m diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index f0cf6dd..13746f4 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} - -------------------------------------------------------------------------------- -- DBus module for DBus brightness controls @@ -88,7 +84,6 @@ signalDep BrightnessConfig {bcPath = p, bcInterface = i} = matchSignal :: ( HasClient env - , HasLogFunc (env c) , MonadReader (env c) m , MonadUnliftIO m , SafeClient c diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index eaf0a18..6b7c92b 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- DBus module for Intel Backlight control @@ -128,7 +125,6 @@ callGetBrightnessIB = callGetBrightness intelBacklightConfig matchSignalIB :: ( SafeClient c - , HasLogFunc (env c) , HasClient env , MonadReader (env c) m , MonadUnliftIO m diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index a2c573b..c19ebb4 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -------------------------------------------------------------------------------- -- High-level interface for managing XMonad's DBus @@ -80,6 +77,7 @@ connectDBus = do disconnectDBus :: MonadUnliftIO m => DBusState -> m () disconnectDBus db = disc dbSesClient >> disc dbSysClient where + disc :: (MonadUnliftIO m, SafeClient c) => (DBusState -> Maybe c) -> m () disc f = maybe (return ()) disconnectDBusClient $ f db -- | Connect to the DBus and request the XMonad name diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs index 2879465..631fbb7 100644 --- a/lib/XMonad/Internal/DBus/Removable.hs +++ b/lib/XMonad/Internal/DBus/Removable.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Module for monitoring removable drive events -- @@ -83,7 +80,6 @@ playSoundMaybe p b = when b $ io $ playSound p -- enable the udisks2 service at boot; however this is not default behavior. listenDevices :: ( HasClient (DBusEnv env) - , HasLogFunc (DBusEnv env SysClient) , MonadReader env m , MonadUnliftIO m ) @@ -99,7 +95,6 @@ listenDevices cl = do runRemovableMon :: ( HasClient (DBusEnv env) - , HasLogFunc (DBusEnv env SysClient) , MonadReader env m , MonadUnliftIO m ) diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 541d096..7d0d35d 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- DBus module for X11 screensave/DPMS control @@ -147,8 +144,7 @@ callQuery = do return $ either (const Nothing) bodyGetCurrentState reply matchSignal - :: ( HasLogFunc (env SesClient) - , HasClient env + :: ( HasClient env , MonadReader (env SesClient) m , MonadUnliftIO m ) diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs index 4e3a712..e646de8 100644 --- a/lib/XMonad/Internal/IO.hs +++ b/lib/XMonad/Internal/IO.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} - -------------------------------------------------------------------------------- -- Random IO-ish functions used throughtout xmonad -- @@ -41,7 +39,7 @@ import System.Process -- read readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a -readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8 +readInt = fmap (fromMaybe 0 . readMaybe . takeWhile isDigit . T.unpack) . readFileUtf8 readBool :: MonadIO m => FilePath -> m Bool readBool = fmap (== (1 :: Int)) . readInt @@ -49,7 +47,7 @@ readBool = fmap (== (1 :: Int)) . readInt -------------------------------------------------------------------------------- -- write -writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m () +writeInt :: (MonadIO m, Show a) => FilePath -> a -> m () writeInt f = writeFileUtf8 f . T.pack . show writeBool :: MonadIO m => FilePath -> Bool -> m () @@ -62,7 +60,7 @@ writeBool f b = writeInt f ((if b then 1 else 0) :: Int) -- value. Assume that the file being read has a min of 0 and an unchanging max -- given by a runtime argument, which is scaled linearly to the range 0-100 -- (percent). -rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c +rawToPercent :: (Integral a, Integral b, RealFrac c) => (a, a) -> b -> c rawToPercent (lower, upper) raw = 100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower) diff --git a/lib/XMonad/Internal/Notify.hs b/lib/XMonad/Internal/Notify.hs index cd2f540..b5f3b91 100644 --- a/lib/XMonad/Internal/Notify.hs +++ b/lib/XMonad/Internal/Notify.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Functions for formatting and sending notifications -- diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index e91a0ed..6fe6a05 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- Functions for formatting and spawning shell commands module XMonad.Internal.Shell @@ -85,10 +83,7 @@ spawn :: MonadIO m => T.Text -> m () spawn = X.spawn . T.unpack -- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input. -spawnPipe - :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) - => T.Text - -> m Handle +spawnPipe :: MonadUnliftIO m => T.Text -> m Handle spawnPipe = liftIO . XR.spawnPipe . T.unpack -- spawnPipeRW diff --git a/lib/XMonad/Internal/Theme.hs b/lib/XMonad/Internal/Theme.hs index 4e38c47..1255195 100644 --- a/lib/XMonad/Internal/Theme.hs +++ b/lib/XMonad/Internal/Theme.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Theme for XMonad and Xmobar @@ -33,6 +31,7 @@ where import Data.Colour import Data.Colour.SRGB +import RIO import qualified RIO.Text as T import qualified XMonad.Layout.Decoration as D import qualified XMonad.Prompt as P diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs index 137928a..f703e37 100644 --- a/lib/Xmobar/Plugins/BacklightCommon.hs +++ b/lib/Xmobar/Plugins/BacklightCommon.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- Common backlight plugin bits -- -- Use the custom DBus interface exported by the XMonad process so I can react diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index 2734bcb..3f99cff 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Bluetooth plugin -- diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs index a4b8975..f62b922 100644 --- a/lib/Xmobar/Plugins/ClevoKeyboard.hs +++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Clevo Keyboard plugin -- @@ -12,6 +10,7 @@ module Xmobar.Plugins.ClevoKeyboard ) where +import RIO import qualified RIO.Text as T import XMonad.Internal.DBus.Brightness.ClevoKeyboard import Xmobar diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index abefb83..ff21f21 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Xmobar.Plugins.Common ( colorText , startListener @@ -33,8 +31,7 @@ data Colors = Colors deriving (Eq, Show, Read) startListener - :: ( HasLogFunc (env c) - , HasClient env + :: ( HasClient env , MonadReader (env c) m , MonadUnliftIO m , SafeClient c diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs index 7f5fe97..6ce6fbb 100644 --- a/lib/Xmobar/Plugins/Device.hs +++ b/lib/Xmobar/Plugins/Device.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -------------------------------------------------------------------------------- -- Device plugin -- diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index 55f293e..e5c5bc9 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Intel backlight plugin -- @@ -12,6 +10,7 @@ module Xmobar.Plugins.IntelBacklight ) where +import RIO import qualified RIO.Text as T import XMonad.Internal.DBus.Brightness.IntelBacklight import Xmobar diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 5ac35fc..01a6a81 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- Screensaver plugin -- @@ -13,6 +11,7 @@ module Xmobar.Plugins.Screensaver where import Data.Internal.DBus +import RIO import qualified RIO.Text as T import XMonad.Internal.DBus.Screensaver import Xmobar diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index e9c0652..20b060e 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - -------------------------------------------------------------------------------- -- VPN plugin -- @@ -57,7 +54,7 @@ data VEnv c = VEnv , vEnv :: !SimpleApp } -instance SafeClient c => HasLogFunc (VEnv c) where +instance HasLogFunc (VEnv c) where logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL instance HasClient VEnv where diff --git a/package.yaml b/package.yaml index b471e6c..1d44bf2 100644 --- a/package.yaml +++ b/package.yaml @@ -13,6 +13,43 @@ extra-source-files: - scripts/* - sound/* +default-extensions: + - OverloadedStrings + - FlexibleContexts + - FlexibleInstances + - InstanceSigs + - MultiParamTypeClasses + - EmptyCase + - LambdaCase + - MultiWayIf + - NamedFieldPuns + - TupleSections + - DeriveFoldable + - DeriveFunctor + - DeriveGeneric + - DeriveLift + - DeriveTraversable + - DerivingStrategies + - DeriveDataTypeable + - EmptyDataDecls + - PartialTypeSignatures + - GeneralizedNewtypeDeriving + - StandaloneDeriving + - BangPatterns + - TypeOperators + - ScopedTypeVariables + - TypeApplications + - ConstraintKinds + - RankNTypes + - GADTs + - DefaultSignatures + - NoImplicitPrelude + - FunctionalDependencies + - DataKinds + - TypeFamilies + - BinaryLiterals + - ViewPatterns + dependencies: - rio >= 0.1.21.0 - X11 >= 1.9.1 @@ -37,13 +74,19 @@ dependencies: - unliftio >= 0.2.21.0 - optparse-applicative >= 0.16.1.0 +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wredundant-constraints +- -Wpartial-fields +- -Werror +- -O2 + library: source-dirs: lib/ - ghc-options: - - -Wall - - -Werror - - -Wpartial-fields - - -O2 executables: xmobar: &bin @@ -53,21 +96,15 @@ executables: - xmonad-config ghc-options: - -threaded - - -Wall - - -Werror - - -Wpartial-fields - - -O2 xmonad: <<: *bin main: xmonad.hs ghc-options: - -threaded - - -Wall - - -Werror - - -Wpartial-fields - - -O2 # this is needed to avoid writing super complex layout types - -fno-warn-missing-signatures vbox-start: <<: *bin main: vbox-start.hs + ghc-options: + - -threaded