ENH make powermon its own thread

bin/powermon.hs

@@ -1,42 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-import ACPI
-import SendXMsg
-
-import Control.Monad
-
-import Data.ByteString
-import Data.ByteString.Char8 as C
-import Data.Connection
-
-import System.IO.Streams.Internal   as S (read)
-import System.IO.Streams.UnixSocket
-
-splitLine :: ByteString -> [ByteString]
-splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
-
-parseLine :: ByteString -> Maybe ACPIEvent
-parseLine line =
-  -- TODO what if we don't have a list this long (we crash)
-  case (line' !! 1, line' !! 2) of
-    ("PBTN", _)      -> Just Power
-    ("PWRF", _)      -> Just Power
-    ("SLPB", _)      -> Just Sleep
-    ("SBTN", _)      -> Just Sleep
-    ("LID", "close") -> Just LidClose
-    _                -> Nothing
-  where
-    line' = splitLine line
-
-sendACPIEvent :: ACPIEvent -> IO ()
-sendACPIEvent = sendXMsg acpiMagic . show
-
-main :: IO ()
-main = do
-  -- TODO barf when the socket doesn't exist
-  Connection { source = s } <- connect "/var/run/acpid.socket"
-  forever $ readStream s
-  where
-    readStream s = do
-      out <- (>>= parseLine) <$> S.read s
-      forM_ out sendACPIEvent

bin/xmonad.hs

@@ -15,7 +15,8 @@ import DBus.Screensaver
 
 import qualified Theme as T
 
-import Control.Monad (forM, forM_, mapM_, void, when)
+import Control.Concurrent
+import Control.Monad      (forM, forM_, mapM_, void, when)
 
 import           Data.List     (find, sortBy, sortOn)
 import qualified Data.Map.Lazy as M
@@ -84,10 +85,10 @@ main :: IO ()
 main = do
   dbClient <- startXMonadService
   (barPID, h) <- spawnPipe' "xmobar"
-  pwrPID <- spawnPID "powermon"
+  _ <- forkIO runPowermon
   launch
     $ ewmh
-    $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient)
+    $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient)
     $ def { terminal = myTerm
           , modMask = myModMask
           , layoutHook = myLayouts
@@ -235,7 +236,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
     let (magic, tag) = splitXMsg d
     if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
        | magic == acpiMagic -> do
-         let acpiTag = readMaybe tag :: Maybe ACPIEvent
+         let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
          forM_ acpiTag $ \case
            Power -> myPowerPrompt
            Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend

lib/ACPI.hs

@@ -1,36 +1,72 @@
-module ACPI (ACPIEvent(..), acpiMagic, isDischarging) where
+{-# LANGUAGE OverloadedStrings #-}
+
+module ACPI
+  ( ACPIEvent(..)
+  , acpiMagic
+  , isDischarging
+  , runPowermon
+  ) where
+
+import SendXMsg
 
 import Control.Exception
-import Text.Read
+import Control.Monad
 
-data ACPIEvent = Power | Sleep | LidClose deriving (Eq)
+import Data.ByteString       hiding (readFile)
+import Data.ByteString.Char8 as C hiding (readFile)
+import Data.Connection
 
-instance Show ACPIEvent where
-  show Power = "power"
-  show Sleep = "sleep"
-  -- show LidOpen = "olid"
-  show LidClose = "clid"
+import System.IO.Streams.Internal   as S (read)
+import System.IO.Streams.UnixSocket
 
-instance Read ACPIEvent where
-  readPrec = do
-    Ident s <- lexP
-    case s of
-      -- TODO this isn't DRY
-      "power" -> return Power
-      "sleep" -> return Sleep
-      "clid" -> return LidClose
-      _ -> pfail
+data ACPIEvent = Power
+    | Sleep
+    | LidClose
+    deriving (Eq)
 
--- TODO use a data type that enforces strings of max length 5
-acpiMagic :: String
-acpiMagic = "%acpi"
+instance Enum ACPIEvent where
+  toEnum 0 = Power
+  toEnum 1 = Sleep
+  toEnum 2 = LidClose
+  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum"
+
+  fromEnum Power    = 0
+  fromEnum Sleep    = 1
+  fromEnum LidClose = 2
+
+sendACPIEvent :: ACPIEvent -> IO ()
+sendACPIEvent = sendXMsg acpiMagic . show . fromEnum
+
+parseLine :: ByteString -> Maybe ACPIEvent
+parseLine line =
+  case splitLine line of
+    (_:"PBTN":_)        -> Just Power
+    (_:"PWRF":_)        -> Just Power
+    (_:"SLPB":_)        -> Just Sleep
+    (_:"SBTN":_)        -> Just Sleep
+    (_:"LID":"close":_) -> Just LidClose
+    _                   -> Nothing
+  where
+    splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
 
 isDischarging :: IO (Maybe Bool)
 isDischarging = do
   status <- try $ readFile "/sys/class/power_supply/BAT0/status"
     :: IO (Either IOException String)
   case status of
-    Left e -> do
-      print e
-      return Nothing
+    Left _  -> return Nothing
     Right s -> return $ Just (s == "Discharging")
+
+-- TODO use a data type that enforces strings of max length 5
+acpiMagic :: String
+acpiMagic = "%acpi"
+
+runPowermon :: IO ()
+runPowermon = do
+  -- TODO barf when the socket doesn't exist
+  Connection { source = s } <- connect "/var/run/acpid.socket"
+  forever $ readStream s
+  where
+    readStream s = do
+      out <- S.read s
+      mapM_ sendACPIEvent $ parseLine =<< out

my-xmonad.cabal

@@ -27,6 +27,9 @@ library
                  , dbus >= 1.2.7
                  , text >= 1.2.3.1
                  , containers >= 0.6.0.1
+                 , tcp-streams >= 1.0.1.1
+                 , io-streams >= 1.5.1.0
+                 , bytestring >= 0.10.8.2
                  , xmobar
     ghc-options: -Wall -Werror -fno-warn-missing-signatures
     default-language: Haskell2010
@@ -64,13 +67,3 @@ executable xit-event
                  , my-xmonad
     default-language: Haskell2010
     ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
-
-executable powermon
-    main-is: bin/powermon.hs
-    build-depends: base
-                 , tcp-streams >= 1.0.1.1
-                 , io-streams >= 1.5.1.0
-                 , bytestring >= 0.10.8.2
-                 , my-xmonad
-    default-language: Haskell2010
-    ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-14.12
+resolver: lts-14.27
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.