REF update compiler flags

This commit is contained in:
Nathan Dwarshuis 2023-02-12 23:08:05 -05:00
parent 7d5a82bd07
commit 71e86f2233
31 changed files with 128 additions and 159 deletions

View File

@ -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

View File

@ -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

View File

@ -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"] $

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- General commands

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- Automatically Manage Dynamic Workspaces
-- This is a somewhat convoluted wrapper for the Dymamic Workspaces module

View File

@ -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) ->

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
)

View File

@ -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
)

View File

@ -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)

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- Functions for formatting and sending notifications
--

View File

@ -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

View File

@ -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

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
-- Common backlight plugin bits
--
-- Use the custom DBus interface exported by the XMonad process so I can react

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- Bluetooth plugin
--

View File

@ -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

View File

@ -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

View File

@ -1,6 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- Device plugin
--

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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