REF use RIO text pretty much everywhere

bin/vbox-start.hs

@@ -21,6 +21,8 @@ import           Control.Exception
 
 import           Data.List
 
+import qualified RIO.Text                              as T
+
 import           Text.Read
 import           Text.XML.Light
 
@@ -34,7 +36,7 @@ main :: IO ()
 main = runAndWait =<< getArgs
 
 runAndWait :: [String] -> IO ()
-runAndWait [n] = either putStrLn runConfig =<< vmInstanceConfig n
+runAndWait [n] = either (putStrLn . T.unpack) runConfig =<< vmInstanceConfig (T.pack n)
   where
     runConfig c = maybe err runID =<< vmMachineID c
     runID i = do

bin/xmobar.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main (main) where
 
 --------------------------------------------------------------------------------
@@ -18,6 +20,8 @@ import           Data.Internal.Dependency
 import           Data.List
 import           Data.Maybe
 
+import qualified RIO.Text                                       as T
+
 import           System.Environment
 import           System.Exit
 import           System.IO
@@ -32,7 +36,6 @@ import           Xmobar.Plugins.VPN
 
 import           System.Posix.Signals
 import           XMonad.Core                                    hiding (config)
-import           XMonad.Hooks.DynamicLog                        hiding (xmobar)
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.Command.Power
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
@@ -40,7 +43,7 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Screensaver               (ssSignalDep)
 import           XMonad.Internal.Process                        hiding (CmdSpec)
-import qualified XMonad.Internal.Theme                          as T
+import qualified XMonad.Internal.Theme                          as XT
 import           Xmobar                                         hiding
     ( iconOffset
     , run
@@ -81,7 +84,7 @@ printDeps :: FIO ()
 printDeps = do
   db <- io connectDBus
   let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
-  io $ mapM_ putStrLn ps
+  io $ mapM_ (putStrLn . T.unpack) ps
   io $ disconnectDBus db
 
 usage :: IO ()
@@ -94,7 +97,7 @@ usage = putStrLn $ intercalate "\n"
 -- | toplevel configuration
 
 -- | The text font family
-textFont :: Always T.FontBuilder
+textFont :: Always XT.FontBuilder
 textFont = fontAlways "XMobar Text Font" "DejaVu Sans Mono" defFontPkgs
 
 -- | Offset of the text in the bar
@@ -102,11 +105,11 @@ textFontOffset :: Int
 textFontOffset = 16
 
 -- | Attributes for the bar font (size, weight, etc)
-textFontData :: T.FontData
+textFontData :: XT.FontData
-textFontData = T.defFontData { T.weight = Just T.Bold, T.size = Just 11 }
+textFontData = XT.defFontData { XT.weight = Just XT.Bold, XT.size = Just 11 }
 
 -- | The icon font family
-iconFont :: Sometimes T.FontBuilder
+iconFont :: Sometimes XT.FontBuilder
 iconFont = fontSometimes "XMobar Icon Font" "Symbols Nerd Font"
   [Package Official "ttf-nerd-fonts-symbols-2048-em"]
 
@@ -125,28 +128,28 @@ iconSize IconLarge  = 18
 iconSize IconXLarge = 20
 
 -- | Attributes for icon fonts
-iconFontData :: Int -> T.FontData
+iconFontData :: Int -> XT.FontData
-iconFontData s = T.defFontData { T.pixelsize = Just s, T.size = Nothing }
+iconFontData s = XT.defFontData { XT.pixelsize = Just s, XT.size = Nothing }
 
 -- | Global configuration
 -- Note that the 'font' and 'textOffset' are assumed to pertain to one (and
 -- only one) text font, and all other fonts are icon fonts. If this assumption
 -- changes the code will need to change significantly
-config :: String -> [String] -> [Int] -> BarRegions -> FilePath -> Config
+config :: T.Text -> [T.Text] -> [Int] -> BarRegions -> FilePath -> Config
 config bf ifs ios br confDir = defaultConfig
-  { font = bf
+  { font = T.unpack bf
-  , additionalFonts = ifs
+  , additionalFonts = fmap T.unpack ifs
   , textOffset = textFontOffset
   , textOffsets = ios
-  , bgColor = T.bgColor
+  , bgColor = T.unpack XT.bgColor
-  , fgColor = T.fgColor
+  , fgColor = T.unpack XT.fgColor
   , position = BottomSize C 100 24
   , border = NoBorder
-  , borderColor = T.bordersColor
+  , borderColor = T.unpack XT.bordersColor
 
-  , sepChar = pSep
+  , sepChar = T.unpack pSep
   , alignSep = [lSep, rSep]
-  , template = fmtRegions br
+  , template = T.unpack $ fmtRegions br
 
   , lowerOnStart = False
   , hideOnStart = False
@@ -252,25 +255,25 @@ getLock = always1 "lock indicator" "icon indicator" root $ lockCmd fontifyAlt
 --------------------------------------------------------------------------------
 -- | bar feature constructors
 
-xmobarDBus :: SafeClient c => String -> XPQuery -> DBusDependency_ c
+xmobarDBus :: SafeClient c => T.Text -> XPQuery -> DBusDependency_ c
   -> (Fontifier -> CmdSpec) -> Maybe c -> BarFeature
 xmobarDBus n q dep cmd cl = iconDBus_ n q root (Only_ dep)
   where
     root useIcon tree = DBusRoot_ (const $ cmd useIcon) tree cl
 
-iconIO_ :: String -> XPQuery -> (Fontifier -> IOTree_ -> Root CmdSpec)
+iconIO_ :: T.Text -> XPQuery -> (Fontifier -> IOTree_ -> Root CmdSpec)
   -> IOTree_ -> BarFeature
 iconIO_ = iconSometimes' And_ Only_
 
-iconDBus :: SafeClient c => String -> XPQuery
+iconDBus :: SafeClient c => T.Text -> XPQuery
   -> (Fontifier -> DBusTree c p -> Root CmdSpec) -> DBusTree c p -> BarFeature
 iconDBus = iconSometimes' And1 $ Only_ . DBusIO
 
-iconDBus_ :: SafeClient c => String -> XPQuery
+iconDBus_ :: SafeClient c => T.Text -> XPQuery
   -> (Fontifier -> DBusTree_ c -> Root CmdSpec) -> DBusTree_ c -> BarFeature
 iconDBus_ = iconSometimes' And_ $ Only_ . DBusIO
 
-iconSometimes' :: (t -> t_ -> t) -> (IODependency_ -> t_) -> String -> XPQuery
+iconSometimes' :: (t -> t_ -> t) -> (IODependency_ -> t_) -> T.Text -> XPQuery
   -> (Fontifier -> t -> Root CmdSpec) -> t -> BarFeature
 iconSometimes' c d n q r t = Sometimes n q
   [ Subfeature icon "icon indicator"
@@ -290,25 +293,26 @@ data BarRegions = BarRegions
   } deriving Show
 
 data CmdSpec = CmdSpec
-  { csAlias    :: String
+  { csAlias    :: T.Text
   , csRunnable :: Runnable
   } deriving Show
 
 concatRegions :: BarRegions -> [CmdSpec]
 concatRegions (BarRegions l c r) = l ++ c ++ r
 
-wirelessCmd :: String -> CmdSpec
+wirelessCmd :: T.Text -> CmdSpec
 wirelessCmd iface = CmdSpec
-  { csAlias = iface ++ "wi"
+  { csAlias = T.append iface "wi"
-  , csRunnable = Run
+  , csRunnable = Run $ Wireless (T.unpack iface) args 5
-    $ Wireless iface
+  }
+  where
+    args = fmap T.unpack
       [ "-t", "<qualityipat><essid>"
       , "--"
       , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
-    ] 5
+      ]
-  }
 
-ethernetCmd :: Fontifier -> String -> CmdSpec
+ethernetCmd :: Fontifier -> T.Text -> CmdSpec
 ethernetCmd fontify iface = CmdSpec
   { csAlias = iface
   , csRunnable = Run
@@ -318,23 +322,23 @@ ethernetCmd fontify iface = CmdSpec
 batteryCmd :: Fontifier -> CmdSpec
 batteryCmd fontify = CmdSpec
   { csAlias = "battery"
-  , csRunnable = Run
+  , csRunnable = Run $ Battery args 50
-    $ Battery
+  }
+  where
+    fontify' = fontify IconSmall
+    args = fmap T.unpack
       [ "--template", "<acstatus><left>"
       , "--Low", "10"
       , "--High", "80"
       , "--low", "red"
-    , "--normal", T.fgColor
+      , "--normal", XT.fgColor
-    , "--high", T.fgColor
+      , "--high", XT.fgColor
       , "--"
       , "-P"
       , "-o" , fontify' "\xf0e7" "BAT"
       , "-O" , fontify' "\xf1e6" "AC"
       , "-i" , fontify' "\xf1e6" "AC"
-    ] 50
+      ]
-  }
-  where
-    fontify' = fontify IconSmall
 
 vpnCmd :: Fontifier -> CmdSpec
 vpnCmd fontify = CmdSpec
@@ -349,23 +353,24 @@ btCmd fontify = CmdSpec
     $ Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
   }
   where
-    fontify' i = fontify IconLarge i . ("BT" ++)
+    fontify' i = fontify IconLarge i . T.append "BT"
 
 alsaCmd :: Fontifier -> CmdSpec
 alsaCmd fontify = CmdSpec
   { csAlias = "alsa:default:Master"
   , csRunnable = Run
     $ Alsa "default" "Master"
+    $ fmap T.unpack
     [ "-t", "<status><volume>%"
     , "--"
     , "-O", fontify' "\xf028" "+"
-    , "-o", fontify' "\xf026" "-" ++ " "
+    , "-o", T.append (fontify' "\xf026" "-") " "
-    , "-c", T.fgColor
+    , "-c", XT.fgColor
-    , "-C", T.fgColor
+    , "-C", XT.fgColor
     ]
   }
   where
-    fontify' i = fontify IconSmall i . ("VOL" ++)
+    fontify' i = fontify IconSmall i . T.append "VOL"
 
 blCmd :: Fontifier -> CmdSpec
 blCmd fontify = CmdSpec
@@ -390,6 +395,7 @@ lockCmd fontify = CmdSpec
   { csAlias = "locks"
   , csRunnable = Run
     $ Locks
+    $ fmap T.unpack
     [ "-N", numIcon
     , "-n", disabledColor numIcon
     , "-C", capIcon
@@ -403,7 +409,7 @@ lockCmd fontify = CmdSpec
     numIcon = fontify' "\xf8a5" "N"
     capIcon = fontify' "\xf657" "C"
     fontify' = fontify IconXLarge
-    disabledColor = xmobarFGColor T.backdropFgColor
+    disabledColor = xmobarFGColor XT.backdropFgColor
 
 dateCmd :: CmdSpec
 dateCmd = CmdSpec
@@ -422,9 +428,9 @@ vpnPresent =
     go (Right (ExitSuccess, out, _))   = if "vpn" `elem` lines out then Nothing
                                          else Just $ Msg Error "vpn not found"
     go (Right (ExitFailure c, _, err)) = Just $ Msg Error
-                                         $ "vpn search exited with code "
+                                         $ T.concat ["vpn search exited with code "
-                                         ++ show c ++ ": " ++ err
+                                                    , T.pack $ show c, ": ", T.pack err]
-    go (Left e)                        = Just $ Msg Error $ show e
+    go (Left e)                        = Just $ Msg Error $ T.pack $ show e
 
 --------------------------------------------------------------------------------
 -- | text font
@@ -432,7 +438,7 @@ vpnPresent =
 -- ASSUME there is only one text font for this entire configuration. This
 -- will correspond to the first font/offset parameters in the config record.
 
-getTextFont :: FIO String
+getTextFont :: FIO T.Text
 getTextFont = do
   fb <- evalAlways textFont
   return $ fb textFontData
@@ -440,7 +446,7 @@ getTextFont = do
 --------------------------------------------------------------------------------
 -- | icon fonts
 
-getIconFonts :: FIO ([String], [Int])
+getIconFonts :: FIO ([T.Text], [Int])
 getIconFonts = do
   fb <- evalSometimes iconFont
   return $ maybe ([], []) apply fb
@@ -457,16 +463,17 @@ data BarFont = IconSmall
 iconFonts :: [BarFont]
 iconFonts = enumFrom minBound
 
-iconString :: T.FontBuilder -> BarFont -> String
+iconString :: XT.FontBuilder -> BarFont -> T.Text
 iconString fb i = fb $ iconFontData $ iconSize i
 
 iconDependency :: IODependency_
 iconDependency = IOSometimes_ iconFont
 
-fontifyText :: BarFont -> String -> String
+fontifyText :: BarFont -> T.Text -> T.Text
-fontifyText fnt txt = concat ["<fn=", show $ 1 + fromEnum fnt, ">", txt, "</fn>"]
+fontifyText fnt txt =
+  T.concat ["<fn=", T.pack $ show $ 1 + fromEnum fnt, ">", txt, "</fn>"]
 
-type Fontifier = BarFont -> String -> String -> String
+type Fontifier = BarFont -> T.Text -> T.Text -> T.Text
 
 fontifyAlt :: Fontifier
 fontifyAlt _ _ alt = alt
@@ -478,10 +485,10 @@ fontifyIcon f i _ = fontifyText f i
 -- | various formatting things
 
 colors :: Colors
-colors = Colors { colorsOn = T.fgColor, colorsOff = T.backdropFgColor }
+colors = Colors { colorsOn = XT.fgColor, colorsOff = XT.backdropFgColor }
 
-sep :: String
+sep :: T.Text
-sep = xmobarFGColor T.backdropFgColor " : "
+sep = xmobarFGColor XT.backdropFgColor " : "
 
 lSep :: Char
 lSep = '}'
@@ -489,14 +496,14 @@ lSep = '}'
 rSep :: Char
 rSep = '{'
 
-pSep :: String
+pSep :: T.Text
 pSep = "%"
 
-fmtSpecs :: [CmdSpec] -> String
+fmtSpecs :: [CmdSpec] -> T.Text
-fmtSpecs = intercalate sep . fmap go
+fmtSpecs = T.intercalate sep . fmap go
   where
-    go CmdSpec { csAlias = a } = wrap pSep pSep a
+    go CmdSpec { csAlias = a } = T.concat [pSep, a, pSep]
 
-fmtRegions :: BarRegions -> String
+fmtRegions :: BarRegions -> T.Text
-fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } =
+fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } = T.concat $
-  fmtSpecs l ++ [lSep] ++ fmtSpecs c ++ [rSep] ++ fmtSpecs r
+  [fmtSpecs l, T.singleton lSep, fmtSpecs c, T.singleton rSep, fmtSpecs r]

bin/xmonad.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
 
 --------------------------------------------------------------------------------
 -- | XMonad binary
@@ -20,6 +21,7 @@ import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 
 import           RIO                                            (async)
+import qualified RIO.Text                                       as T
 
 import           System.Directory
 import           System.Environment
@@ -51,7 +53,7 @@ import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
-import qualified XMonad.Internal.Theme                          as T
+import qualified XMonad.Internal.Theme                          as XT
 import           XMonad.Layout.MultiToggle
 import           XMonad.Layout.NoBorders
 import           XMonad.Layout.NoFrillsDecoration
@@ -114,8 +116,8 @@ tabbedFeature :: Always Theme
 tabbedFeature = Always "theme for tabbed windows" $ Option sf fallback
   where
     sf = Subfeature niceTheme "theme with nice font"
-    niceTheme = IORoot T.tabbedTheme $ fontTree T.defFontFamily defFontPkgs
+    niceTheme = IORoot XT.tabbedTheme $ fontTree XT.defFontFamily defFontPkgs
-    fallback = Always_ $ FallbackAlone $ T.tabbedTheme T.fallbackFont
+    fallback = Always_ $ FallbackAlone $ XT.tabbedTheme XT.fallbackFont
 
 features :: Maybe SysClient -> FeatureSet
 features cl = FeatureSet
@@ -157,8 +159,8 @@ evalConf db@DBusState { dbSysClient = cl } = do
           , logHook = myLoghook xmobarHandle
           , clickJustFocuses = False
           , focusFollowsMouse = False
-          , normalBorderColor = T.bordersColor
+          , normalBorderColor = T.unpack XT.bordersColor
-          , focusedBorderColor = T.selectedBordersColor
+          , focusedBorderColor = T.unpack XT.selectedBordersColor
           }
   where
     forkIO_ = void . forkIO
@@ -184,7 +186,7 @@ printDeps = do
   let fs = concatMap dumpFeature f
   let ds = concatMap dumpSometimes d
   let ps = fmap showFulfillment $ sort $ nub $ is ++ fs ++ ds
-  io $ mapM_ putStrLn ps
+  io $ mapM_ (putStrLn . T.unpack) ps
   io $ disconnectDBus db
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
@@ -272,7 +274,7 @@ vmDynamicWorkspace = Sometimes "virtualbox workspace" xpfVirtualBox
   where
     root = IORoot_ dw $ toAnd_ (sysExe [Package Official "virtualbox"] "VBoxManage")
       $ IOTest_ name [] $ vmExists vm
-    name = unwords ["test if", vm, "exists"]
+    name = T.unwords ["test if", vm, "exists"]
     c = "VirtualBoxVM"
     vm = "win8raw"
     dw = DynWorkspace
@@ -435,35 +437,39 @@ whenChanged v action = do
 logXinerama :: Handle -> X ()
 logXinerama h = withWindowSet $ \ws -> io
   $ hPutStrLn h
-  $ unwords
+  $ T.unpack
-  $ filter (not . null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
+  $ T.unwords
+  $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
   where
-    onScreen ws = xmobarColor hilightFgColor hilightBgColor
+    onScreen ws = xmobarColor_ hilightFgColor hilightBgColor
-      $ pad
+      $ (T.pack . pad . T.unpack)
-      $ unwords
+      $ T.unwords
       $ map (fmtTags ws . W.tag . W.workspace)
       $ sortBy compareXCoord
       $ W.current ws : W.visible ws
-    offScreen ws = xmobarColor T.backdropFgColor ""
+    offScreen = xmobarColor_ XT.backdropFgColor ""
-      $ unwords
+      . T.unwords
-      $ map W.tag
+      . fmap (T.pack . W.tag)
-      $ filter (isJust . W.stack)
+      . filter (isJust . W.stack)
-      $ sortOn W.tag
+      . sortOn W.tag
-      $ W.hidden ws
+      . W.hidden
-    sep = xmobarColor T.backdropFgColor "" ":"
+    sep = xmobarColor_ XT.backdropFgColor "" ":"
-    layout ws = description $ W.layout $ W.workspace $ W.current ws
+    layout = T.pack . description . W.layout . W.workspace . W.current
-    nWindows ws = wrap "(" ")"
+    nWindows = (\x -> T.concat ["(", x, ")"])
-      $ show
+      . T.pack
-      $ length
+      . show
-      $ W.integrate'
+      . length
-      $ W.stack
+      . W.integrate'
-      $ W.workspace
+      . W.stack
-      $ W.current ws
+      . W.workspace
+      . W.current
     hilightBgColor = "#A6D3FF"
-    hilightFgColor = T.blend' 0.4 hilightBgColor T.fgColor
+    hilightFgColor = XT.blend' 0.4 hilightBgColor XT.fgColor
-    fmtTags ws t = if t == W.currentTag ws
+    fmtTags ws t = let t_ = T.pack t in
-      then xmobarColor T.fgColor hilightBgColor t
+      if t == W.currentTag ws
-      else t
+      then xmobarColor_ XT.fgColor hilightBgColor t_
+      else t_
+    xmobarColor_ a b c = T.pack $ xmobarColor (T.unpack a) (T.unpack b) (T.unpack c)
 
 compareXCoord
   :: W.Screen i1 l1 a1 ScreenId ScreenDetail
@@ -511,7 +517,7 @@ xMsgEventHook handler ClientMessageEvent { ev_message_type = t, ev_data = d }
     case xtype of
       Workspace -> removeDynamicWorkspace tag
       ACPI      -> handler tag
-      Unknown   -> io $ print "WARNING: unknown concurrent message"
+      Unknown   -> io $ putStrLn "WARNING: unknown concurrent message"
     return (All True)
 xMsgEventHook _ _ = return (All True)
 

lib/Data/Internal/DBus.hs

@@ -34,6 +34,8 @@ import           Data.Bifunctor
 import qualified Data.Map.Strict   as M
 import           Data.Maybe
 
+import qualified RIO.Text          as T
+
 import           DBus
 import           DBus.Client
 
@@ -86,10 +88,10 @@ getDBusClient' sys = do
 --------------------------------------------------------------------------------
 -- | Methods
 
-type MethodBody = Either String [Variant]
+type MethodBody = Either T.Text [Variant]
 
 callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl = fmap (bimap methodErrorMessage methodReturnBody)
+callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
   . call (toClient cl)
 
 callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
@@ -175,24 +177,24 @@ withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure   = f Nothing
 withSignalMatch _ NoMatch   = return ()
 
-matchPropertyChanged :: IsVariant a => InterfaceName -> String -> [Variant]
+matchPropertyChanged :: IsVariant a => InterfaceName -> T.Text -> [Variant]
   -> SignalMatch a
 matchPropertyChanged iface property [i, body, _] =
-  let i' = (fromVariant i :: Maybe String)
+  let i' = (fromVariant i :: Maybe T.Text)
       b = toMap body in
     case (i', b) of
-      (Just i'', Just b') -> if i'' == formatInterfaceName iface then
+      (Just i'', Just b') -> if i'' == T.pack (formatInterfaceName iface) then
         maybe NoMatch Match $ fromVariant =<< M.lookup property b'
         else NoMatch
       _                   -> Failure
   where
-    toMap v = fromVariant v :: Maybe (M.Map String Variant)
+    toMap v = fromVariant v :: Maybe (M.Map T.Text Variant)
 matchPropertyChanged _ _ _ = Failure
 
 --------------------------------------------------------------------------------
 -- | Object Manager
 
-type ObjectTree = M.Map ObjectPath (M.Map String (M.Map String Variant))
+type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))
 
 omInterface :: InterfaceName
 omInterface = interfaceName_ "org.freedesktop.DBus.ObjectManager"

lib/Data/Internal/Dependency.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE GADTs               #-}
+{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -125,6 +126,7 @@ import           DBus                    hiding (typeOf)
 import qualified DBus.Introspection      as I
 
 import           RIO                     hiding (LogLevel, bracket, fromString)
+import qualified RIO.Text                as T
 
 import           System.Directory
 import           System.Environment
@@ -179,14 +181,16 @@ evalAlways a = do
   mapM_ printMsg ws
   return x
 
+-- TODO use real logging functions
 printMsg :: FMsg -> FIO ()
 printMsg (FMsg fn n (Msg ll m)) = do
   xl <- asks xpLogLevel
   p <- io getProgName
-  io $ when (ll <= xl) $ putStrLn $ unwords $ s p
+  io $ when (ll <= xl) $
+    putStrLn $ T.unpack $ T.concat $ s (T.pack p)
   where
     s p = [ bracket p
-          , bracket $ show ll
+          , bracket $ T.pack $ show ll
           , bracket fn
           ]
           ++ maybe [] ((:[]) . bracket) n
@@ -195,8 +199,8 @@ printMsg (FMsg fn n (Msg ll m)) = do
 --------------------------------------------------------------------------------
 -- | Package status
 
-showFulfillment :: Fulfillment -> String
+showFulfillment :: Fulfillment -> T.Text
-showFulfillment (Package t n) = show t ++ "\t" ++ n
+showFulfillment (Package t n) = T.concat [T.pack $ show t, "\t", n]
 
 dumpFeature :: Feature a -> [Fulfillment]
 dumpFeature = either dumpSometimes dumpAlways
@@ -228,7 +232,7 @@ type Feature a = Either (Sometimes a) (Always a)
 -- | Feature that is guaranteed to work
 -- This is composed of sub-features that are tested in order, and if all fail
 -- the fallback is a monadic action (eg a plain haskell function)
-data Always a = Always String (Always_ a)
+data Always a = Always T.Text (Always_ a)
 
 -- | Feature that is guaranteed to work (inner data)
 data Always_ a = Option (SubfeatureRoot a) (Always_ a)
@@ -247,7 +251,7 @@ data FallbackStack p = FallbackBottom (Always p)
 -- | Feature that might not be present
 -- This is like an Always except it doesn't fall back on a guaranteed monadic
 -- action
-data Sometimes a = Sometimes String XPQuery (Sometimes_ a)
+data Sometimes a = Sometimes T.Text XPQuery (Sometimes_ a)
 
 -- | Feature that might not be present (inner data)
 type Sometimes_ a = [SubfeatureRoot a]
@@ -258,7 +262,7 @@ type Sometimes_ a = [SubfeatureRoot a]
 -- sub-feature.
 data Subfeature f = Subfeature
   { sfData :: f
-  , sfName :: String
+  , sfName :: T.Text
   }
 
 -- | Loglevel at which feature testing should be reported
@@ -296,7 +300,7 @@ type DBusTree_ c = Tree_ (DBusDependency_ c)
 -- | A dependency that only requires IO to evaluate (with payload)
 data IODependency p =
   -- an IO action that yields a payload
-  IORead String [Fulfillment] (FIO (Result p))
+  IORead T.Text [Fulfillment] (FIO (Result p))
   -- always yields a payload
   | IOConst p
   -- an always that yields a payload
@@ -312,7 +316,7 @@ data DBusDependency_ c = Bus [Fulfillment] BusName
 
 -- | A dependency that only requires IO to evaluate (no payload)
 data IODependency_ = IOSystem_ [Fulfillment] SystemDependency
-  | IOTest_ String [Fulfillment] (IO (Maybe Msg))
+  | IOTest_ T.Text [Fulfillment] (IO (Maybe Msg))
   | forall a. IOSometimes_ (Sometimes a)
 
 -- | A system component to an IODependency
@@ -320,8 +324,8 @@ data IODependency_ = IOSystem_ [Fulfillment] SystemDependency
 data SystemDependency =
   Executable Bool FilePath
   | AccessiblePath FilePath Bool Bool
-  | Systemd UnitType String
+  | Systemd UnitType T.Text
-  | Process String
+  | Process T.Text
   deriving (Eq, Show, Generic)
 
 -- | The type of a systemd service
@@ -330,12 +334,12 @@ data UnitType = SystemUnit | UserUnit deriving (Eq, Show, Generic)
 -- | Wrapper type to describe and endpoint
 data DBusMember = Method_ MemberName
   | Signal_ MemberName
-  | Property_ String
+  | Property_ T.Text
   deriving (Eq, Show, Generic)
 
 -- | A means to fulfill a dependency
 -- For now this is just the name of an Arch Linux package (AUR or official)
-data Fulfillment = Package ArchPkg String deriving (Eq, Show, Ord)
+data Fulfillment = Package ArchPkg T.Text deriving (Eq, Show, Ord)
 
 data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
 
@@ -346,10 +350,10 @@ data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
 -- and dump on the CLI (unless there is a way to make Aeson work inside an IO)
 
 -- | A message with criteria for when to show it
-data Msg = Msg LogLevel String
+data Msg = Msg LogLevel T.Text
 
 -- | A message annotated with subfeature and feature name
-data FMsg = FMsg String (Maybe String) Msg
+data FMsg = FMsg T.Text (Maybe T.Text) Msg
 
 -- | Tested Always feature
 data PostAlways a = Primary (SubfeaturePass a) [SubfeatureFail] (Always_ a)
@@ -493,13 +497,13 @@ evalAlwaysMsg (Always n x) = do
     (Primary p fs _)  -> second (++ failedMsgs n fs) $ passActMsg n p
     (Fallback act fs) -> (act, failedMsgs n fs)
 
-passActMsg :: String -> SubfeaturePass a -> (a, [FMsg])
+passActMsg :: T.Text -> SubfeaturePass a -> (a, [FMsg])
 passActMsg fn Subfeature { sfData = PostPass a ws, sfName = n } = (a, fmap (FMsg fn (Just n)) ws)
 
-failedMsgs :: String -> [SubfeatureFail] -> [FMsg]
+failedMsgs :: T.Text -> [SubfeatureFail] -> [FMsg]
 failedMsgs n = concatMap (failedMsg n)
 
-failedMsg :: String -> SubfeatureFail -> [FMsg]
+failedMsg :: T.Text -> SubfeatureFail -> [FMsg]
 failedMsg fn Subfeature { sfData = d, sfName = n } = case d of
   (PostFail es)   -> f es
   (PostMissing e) -> f [e]
@@ -636,14 +640,14 @@ testSysDependency :: SystemDependency -> IO (Maybe Msg)
 testSysDependency (Executable sys bin) = maybe (Just msg) (const Nothing)
   <$> findExecutable bin
   where
-    msg = Msg Error $ unwords [e, "executable", singleQuote bin, "not found"]
+    msg = Msg Error $ T.concat [e, "executable", singleQuote $ T.pack bin, "not found"]
     e = if sys then "system" else "local"
 testSysDependency (Systemd t n) = shellTest cmd msg
   where
-    msg = unwords ["systemd", unitType t, "unit", singleQuote n, "not found"]
+    msg = T.concat ["systemd", unitType t, "unit", singleQuote n, "not found"]
     cmd = fmtCmd "systemctl" $ ["--user" | t == UserUnit] ++ ["status", n]
 testSysDependency (Process n) = shellTest (fmtCmd "pidof" [n])
-  $ "Process " ++ singleQuote n ++ " not found"
+  $ T.unwords ["Process", singleQuote n, "not found"]
 testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
   where
     testPerm False _ _  = Nothing
@@ -658,14 +662,14 @@ testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
         (_, Just False)          -> mkErr "file not writable"
         _                        -> Nothing
 
-shellTest :: String -> String -> IO (Maybe Msg)
+shellTest :: T.Text -> T.Text -> IO (Maybe Msg)
 shellTest cmd msg = do
-  (rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
+  (rc, _, _) <- readCreateProcessWithExitCode' (shell $ T.unpack cmd) ""
   return $ case rc of
     ExitSuccess -> Nothing
     _           -> Just $ Msg Error msg
 
-unitType :: UnitType -> String
+unitType :: UnitType -> T.Text
 unitType SystemUnit = "system"
 unitType UserUnit   = "user"
 
@@ -675,44 +679,44 @@ unitType UserUnit   = "user"
 -- Make a special case for these since we end up testing the font alot, and it
 -- would be nice if I can cache them.
 
-fontAlways :: String -> String -> [Fulfillment] -> Always FontBuilder
+fontAlways :: T.Text -> T.Text -> [Fulfillment] -> Always FontBuilder
 fontAlways n fam ful = always1 n (fontFeatureName fam) root fallbackFont
   where
     root = IORoot id $ fontTree fam ful
 
-fontSometimes :: String -> String -> [Fulfillment]-> Sometimes FontBuilder
+fontSometimes :: T.Text -> T.Text -> [Fulfillment]-> Sometimes FontBuilder
 fontSometimes n fam ful = sometimes1 n (fontFeatureName fam) root
   where
     root = IORoot id $ fontTree fam ful
 
-fontFeatureName :: String -> String
+fontFeatureName :: T.Text -> T.Text
-fontFeatureName n = unwords ["Font family for", singleQuote n]
+fontFeatureName n = T.unwords ["Font family for", singleQuote n]
 
-fontTreeAlt :: String -> [Fulfillment] -> Tree IODependency d_ FontBuilder
+fontTreeAlt :: T.Text -> [Fulfillment] -> Tree IODependency d_ FontBuilder
 fontTreeAlt fam ful = Or (fontTree fam ful) $ Only $ IOConst fallbackFont
 
-fontTree :: String -> [Fulfillment] -> Tree IODependency d_ FontBuilder
+fontTree :: T.Text -> [Fulfillment] -> Tree IODependency d_ FontBuilder
 fontTree n = Only . fontDependency n
 
-fontTree_ :: String -> [Fulfillment] -> IOTree_
+fontTree_ :: T.Text -> [Fulfillment] -> IOTree_
 fontTree_ n = Only_ . fontDependency_ n
 
-fontDependency :: String -> [Fulfillment] -> IODependency FontBuilder
+fontDependency :: T.Text -> [Fulfillment] -> IODependency FontBuilder
 fontDependency fam ful = IORead (fontTestName fam) ful $ testFont fam
 
-fontDependency_ :: String -> [Fulfillment] -> IODependency_
+fontDependency_ :: T.Text -> [Fulfillment] -> IODependency_
 fontDependency_ fam ful = IOTest_ (fontTestName fam) ful $ voidRead <$> testFont' fam
 
-fontTestName :: String -> String
+fontTestName :: T.Text -> T.Text
-fontTestName fam = unwords ["test if font", singleQuote fam, "exists"]
+fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 
-testFont :: String -> FIO (Result FontBuilder)
+testFont :: T.Text -> FIO (Result FontBuilder)
 testFont = liftIO . testFont'
 
-testFont' :: String -> IO (Result FontBuilder)
+testFont' :: T.Text -> IO (Result FontBuilder)
 testFont' fam = maybe pass (Left . (:[])) <$> shellTest cmd msg
   where
-    msg = unwords ["font family", qFam, "not found"]
+    msg = T.unwords ["font family", qFam, "not found"]
     cmd = fmtCmd "fc-list" ["-q", qFam]
     qFam = singleQuote fam
     pass = Right $ PostPass (buildFont $ Just fam) []
@@ -723,29 +727,28 @@ testFont' fam = maybe pass (Left . (:[])) <$> shellTest cmd msg
 -- ASSUME that the system uses systemd in which case ethernet interfaces always
 -- start with "en" and wireless interfaces always start with "wl"
 
-readEthernet :: IODependency String
+readEthernet :: IODependency T.Text
 readEthernet = readInterface "get ethernet interface" isEthernet
 
-readWireless :: IODependency String
+readWireless :: IODependency T.Text
 readWireless = readInterface "get wireless interface" isWireless
 
-isWireless :: String -> Bool
+isWireless :: T.Text -> Bool
-isWireless ('w':'l':_) = True
+isWireless = T.isPrefixOf "wl"
-isWireless _           = False
 
-isEthernet :: String -> Bool
+isEthernet :: T.Text -> Bool
-isEthernet ('e':'n':_) = True
+isEthernet = T.isPrefixOf "en"
-isEthernet _           = False
 
-listInterfaces :: IO [String]
+listInterfaces :: IO [T.Text]
-listInterfaces = fromRight [] <$> tryIOError (listDirectory sysfsNet)
+listInterfaces = fromRight []
+  <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
 
 sysfsNet :: FilePath
 sysfsNet = "/sys/class/net"
 
 -- ASSUME there are no (non-base) packages required to make these interfaces
 -- work (all at the kernel level)
-readInterface :: String -> (String -> Bool) -> IODependency String
+readInterface :: T.Text -> (T.Text -> Bool) -> IODependency T.Text
 readInterface n f = IORead n [] go
   where
     go = io $ do
@@ -754,13 +757,13 @@ readInterface n f = IORead n [] go
         [] -> return $ Left [Msg Error "no interfaces found"]
         (x:xs) -> do
           return $ Right $ PostPass x
-            $ fmap (Msg Warn . ("ignoring extra interface: " ++)) xs
+            $ fmap (Msg Warn . T.append "ignoring extra interface: ") xs
 
 --------------------------------------------------------------------------------
 -- | Misc testers
 
-socketExists :: String -> [Fulfillment] -> IO FilePath -> IODependency_
+socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
-socketExists n ful = IOTest_ ("test if " ++ n ++ " socket exists") ful
+socketExists n ful = IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
   . socketExists'
 
 socketExists' :: IO FilePath -> IO (Maybe Msg)
@@ -768,8 +771,8 @@ socketExists' getPath = do
   p <- getPath
   r <- tryIOError $ getFileStatus p
   return $ case r of
-    Left e  -> toErr $ ioe_description e
+    Left e  -> toErr $ T.pack $ ioe_description e
-    Right s -> if isSocket s then Nothing else toErr $ p ++ " is not a socket"
+    Right s -> if isSocket s then Nothing else toErr $ T.append (T.pack p) " is not a socket"
   where
     toErr = Just . Msg Error
 
@@ -793,15 +796,15 @@ testDBusDepNoCache_ cl (Bus _ bus) = io $ do
         Right b -> let ns = bodyGetNames b in
           if bus' `elem` ns then Right []
           else Left [
-            Msg Error $ unwords ["name", singleQuote bus', "not found on dbus"]
+            Msg Error $ T.unwords ["name", singleQuote bus', "not found on dbus"]
             ]
   where
-    bus' = formatBusName bus
+    bus' = T.pack $ formatBusName bus
     queryBus = busName_ "org.freedesktop.DBus"
     queryIface = interfaceName_ "org.freedesktop.DBus"
     queryPath = objectPath_ "/"
     queryMem = memberName_ "ListNames"
-    bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
+    bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [T.Text]
     bodyGetNames _   = []
 
 testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
@@ -820,18 +823,18 @@ testDBusDepNoCache_ cl (Endpoint _ busname objpath iface mem) = io $ do
       . I.objectInterfaces
     matchMem (Method_ n)   = elemMember n I.methodName I.interfaceMethods
     matchMem (Signal_ n)   = elemMember n I.signalName I.interfaceSignals
-    matchMem (Property_ n) = elemMember n I.propertyName I.interfaceProperties
+    matchMem (Property_ n) = elemMember n (T.pack . I.propertyName) I.interfaceProperties
     elemMember n fname fmember = elem n . fmap fname . fmember
-    fmtMem (Method_ n)   = "method " ++ singleQuote (formatMemberName n)
+    fmtMem (Method_ n)   = T.unwords ["method", singleQuote (T.pack $ formatMemberName n)]
-    fmtMem (Signal_ n)   = "signal " ++ singleQuote (formatMemberName n)
+    fmtMem (Signal_ n)   = T.unwords ["signal", singleQuote (T.pack $ formatMemberName n)]
-    fmtMem (Property_ n) = "property " ++ singleQuote n
+    fmtMem (Property_ n) = T.unwords ["property", singleQuote n]
-    fmtMsg' m = unwords
+    fmtMsg' m = T.unwords
       [ "could not find"
       , fmtMem m
       , "on interface"
-      , singleQuote $ formatInterfaceName iface
+      , singleQuote $ T.pack $ formatInterfaceName iface
       , "on bus"
-      , formatBusName busname
+      , T.pack $ formatBusName busname
       ]
 
 testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
@@ -865,40 +868,40 @@ ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
 --------------------------------------------------------------------------------
 -- | Feature constructors
 
-sometimes1_ :: XPQuery -> String -> String -> Root a -> Sometimes a
+sometimes1_ :: XPQuery -> T.Text -> T.Text -> Root a -> Sometimes a
 sometimes1_ x fn n t = Sometimes fn x
   [Subfeature{ sfData = t, sfName = n }]
 
-always1_ :: String -> String -> Root a -> a -> Always a
+always1_ :: T.Text -> T.Text -> Root a -> a -> Always a
 always1_ fn n t x = Always fn
   $ Option (Subfeature{ sfData = t, sfName = n }) (Always_ $ FallbackAlone x)
 
-sometimes1 :: String -> String -> Root a -> Sometimes a
+sometimes1 :: T.Text -> T.Text -> Root a -> Sometimes a
 sometimes1 = sometimes1_ (const True)
 
-always1 :: String -> String -> Root a -> a -> Always a
+always1 :: T.Text -> T.Text -> Root a -> a -> Always a
 always1 = always1_
 
-sometimesIO_ :: String -> String -> IOTree_ -> a -> Sometimes a
+sometimesIO_ :: T.Text -> T.Text -> IOTree_ -> a -> Sometimes a
 sometimesIO_ fn n t x = sometimes1 fn n $ IORoot_ x t
 
-sometimesIO :: String -> String -> IOTree p -> (p -> a) -> Sometimes a
+sometimesIO :: T.Text -> T.Text -> IOTree p -> (p -> a) -> Sometimes a
 sometimesIO fn n t x = sometimes1 fn n $ IORoot x t
 
-sometimesExe :: MonadIO m => String -> String -> [Fulfillment] -> Bool
+sometimesExe :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
   -> FilePath -> Sometimes (m ())
 sometimesExe fn n ful sys path = sometimesExeArgs fn n ful sys path []
 
-sometimesExeArgs :: MonadIO m => String -> String -> [Fulfillment] -> Bool
+sometimesExeArgs :: MonadIO m => T.Text -> T.Text -> [Fulfillment] -> Bool
-  -> FilePath -> [String] -> Sometimes (m ())
+  -> FilePath -> [T.Text] -> Sometimes (m ())
 sometimesExeArgs fn n ful sys path args =
   sometimesIO_ fn n (Only_ (IOSystem_ ful $ Executable sys path)) $ spawnCmd path args
 
-sometimesDBus :: SafeClient c => Maybe c -> String -> String
+sometimesDBus :: SafeClient c => Maybe c -> T.Text -> T.Text
   -> Tree_ (DBusDependency_ c) -> (c -> a) -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c
 
-sometimesEndpoint :: (SafeClient c, MonadIO m) => String -> String
+sometimesEndpoint :: (SafeClient c, MonadIO m) => T.Text -> T.Text
   -> [Fulfillment] -> BusName -> ObjectPath -> InterfaceName -> MemberName
   -> Maybe c -> Sometimes (m ())
 sometimesEndpoint fn name ful busname path iface mem cl =
@@ -935,37 +938,37 @@ readResult_ _        = Right []
 --------------------------------------------------------------------------------
 -- | IO Dependency Constructors
 
-exe :: Bool -> [Fulfillment] -> String -> IODependency_
+exe :: Bool -> [Fulfillment] -> FilePath -> IODependency_
 exe b ful = IOSystem_ ful . Executable b
 
-sysExe :: [Fulfillment] -> String -> IODependency_
+sysExe :: [Fulfillment] -> FilePath -> IODependency_
 sysExe = exe True
 
-localExe :: [Fulfillment] -> String -> IODependency_
+localExe :: [Fulfillment] -> FilePath -> IODependency_
 localExe = exe False
 
-path' :: Bool -> Bool -> String -> [Fulfillment] -> IODependency_
+path' :: Bool -> Bool -> FilePath -> [Fulfillment] -> IODependency_
 path' r w n ful = IOSystem_ ful $ AccessiblePath n r w
 
-pathR :: String -> [Fulfillment] -> IODependency_
+pathR :: FilePath -> [Fulfillment] -> IODependency_
 pathR = path' True False
 
-pathW :: String -> [Fulfillment] -> IODependency_
+pathW :: FilePath -> [Fulfillment] -> IODependency_
 pathW = path' False True
 
-pathRW :: String -> [Fulfillment] -> IODependency_
+pathRW :: FilePath -> [Fulfillment] -> IODependency_
 pathRW = path' True True
 
-sysd :: UnitType -> [Fulfillment] -> String -> IODependency_
+sysd :: UnitType -> [Fulfillment] -> T.Text -> IODependency_
 sysd u ful = IOSystem_ ful . Systemd u
 
-sysdUser :: [Fulfillment] -> String -> IODependency_
+sysdUser :: [Fulfillment] -> T.Text -> IODependency_
 sysdUser = sysd UserUnit
 
-sysdSystem :: [Fulfillment] -> String -> IODependency_
+sysdSystem :: [Fulfillment] -> T.Text -> IODependency_
 sysdSystem = sysd SystemUnit
 
-process :: [Fulfillment] -> String -> IODependency_
+process :: [Fulfillment] -> T.Text -> IODependency_
 process ful = IOSystem_ ful . Process
 
 --------------------------------------------------------------------------------
@@ -1022,6 +1025,6 @@ dataDBusDependency d = case d of
 --------------------------------------------------------------------------------
 -- | JSON formatting
 
-bracket :: String -> String
+bracket :: T.Text -> T.Text
-bracket s = "[" ++ s ++ "]"
+bracket s = T.concat ["[", s, "]"]
 

lib/XMonad/Internal/Command/DMenu.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Dmenu (Rofi) Commands
 
@@ -24,6 +26,8 @@ import           DBus
 
 import           Graphics.X11.Types
 
+import qualified RIO.Text                        as T
+
 import           System.Directory
     ( XdgDirectory (..)
     , getXdgDirectory
@@ -41,28 +45,28 @@ import           XMonad.Util.NamedActions
 --------------------------------------------------------------------------------
 -- | DMenu executables
 
-myDmenuCmd :: String
+myDmenuCmd :: FilePath
 myDmenuCmd = "rofi"
 
-myDmenuDevices :: String
+myDmenuDevices :: FilePath
 myDmenuDevices = "rofi-dev"
 
-myDmenuPasswords :: String
+myDmenuPasswords :: FilePath
 myDmenuPasswords = "rofi-bw"
 
-myDmenuBluetooth :: String
+myDmenuBluetooth :: FilePath
 myDmenuBluetooth = "rofi-bt"
 
-myDmenuVPN :: String
+myDmenuVPN :: FilePath
 myDmenuVPN = "rofi-evpn"
 
-myDmenuMonitors :: String
+myDmenuMonitors :: FilePath
 myDmenuMonitors = "rofi-autorandr"
 
-myDmenuNetworks :: String
+myDmenuNetworks :: FilePath
 myDmenuNetworks = "networkmanager_dmenu"
 
-myClipboardManager :: String
+myClipboardManager :: FilePath
 myClipboardManager = "greenclip"
 
 --------------------------------------------------------------------------------
@@ -77,17 +81,17 @@ clipboardPkgs = [Package AUR "rofi-greenclip"]
 --------------------------------------------------------------------------------
 -- | Other internal functions
 
-spawnDmenuCmd :: String -> [String] -> SometimesX
+spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX
 spawnDmenuCmd n =
   sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
 
-themeArgs :: String -> [String]
+themeArgs :: T.Text -> [T.Text]
 themeArgs hexColor =
   [ "-theme-str"
-  , "'#element.selected.normal { background-color: " ++ hexColor ++ "; }'"
+  , T.concat ["'#element.selected.normal { background-color: ", hexColor, "; }'"]
   ]
 
-myDmenuMatchingArgs :: [String]
+myDmenuMatchingArgs :: [T.Text]
 myDmenuMatchingArgs = ["-i"] -- case insensitivity
 
 dmenuTree :: IOTree_ -> IOTree_
@@ -107,7 +111,7 @@ runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
     x = do
       c <- io $ getXdgDirectory XdgConfig "rofi/devices.dhall"
       spawnCmd myDmenuDevices
-        $ ["-c", c]
+        $ ["-c", T.pack c]
         ++ "--" : themeArgs "#999933"
         ++ myDmenuMatchingArgs
 
@@ -174,7 +178,7 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
   where
     act = spawnCmd myDmenuCmd args
     tree = listToAnds dmenuDep [ sysExe clipboardPkgs myClipboardManager
-                               , process [] myClipboardManager
+                               , process [] $ T.pack myClipboardManager
                                ]
     args = [ "-modi", "\"clipboard:greenclip print\""
            , "-show", "clipboard"
@@ -200,7 +204,7 @@ showKeysDMenu = Subfeature
 
 showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
 showKeys kbs = io $ do
-      (h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
+      (h, _, _, _) <- createProcess' $ (shell' $ T.unpack cmd) { std_in = CreatePipe }
       forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
   where
     cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]

lib/XMonad/Internal/Command/Desktop.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | General commands
 
@@ -47,6 +49,8 @@ import           Data.Internal.Dependency
 
 import           DBus
 
+import qualified RIO.Text                    as T
+
 import           System.Directory
 import           System.Environment
 import           System.FilePath
@@ -64,34 +68,34 @@ import           XMonad.Operations
 --------------------------------------------------------------------------------
 -- | My Executables
 
-myTerm :: String
+myTerm :: FilePath
 myTerm = "urxvt"
 
-myCalc :: String
+myCalc :: FilePath
 myCalc = "bc"
 
-myBrowser :: String
+myBrowser :: FilePath
 myBrowser = "brave"
 
-myEditor :: String
+myEditor :: FilePath
 myEditor = "emacsclient"
 
-myEditorServer :: String
+myEditorServer :: FilePath
 myEditorServer = "emacs"
 
-myMultimediaCtl :: String
+myMultimediaCtl :: FilePath
 myMultimediaCtl = "playerctl"
 
-myBluetooth :: String
+myBluetooth :: FilePath
 myBluetooth = "bluetoothctl"
 
-myCapture :: String
+myCapture :: FilePath
 myCapture = "flameshot"
 
-myImageBrowser :: String
+myImageBrowser :: FilePath
 myImageBrowser = "feh"
 
-myNotificationCtrl :: String
+myNotificationCtrl :: FilePath
 myNotificationCtrl = "dunstctl"
 
 --------------------------------------------------------------------------------
@@ -132,7 +136,8 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
     deps = listToAnds (socketExists "tmux" [] socketName)
       $ fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
     act = spawn
-      $ "tmux has-session"
+      $ T.unpack
+      $ fmtCmd "tmux" ["has-session"]
       #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
       #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
     c = "exec tmux attach-session -d"
@@ -146,7 +151,7 @@ runCalc :: SometimesX
 runCalc = sometimesIO_ "calculator" "bc" deps act
   where
     deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package Official "bc"] myCalc)
-    act = spawnCmd myTerm ["-e", myCalc, "-l"]
+    act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
 
 runBrowser :: SometimesX
 runBrowser = sometimesExe "web browser" "brave" [Package AUR "brave-bin"]
@@ -159,7 +164,7 @@ runEditor = sometimesIO_ "text editor" "emacs" tree cmd
       ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
     -- NOTE 1: we could test if the emacs socket exists, but it won't come up
     -- before xmonad starts, so just check to see if the process has started
-    tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] myEditorServer
+    tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
 
 runFileManager :: SometimesX
 runFileManager = sometimesExe "file browser" "pcmanfm" [Package Official "pcmanfm"]
@@ -168,8 +173,8 @@ runFileManager = sometimesExe "file browser" "pcmanfm" [Package Official "pcmanf
 --------------------------------------------------------------------------------
 -- | Multimedia Commands
 
-runMultimediaIfInstalled :: String -> String -> SometimesX
+runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX
-runMultimediaIfInstalled n cmd = sometimesExeArgs (n ++ " multimedia control")
+runMultimediaIfInstalled n cmd = sometimesExeArgs (T.append n " multimedia control")
   "playerctl" [Package Official "playerctl"] True myMultimediaCtl [cmd]
 
 runTogglePlay :: SometimesX
@@ -195,11 +200,11 @@ playSound file = do
   -- manually look up directories to avoid the X monad
   p <- io $ (</> soundDir </> file) . cfgDir <$> getDirectories
   -- paplay seems to have less latency than aplay
-  spawnCmd "paplay" [p]
+  spawnCmd "paplay" [T.pack p]
 
-featureSound :: String -> FilePath -> X () -> X () -> SometimesX
+featureSound :: T.Text -> FilePath -> X () -> X () -> SometimesX
 featureSound n file pre post =
-  sometimesIO_ ("volume " ++ n ++ " control") "paplay" tree
+  sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree
   $ pre >> playSound file >> post
   where
     -- ASSUME pulseaudio pulls in libpulse as a dep; pulseaudio itself is needed
@@ -218,9 +223,9 @@ runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return
 --------------------------------------------------------------------------------
 -- | Notification control
 
-runNotificationCmd :: String -> FilePath -> Maybe SesClient -> SometimesX
+runNotificationCmd :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
 runNotificationCmd n arg cl =
-  sometimesDBus cl (n ++ " control") "dunstctl" tree cmd
+  sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
   where
     cmd _ = spawnCmd myNotificationCtrl [arg]
     tree = toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl)
@@ -260,7 +265,8 @@ runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
   where
     tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs myBluetooth) (Only_ $ Bus [] btBus)
     cmd _ = spawn
-      $ myBluetooth ++ " show | grep -q \"Powered: no\""
+      $ T.unpack
+      $ T.unwords [T.pack myBluetooth, "show | grep -q \"Powered: no\""]
       #!&& "a=on"
       #!|| "a=off"
       #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
@@ -270,11 +276,11 @@ runToggleEthernet :: SometimesX
 runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
   [Subfeature root "nmcli"]
   where
-    root = IORoot (spawn . cmd) $ And1 (Only readEthernet) $ Only_
+    root = IORoot (spawn . T.unpack . cmd) $ And1 (Only readEthernet) $ Only_
       $ sysExe networkManagerPkgs "nmcli"
     -- TODO make this less noisy
     cmd iface =
-      "nmcli -g GENERAL.STATE device show " ++ iface ++ " | grep -q disconnected"
+      T.unwords ["nmcli -g GENERAL.STATE device show", iface, "| grep -q disconnected"]
       #!&& "a=connect"
       #!|| "a=disconnect"
       #!>> fmtCmd "nmcli" ["device", "$a", iface]
@@ -291,7 +297,9 @@ runRecompile :: X ()
 runRecompile = do
   -- assume that the conf directory contains a valid stack project
   confDir <- asks (cfgDir . directories)
-  spawnAt confDir $ fmtCmd "stack" ["install"]
+  spawnAt confDir
+    $ T.unpack
+    $ fmtCmd "stack" ["install"]
     #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
     #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
 
@@ -312,8 +320,8 @@ getCaptureDir = do
   where
     fallback = (</> ".local/share") <$> getHomeDirectory
 
-runFlameshot :: String -> String -> Maybe SesClient -> SometimesX
+runFlameshot :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
-runFlameshot n mode cl = sometimesDBus cl n myCapture tree cmd
+runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
   where
     cmd _ = spawnCmd myCapture [mode]
     tree = toAnd_ (DBusIO $ sysExe [Package Official "flameshot"] myCapture)
@@ -336,4 +344,4 @@ runCaptureBrowser :: SometimesX
 runCaptureBrowser = sometimesIO_ "screen capture browser" "feh"
   (Only_ $ sysExe [Package Official "feh"] myImageBrowser) $ do
   dir <- io getCaptureDir
-  spawnCmd myImageBrowser [dir]
+  spawnCmd myImageBrowser [T.pack dir]

lib/XMonad/Internal/Command/Power.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Commands for controlling power
 
@@ -34,6 +36,8 @@ import qualified Data.Map                    as M
 
 import           Graphics.X11.Types
 
+import qualified RIO.Text                    as T
+
 import           System.Directory
 import           System.Exit
 import           System.FilePath.Posix
@@ -43,20 +47,20 @@ import           System.Process              (ProcessHandle)
 import           XMonad.Core
 import           XMonad.Internal.Process     (spawnPipeArgs)
 import           XMonad.Internal.Shell
-import qualified XMonad.Internal.Theme       as T
+import qualified XMonad.Internal.Theme       as XT
 import           XMonad.Prompt
 import           XMonad.Prompt.ConfirmPrompt
 
 --------------------------------------------------------------------------------
 -- | Executables
 
-myScreenlock :: String
+myScreenlock :: FilePath
 myScreenlock = "screenlock"
 
-myOptimusManager :: String
+myOptimusManager :: FilePath
 myOptimusManager = "optimus-manager"
 
-myPrimeOffload :: String
+myPrimeOffload :: FilePath
 myPrimeOffload = "prime-offload"
 
 --------------------------------------------------------------------------------
@@ -97,23 +101,23 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
 --------------------------------------------------------------------------------
 -- | Confirmation prompts
 
-promptFontDep :: IOTree T.FontBuilder
+promptFontDep :: IOTree XT.FontBuilder
-promptFontDep = fontTreeAlt T.defFontFamily defFontPkgs
+promptFontDep = fontTreeAlt XT.defFontFamily defFontPkgs
 
 defFontPkgs :: [Fulfillment]
 defFontPkgs = [Package Official "ttf-dejavu"]
 
-confirmPrompt' :: String -> X () -> T.FontBuilder -> X ()
+confirmPrompt' :: T.Text -> X () -> XT.FontBuilder -> X ()
-confirmPrompt' s x fb = confirmPrompt (T.promptTheme fb) s x
+confirmPrompt' s x fb = confirmPrompt (XT.promptTheme fb) (T.unpack s) x
 
-suspendPrompt :: T.FontBuilder -> X ()
+suspendPrompt :: XT.FontBuilder -> X ()
 suspendPrompt = confirmPrompt' "suspend?" runSuspend
 
-quitPrompt :: T.FontBuilder -> X ()
+quitPrompt :: XT.FontBuilder -> X ()
 quitPrompt = confirmPrompt' "quit?" $ io exitSuccess
 
-sometimesPrompt :: String -> (T.FontBuilder -> X ()) -> SometimesX
+sometimesPrompt :: T.Text -> (XT.FontBuilder -> X ()) -> SometimesX
-sometimesPrompt n = sometimesIO n (n ++ " command") promptFontDep
+sometimesPrompt n = sometimesIO n (T.append n " command") promptFontDep
 
 -- TODO doesn't this need to also lock the screen?
 runSuspendPrompt :: SometimesX
@@ -131,7 +135,7 @@ runQuitPrompt = sometimesPrompt "quit prompt" quitPrompt
 isUsingNvidia :: IO Bool
 isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
 
-hasBattery :: IO (Maybe String)
+hasBattery :: IO (Maybe T.Text)
 hasBattery = do
   ps <- fromRight [] <$> tryIOError (listDirectory syspath)
   ts <- mapM readType ps
@@ -140,16 +144,17 @@ hasBattery = do
     readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
     syspath = "/sys/class/power_supply"
 
-runOptimusPrompt' :: T.FontBuilder -> X ()
+runOptimusPrompt' :: XT.FontBuilder -> X ()
 runOptimusPrompt' fb = do
   nvidiaOn <- io isUsingNvidia
   switch $ if nvidiaOn then "integrated" else "nvidia"
   where
     switch mode = confirmPrompt' (prompt mode) (cmd mode) fb
-    prompt mode = "gpu switch to " ++ mode ++ "?"
+    prompt mode = T.concat ["gpu switch to ", mode, "?"]
     cmd mode = spawn $
-      myPrimeOffload
+      T.unpack
-      #!&& unwords [myOptimusManager, "--switch", mode, "--no-confirm"]
+      $ T.pack myPrimeOffload
+      #!&& T.unwords [T.pack myOptimusManager, "--switch", mode, "--no-confirm"]
       #!&& "killall xmonad"
 
 runOptimusPrompt :: SometimesX
@@ -197,11 +202,11 @@ runPowerPrompt = Sometimes "power prompt" (const True) [sf]
     tree = And12 (,) lockTree promptFontDep
     lockTree = Or (Only $ IOSometimes runScreenLock id) (Only $ IOConst skip)
 
-powerPrompt :: X () -> T.FontBuilder -> X ()
+powerPrompt :: X () -> XT.FontBuilder -> X ()
 powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
   where
     comp = mkComplFunFromList theme []
-    theme = (T.promptTheme fb) { promptKeymap = keymap }
+    theme = (XT.promptTheme fb) { promptKeymap = keymap }
     keymap = M.fromList
       $ ((controlMask, xK_g), quit) :
       map (first $ (,) 0)

lib/XMonad/Internal/Concurrent/VirtualBox.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
 --------------------------------------------------------------------------------
 -- | VirtualBox-specific functions
 
@@ -14,24 +16,26 @@ import           Data.Internal.Dependency
 
 import           Text.XML.Light
 
+import           RIO.FilePath
+import qualified RIO.Text                 as T
+
 import           System.Directory
-import           System.FilePath
 
 import           XMonad.Internal.Shell
 
-vmExists :: String -> IO (Maybe Msg)
+vmExists :: T.Text -> IO (Maybe Msg)
 vmExists vm = either (Just . Msg Error) (const Nothing) <$> vmInstanceConfig vm
 
-vmInstanceConfig :: String -> IO (Either String FilePath)
+vmInstanceConfig :: T.Text -> IO (Either T.Text FilePath)
 vmInstanceConfig vmName = do
   either (return . Right) findInstance =<< vmDirectory
   where
-    path = vmName </> (vmName ++ ".vbox")
+    path = T.unpack vmName </> addExtension (T.unpack vmName) "vbox"
     findInstance dir = do
       res <- findFile [dir] path
       return $ case res of
         Just p  -> Right p
-        Nothing -> Left $ "could not find VM instance: " ++ singleQuote vmName
+        Nothing -> Left $ T.append "could not find VM instance: " $ singleQuote vmName
 
 vmDirectory :: IO (Either String String)
 vmDirectory = do

lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | DBus module for Clevo Keyboard control
 

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | DBus module for DBus brightness controls
 
@@ -21,6 +23,8 @@ import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
 
+import qualified RIO.Text                    as T
+
 import           XMonad.Core                 (io)
 import           XMonad.Internal.DBus.Common
 
@@ -42,7 +46,7 @@ data BrightnessConfig a b = BrightnessConfig
   , bcGetMax    :: IO a
   , bcPath      :: ObjectPath
   , bcInterface :: InterfaceName
-  , bcName      :: String
+  , bcName      :: T.Text
   }
 
 data BrightnessControls = BrightnessControls
@@ -92,7 +96,7 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
 brightnessExporter :: RealFrac b => XPQuery -> [Fulfillment] -> [IODependency_]
   -> BrightnessConfig a b -> Maybe SesClient -> SometimesIO
 brightnessExporter q ful deps bc@BrightnessConfig { bcName = n } cl =
-  Sometimes (n ++ " DBus Interface") q [Subfeature root "exporter"]
+  Sometimes (T.append n " DBus Interface") q [Subfeature root "exporter"]
   where
     root = DBusRoot_ (exportBrightnessControls' bc) tree cl
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
@@ -133,12 +137,12 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
   where
     sig = signal p i memCur
 
-callBacklight :: XPQuery -> Maybe SesClient -> BrightnessConfig a b -> String
+callBacklight :: XPQuery -> Maybe SesClient -> BrightnessConfig a b -> T.Text
   -> MemberName -> SometimesIO
 callBacklight q cl BrightnessConfig { bcPath = p
                                     , bcInterface = i
                                     , bcName = n } controlName m =
-  Sometimes (unwords [n, controlName]) q [Subfeature root "method call"]
+  Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
   where
     root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
     cmd c = io $ void $ callMethod c xmonadBusName p i m

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | DBus module for Intel Backlight control
 

lib/XMonad/Internal/DBus/Removable.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Module for monitoring removable drive events
 --

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | DBus module for X11 screensave/DPMS control
 

lib/XMonad/Internal/Notify.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Functions for formatting and sending notifications
 --
@@ -21,6 +23,8 @@ import           Data.Maybe
 
 import           DBus.Notify
 
+import qualified RIO.Text               as T
+
 import           XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
@@ -40,21 +44,22 @@ defNoteError = defNote
 --------------------------------------------------------------------------------
 -- | Format a 'notify-send' command to be send to the shell
 
-parseBody :: Body -> Maybe String
+parseBody :: Body -> Maybe T.Text
-parseBody (Text s) = Just s
+parseBody (Text s) = Just $ T.pack s
 parseBody _        = Nothing
 
-fmtNotifyCmd :: Note -> String
+fmtNotifyCmd :: Note -> T.Text
 fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
 
 spawnNotify :: MonadIO m => Note -> m ()
 spawnNotify = spawnCmd "notify-send" . fmtNotifyArgs
 
-fmtNotifyArgs :: Note -> [String]
+fmtNotifyArgs :: Note -> [T.Text]
 fmtNotifyArgs n = getIcon n ++ getSummary n ++ getBody n
   where
     -- TODO add the rest of the options as needed
-    getSummary = (:[]) . doubleQuote . summary
+    getSummary = (:[]) . doubleQuote . T.pack . summary
-    getIcon n' = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
+    getIcon n' =
+      maybe [] (\i -> ["-i", T.pack $ case i of { Icon s -> s; File s -> s }])
       $ appImage n'
     getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'

lib/XMonad/Internal/Shell.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Functions for formatting and spawning shell commands
 
@@ -15,45 +17,50 @@ module XMonad.Internal.Shell
 
 import           Control.Monad.IO.Class
 
+import qualified RIO.Text                as T
+
 import           XMonad.Internal.Process
 
 --------------------------------------------------------------------------------
 -- | Opening subshell
 
-spawnCmd :: MonadIO m => String -> [String] -> m ()
+spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
-spawnCmd cmd args = spawn $ fmtCmd cmd args
+spawnCmd cmd args = spawn $ T.unpack $ fmtCmd cmd args
 
 --------------------------------------------------------------------------------
 -- | Formatting commands
 
-fmtCmd :: String -> [String] -> String
+fmtCmd :: FilePath -> [T.Text] -> T.Text
-fmtCmd cmd args = unwords $ cmd : args
+fmtCmd cmd args = T.unwords $ T.pack cmd : args
 
-(#!&&) :: String -> String -> String
+op :: T.Text -> T.Text -> T.Text -> T.Text
-cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
+op a x b = T.unwords [a, x, b]
+
+(#!&&) :: T.Text -> T.Text -> T.Text
+cmdA #!&& cmdB = op cmdA "&&" cmdB
 
 infixr 0 #!&&
 
-(#!|) :: String -> String -> String
+(#!|) :: T.Text -> T.Text -> T.Text
-cmdA #!| cmdB = cmdA ++ " | " ++ cmdB
+cmdA #!| cmdB = op cmdA "|" cmdB
 
 infixr 0 #!|
 
-(#!||) :: String -> String -> String
+(#!||) :: T.Text -> T.Text -> T.Text
-cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB
+cmdA #!|| cmdB = op cmdA "||" cmdB
 
 infixr 0 #!||
 
-(#!>>) :: String -> String -> String
+(#!>>) :: T.Text -> T.Text -> T.Text
-cmdA #!>> cmdB = cmdA ++ "; " ++ cmdB
+cmdA #!>> cmdB = op cmdA ";" cmdB
 
 infixr 0 #!>>
 
-doubleQuote :: String -> String
+doubleQuote :: T.Text -> T.Text
-doubleQuote s = "\"" ++ s ++ "\""
+doubleQuote s = T.concat ["\"", s, "\""]
 
-singleQuote :: String -> String
+singleQuote :: T.Text -> T.Text
-singleQuote s = "'" ++ s ++ "'"
+singleQuote s = T.concat ["'", s, "'"]
 
 skip :: Monad m => m ()
 skip = return ()

lib/XMonad/Internal/Theme.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Theme for XMonad and Xmobar
 
@@ -28,10 +30,10 @@ module XMonad.Internal.Theme
   , promptTheme
   ) where
 
-import           Data.Char
 import           Data.Colour
 import           Data.Colour.SRGB
-import           Data.List
+
+import qualified RIO.Text                 as T
 
 import qualified XMonad.Layout.Decoration as D
 import qualified XMonad.Prompt            as P
@@ -39,50 +41,56 @@ import qualified XMonad.Prompt            as P
 --------------------------------------------------------------------------------
 -- | Colors - vocabulary roughly based on GTK themes
 
-baseColor :: String
+baseColor :: T.Text
 baseColor = "#f7f7f7"
 
-bgColor :: String
+bgColor :: T.Text
 bgColor = "#d6d6d6"
 
-fgColor :: String
+fgColor :: T.Text
 fgColor = "#2c2c2c"
 
-bordersColor :: String
+bordersColor :: T.Text
 bordersColor = darken' 0.3 bgColor
 
-warningColor :: String
+warningColor :: T.Text
 warningColor = "#ffca28"
 
-errorColor :: String
+errorColor :: T.Text
 errorColor = "#e53935"
 
-selectedFgColor :: String
+selectedFgColor :: T.Text
 selectedFgColor = "#ffffff"
 
-selectedBgColor :: String
+selectedBgColor :: T.Text
 selectedBgColor = "#4a79c7"
 
-selectedBordersColor :: String
+selectedBordersColor :: T.Text
 selectedBordersColor = "#4a79c7"
 
-backdropBaseColor :: String
+backdropBaseColor :: T.Text
 backdropBaseColor = baseColor
 
-backdropTextColor :: String
+backdropTextColor :: T.Text
 backdropTextColor = blend' 0.95 fgColor backdropBaseColor
 
-backdropFgColor :: String
+backdropFgColor :: T.Text
 backdropFgColor = blend' 0.75 fgColor bgColor
 
 --------------------------------------------------------------------------------
 -- | Color functions
 
-blend' :: Float -> String -> String -> String
+blend' :: Float -> T.Text -> T.Text -> T.Text
-blend' wt c0 c1 = sRGB24show $ blend wt (sRGB24read c0) (sRGB24read c1)
+blend' wt c0 c1 = sRGB24showT $ blend wt (sRGB24readT c0) (sRGB24readT c1)
 
-darken' :: Float -> String -> String
+darken' :: Float -> T.Text -> T.Text
-darken' wt = sRGB24show . darken wt . sRGB24read
+darken' wt = sRGB24showT . darken wt . sRGB24readT
+
+sRGB24readT :: (RealFrac a, Floating a) => T.Text -> Colour a
+sRGB24readT = sRGB24read . T.unpack
+
+sRGB24showT :: (RealFrac a, Floating a) => Colour a -> T.Text
+sRGB24showT = T.pack . sRGB24show
 
 --------------------------------------------------------------------------------
 -- | Fonts
@@ -107,9 +115,9 @@ data FontData = FontData
     , antialias :: Maybe Bool
     }
 
-type FontBuilder = FontData -> String
+type FontBuilder = FontData -> T.Text
 
-buildFont :: Maybe String -> FontData -> String
+buildFont :: Maybe T.Text -> FontData -> T.Text
 buildFont Nothing _ = "fixed"
 buildFont (Just fam) FontData { weight = w
                             , slant = l
@@ -117,17 +125,17 @@ buildFont (Just fam) FontData { weight = w
                             , pixelsize = p
                             , antialias = a
                             }
-  = intercalate ":" $ ["xft", fam] ++ elems
+  = T.intercalate ":" $ ["xft", fam] ++ elems
   where
-    elems = [ k ++ "=" ++ v | (k, Just v) <- [ ("weight", showLower w)
+    elems = [ T.concat [k, "=", v] | (k, Just v) <- [ ("weight", showLower w)
                                                     , ("slant", showLower l)
                                                     , ("size", showLower s)
                                                     , ("pixelsize", showLower p)
                                                     , ("antialias", showLower a)
                                                     ]
                             ]
-    showLower :: Show a => Maybe a -> Maybe String
+    showLower :: Show a => Maybe a -> Maybe T.Text
-    showLower = fmap (fmap toLower . show)
+    showLower = fmap (T.toLower . T.pack . show)
 
 fallbackFont :: FontBuilder
 fallbackFont = buildFont Nothing
@@ -144,7 +152,7 @@ defFontData = FontData
   , pixelsize = Nothing
   }
 
-defFontFamily :: String
+defFontFamily :: T.Text
 defFontFamily = "DejaVu Sans"
 
 -- defFontDep :: IODependency FontBuilder
@@ -158,19 +166,19 @@ defFontFamily = "DejaVu Sans"
 
 tabbedTheme :: FontBuilder -> D.Theme
 tabbedTheme fb = D.def
-  { D.fontName              = fb $ defFontData { weight = Just Bold }
+  { D.fontName              = T.unpack $ fb $ defFontData { weight = Just Bold }
 
-  , D.activeTextColor       = fgColor
+  , D.activeTextColor       = T.unpack fgColor
-  , D.activeColor           = bgColor
+  , D.activeColor           = T.unpack bgColor
-  , D.activeBorderColor     = bgColor
+  , D.activeBorderColor     = T.unpack bgColor
 
-  , D.inactiveTextColor     = backdropTextColor
+  , D.inactiveTextColor     = T.unpack backdropTextColor
-  , D.inactiveColor         = backdropFgColor
+  , D.inactiveColor         = T.unpack backdropFgColor
-  , D.inactiveBorderColor   = backdropFgColor
+  , D.inactiveBorderColor   = T.unpack backdropFgColor
 
-  , D.urgentTextColor       = darken' 0.5 errorColor
+  , D.urgentTextColor       = T.unpack $ darken' 0.5 errorColor
-  , D.urgentColor           = errorColor
+  , D.urgentColor           = T.unpack errorColor
-  , D.urgentBorderColor     = errorColor
+  , D.urgentBorderColor     = T.unpack errorColor
 
   -- this is in a newer version
   -- , D.activeBorderWidth     = 0
@@ -184,12 +192,12 @@ tabbedTheme fb = D.def
 
 promptTheme :: FontBuilder -> P.XPConfig
 promptTheme fb = P.def
-  { P.font              = fb $ defFontData { size = Just 12 }
+  { P.font              = T.unpack $ fb $ defFontData { size = Just 12 }
-  , P.bgColor           = bgColor
+  , P.bgColor           = T.unpack bgColor
-  , P.fgColor           = fgColor
+  , P.fgColor           = T.unpack fgColor
-  , P.fgHLight          = selectedFgColor
+  , P.fgHLight          = T.unpack selectedFgColor
-  , P.bgHLight          = selectedBgColor
+  , P.bgHLight          = T.unpack selectedBgColor
-  , P.borderColor       = bordersColor
+  , P.borderColor       = T.unpack bordersColor
   , P.promptBorderWidth = 1
   , P.height            = 35
   , P.position          = P.CenteredAt 0.5 0.5

lib/Xmobar/Plugins/BacklightCommon.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Common backlight plugin bits
 --
@@ -8,14 +10,16 @@ module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import           Data.Internal.DBus
 
+import qualified RIO.Text              as T
+
 import           Xmobar.Plugins.Common
 
 startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
-  -> (SesClient -> IO (Maybe a)) -> String -> Callback -> IO ()
+  -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
     withDBusClientConnection cb $ \c -> do
       matchSignal display c
       display =<< callGetBrightness c
     where
-      formatBrightness b = return $ icon ++ show (round b :: Integer) ++ "%"
+      formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
       display = displayMaybe cb formatBrightness

lib/Xmobar/Plugins/Bluetooth.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Bluetooth plugin
 --
@@ -49,11 +51,13 @@ import           Data.Maybe
 import           DBus
 import           DBus.Client
 
+import qualified RIO.Text                    as T
+
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 
-btAlias :: String
+btAlias :: T.Text
 btAlias = "bluetooth"
 
 btDep :: DBusDependency_ SysClient
@@ -63,7 +67,7 @@ btDep = Endpoint [Package Official "bluez"] btBus btOMPath omInterface
 data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 
 instance Exec Bluetooth where
-  alias (Bluetooth _ _) = btAlias
+  alias (Bluetooth _ _) = T.unpack btAlias
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
@@ -91,13 +95,13 @@ startAdapter is cs cb cl = do
 -- Color corresponds to the adaptor powered state, and the icon corresponds to
 -- if it is paired or not. If the adaptor state is undefined, display "N/A"
 
-type IconFormatter = (Maybe Bool -> Bool -> String)
+type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
-type Icons = (String, String)
+type Icons = (T.Text, T.Text)
 
 displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
 displayIcon callback formatter =
-  callback . uncurry formatter <=< readState
+  callback . T.unpack . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -154,8 +158,8 @@ adaptorHasDevice adaptor device = case splitPath device of
   [org, bluez, hciX, _] -> splitPath adaptor == [org, bluez, hciX]
   _                     -> False
 
-splitPath :: ObjectPath -> [String]
+splitPath :: ObjectPath -> [T.Text]
-splitPath = splitOn "/" . dropWhile (=='/') . formatObjectPath
+splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
 
 getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
@@ -207,7 +211,7 @@ addAdaptorListener state display adaptor sys = do
 
 callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
 callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
-  $ memberName_ adaptorPowered
+  $ memberName_ $ T.unpack adaptorPowered
 
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
@@ -221,7 +225,7 @@ readPowered = fmap btPowered . readMVar
 adapterInterface :: InterfaceName
 adapterInterface = interfaceName_ "org.bluez.Adapter1"
 
-adaptorPowered :: String
+adaptorPowered :: T.Text
 adaptorPowered = "Powered"
 
 --------------------------------------------------------------------------------
@@ -253,7 +257,8 @@ matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
 callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
-callGetConnected p = callPropertyGet btBus p devInterface $ memberName_ devConnected
+callGetConnected p = callPropertyGet btBus p devInterface
+  $ memberName_ (T.unpack devConnected)
 
 insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
@@ -279,5 +284,5 @@ readDevices = fmap btDevices . readMVar
 devInterface :: InterfaceName
 devInterface = interfaceName_ "org.bluez.Device1"
 
-devConnected :: String
+devConnected :: T.Text
 devConnected = "Connected"

lib/Xmobar/Plugins/ClevoKeyboard.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Clevo Keyboard plugin
 --
@@ -9,18 +11,20 @@ module Xmobar.Plugins.ClevoKeyboard
   , ckAlias
   ) where
 
+import qualified RIO.Text                                      as T
+
 import           Xmobar
 
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 
-newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show)
+newtype ClevoKeyboard = ClevoKeyboard T.Text deriving (Read, Show)
 
-ckAlias :: String
+ckAlias :: T.Text
 ckAlias = "clevokeyboard"
 
 instance Exec ClevoKeyboard where
-  alias (ClevoKeyboard _) = ckAlias
+  alias (ClevoKeyboard _) = T.unpack ckAlias
   start (ClevoKeyboard icon) =
      startBacklight matchSignalCK callGetBrightnessCK icon

lib/Xmobar/Plugins/Common.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Xmobar.Plugins.Common
   ( colorText
   , startListener
@@ -20,18 +22,21 @@ import           Data.Internal.DBus
 import           DBus
 import           DBus.Client
 
+import qualified RIO.Text                as T
+
 import           XMonad.Hooks.DynamicLog (xmobarColor)
 
+-- use string here since all the callbacks in xmobar use strings :(
 type Callback = String -> IO ()
 
 data Colors = Colors
-  { colorsOn  :: String
+  { colorsOn  :: T.Text
-  , colorsOff :: String
+  , colorsOff :: T.Text
   }
   deriving (Eq, Show, Read)
 
 startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
-  -> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
+  -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
   -> c -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
@@ -40,24 +45,24 @@ startListener rule getProp fromSignal toColor cb client = do
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch :: Callback -> (a -> IO String) -> SignalMatch a -> IO ()
+procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
-colorText :: Colors -> Bool -> String -> String
+colorText :: Colors -> Bool -> T.Text -> T.Text
 colorText Colors { colorsOn = c } True   = xmobarFGColor c
 colorText Colors { colorsOff = c } False = xmobarFGColor c
 
-xmobarFGColor :: String -> String -> String
+xmobarFGColor :: T.Text -> T.Text -> T.Text
-xmobarFGColor c = xmobarColor c ""
+xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
 
-na :: String
+na :: T.Text
 na = "N/A"
 
-displayMaybe :: Callback -> (a -> IO String) -> Maybe a -> IO ()
+displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
-displayMaybe cb f = cb <=< maybe (return na) f
+displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
 
 displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
-displayMaybe' cb = maybe (cb na)
+displayMaybe' cb = maybe (cb $ T.unpack na)
 
 withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
 withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient

lib/Xmobar/Plugins/Device.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Device plugin
 --
@@ -17,12 +19,14 @@ import           Data.Word
 
 import           DBus
 
+import qualified RIO.Text                        as T
+
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 
-newtype Device = Device (String, String, Colors) deriving (Read, Show)
+newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
 
 nmPath :: ObjectPath
 nmPath = objectPath_ "/org/freedesktop/NetworkManager"
@@ -36,14 +40,14 @@ nmDeviceInterface = interfaceName_ "org.freedesktop.NetworkManager.Device"
 getByIP :: MemberName
 getByIP = memberName_ "GetDeviceByIpIface"
 
-devSignal :: String
+devSignal :: T.Text
 devSignal = "Ip4Connectivity"
 
 devDep :: DBusDependency_ SysClient
 devDep = Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface
   $ Method_ getByIP
 
-getDevice :: SysClient -> String -> IO (Maybe ObjectPath)
+getDevice :: SysClient -> T.Text -> IO (Maybe ObjectPath)
 getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
   where
     mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
@@ -52,13 +56,13 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
 
 getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
 getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
-  $ memberName_ devSignal
+  $ memberName_ $ T.unpack devSignal
 
 matchStatus :: [Variant] -> SignalMatch Word32
 matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 
 instance Exec Device where
-  alias (Device (iface, _, _)) = iface
+  alias (Device (iface, _, _)) = T.unpack iface
   start (Device (iface, text, colors)) cb = do
     withDBusClientConnection cb $ \sys -> do
       path <- getDevice sys iface

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Intel backlight plugin
 --
@@ -9,18 +11,20 @@ module Xmobar.Plugins.IntelBacklight
   , blAlias
   ) where
 
+import qualified RIO.Text                                       as T
+
 import           Xmobar
 
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 
-newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
+newtype IntelBacklight = IntelBacklight T.Text deriving (Read, Show)
 
-blAlias :: String
+blAlias :: T.Text
 blAlias = "intelbacklight"
 
 instance Exec IntelBacklight where
-  alias (IntelBacklight _) = blAlias
+  alias (IntelBacklight _) = T.unpack blAlias
   start (IntelBacklight icon) =
      startBacklight matchSignalIB callGetBrightnessIB icon

lib/Xmobar/Plugins/Screensaver.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | Screensaver plugin
 --
@@ -9,18 +11,20 @@ module Xmobar.Plugins.Screensaver
   , ssAlias
   ) where
 
+import qualified RIO.Text                         as T
+
 import           Xmobar
 
 import           XMonad.Internal.DBus.Screensaver
 import           Xmobar.Plugins.Common
 
-newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show)
+newtype Screensaver = Screensaver (T.Text, Colors) deriving (Read, Show)
 
-ssAlias :: String
+ssAlias :: T.Text
 ssAlias = "screensaver"
 
 instance Exec Screensaver where
-  alias (Screensaver _) = ssAlias
+  alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb = do
     withDBusClientConnection cb $ \sys -> do
       matchSignal display sys

lib/Xmobar/Plugins/VPN.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- | VPN plugin
 --
@@ -22,15 +24,17 @@ import qualified Data.Set                        as S
 
 import           DBus
 
+import qualified RIO.Text                        as T
+
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
 import           Xmobar
 import           Xmobar.Plugins.Common
 
-newtype VPN = VPN (String, Colors) deriving (Read, Show)
+newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
 
 instance Exec VPN where
-  alias (VPN _) = vpnAlias
+  alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
     state <- initState c
@@ -84,7 +88,7 @@ vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 addedCallback :: MutableVPNState -> IO () -> SignalCallback
 addedCallback state display [device, added] = update >> display
   where
-    added' = fromVariant added :: Maybe (M.Map String (M.Map String Variant))
+    added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
     update = updateDevice S.insert state device is
 addedCallback _ _ _                       = return ()
@@ -92,12 +96,12 @@ addedCallback _ _ _                       = return ()
 removedCallback :: MutableVPNState -> IO () -> SignalCallback
 removedCallback state display [device, interfaces] = update >> display
   where
-    is = fromMaybe [] $ fromVariant interfaces :: [String]
+    is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is
 removedCallback _ _ _                       = return ()
 
 updateDevice :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> Variant -> [String] -> IO ()
+  -> Variant -> [T.Text] -> IO ()
 updateDevice f state device interfaces = when (vpnDeviceTun `elem` interfaces) $
   forM_ d $ updateState f state
   where
@@ -113,10 +117,10 @@ vpnBus = busName_ "org.freedesktop.NetworkManager"
 vpnPath :: ObjectPath
 vpnPath = objectPath_ "/org/freedesktop"
 
-vpnDeviceTun :: String
+vpnDeviceTun :: T.Text
 vpnDeviceTun = "org.freedesktop.NetworkManager.Device.Tun"
 
-vpnAlias :: String
+vpnAlias :: T.Text
 vpnAlias = "vpn"
 
 vpnDep :: DBusDependency_ SysClient