Events.hs

-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli <dino@ui3.info>

{-# LANGUAGE FlexibleContexts #-}

module Uacpid.Events
   ( Handler (..), loadHandlers, executeHandlers )
   where

import Control.Monad.Except
import Data.List
import qualified Data.Map as M
import Data.Maybe
import System.Directory
import System.FilePath
import System.Log
import System.Process
import Text.Regex ( matchRegex, mkRegex )

import Uacpid.Conf ( ConfMap, getConfDir, parseToMap )
import Uacpid.Log ( logM )


data Handler = Handler
   { evName :: String
   , evEventRe :: String
   , evAction :: String
   }


lookupHandlerE :: (MonadError String m) =>
   String -> String -> ConfMap -> m String
lookupHandlerE name k m = maybe
   (throwError $ "Handler " ++ name ++ ": key " ++ k ++ " not found")
   return $ M.lookup k m


loadHandler :: (String, FilePath) -> IO (Maybe Handler)
loadHandler (name, path) = do
   -- Parse the event file into a map
   evMap <- liftM parseToMap $ readFile path

   -- Extract data from it to make an Handler, with error reporting
   eitherStringHandler <- runExceptT $ do
      event <- lookupHandlerE name "event" evMap
      action <- lookupHandlerE name "action" evMap
      return $ Handler name event action

   result <- case eitherStringHandler of
      Left emsg -> do
         logM WARNING emsg
         return Nothing
      Right ev -> return $ Just ev

   return result


loadHandlers :: IO [Handler]
loadHandlers = do
   confDir <- getConfDir
   let eventsDir = confDir </> "events"

   {- Load the event handler files. Files starting with . and ending 
      with ~ are discarded. We don't want . and .. of course, but you 
      can also disable one by make it look like events/.foo or 
      events/foo~
   -}
   eventFiles <- liftM 
      ( filter (\file -> not $ any ($ file)
         [ isPrefixOf ".", isSuffixOf "~" ]))
      $ getDirectoryContents eventsDir

   -- Construct a list of (filename, /path/to/filename)
   let eventPairs = map (\n -> (n, eventsDir </> n)) eventFiles

   -- Load these files and parse them
   events <- liftM catMaybes $ mapM loadHandler eventPairs

   let names = map evName events

   -- Log what we loaded for informational purposes
   if (null names)
      then logM NOTICE "No valid event handlers were found"
      else logM NOTICE $ "Handlers loaded: " ++
         (intercalate " " names)

   return events


executeHandlers :: String -> [Handler] -> IO ()
executeHandlers acpiHandler es = do
   let responders = filter (\e -> isJust $
         matchRegex (mkRegex (evEventRe e)) acpiHandler) es

   mapM_ (waitForProcess <=< runCommand . evAction) responders