diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2015-04-04 09:13:08 +0900 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2015-04-04 09:13:08 +0900 |
commit | 1a0b1c7f26be8ead9861e7f1d1fe4b1c23b483c7 (patch) | |
tree | f7232bf8a4e1da80c9c428140fb7b2e3ea24559f | |
parent | e400260ce27c52eaf96e6630dd7b358887c9db6e (diff) | |
download | srem-1a0b1c7f26be8ead9861e7f1d1fe4b1c23b483c7.tar.gz |
beginnings of cross-platform reminders
-rw-r--r-- | src/Control/SremConfig.hs | 9 | ||||
-rw-r--r-- | src/Main.hs | 2 | ||||
-rw-r--r-- | src/Utility/Notify.hs | 34 | ||||
-rw-r--r-- | src/Utility/Notify/Posix.hs | 60 | ||||
-rw-r--r-- | srem.cabal | 2 |
5 files changed, 102 insertions, 5 deletions
diff --git a/src/Control/SremConfig.hs b/src/Control/SremConfig.hs index 18ff0da..852ff27 100644 --- a/src/Control/SremConfig.hs +++ b/src/Control/SremConfig.hs @@ -23,6 +23,8 @@ module Control.SremConfig ( getCacheDirectory , intervals + , notificationSound + -- , alwaysRunningInX11Process ) where import System.Directory (getHomeDirectory) @@ -34,5 +36,12 @@ getCacheDirectory :: IO FilePath getCacheDirectory = getHomeDirectory >>= \h -> return $ h </> ".cache" </> "srem" +notificationSound :: IO FilePath +notificationSound = getHomeDirectory >>= \h -> + return $ h </> "lib" </> "annex" </> "doc" </> "sounds" </> "beep.wav" + intervals :: [Int] intervals = [60, 15, 0] + +-- alwaysRunningInX11Process :: String +-- alwaysRunningInX11Process = "xbindkeys" diff --git a/src/Main.hs b/src/Main.hs index c5f8b96..abd6b21 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -41,7 +41,7 @@ doCron = do let nowRemsFilter r = getReminderHour r == h && getReminderMinute r == m nowRems = filter nowRemsFilter rems - mapM_ sendNotification nowRems + sendNotifications nowRems appendUserReminder :: Reminder -> IO () appendUserReminder r = do diff --git a/src/Utility/Notify.hs b/src/Utility/Notify.hs index 69bdb0c..5b8a3a6 100644 --- a/src/Utility/Notify.hs +++ b/src/Utility/Notify.hs @@ -1,6 +1,32 @@ -module Utility.Notify (sendNotification) where +{-# LANGUAGE CPP #-} -import Types.Reminder +{- -sendNotification :: Reminder -> IO () -sendNotification r = putStrLn $ show r + srem --- Timed reminders as notifications + + Copyright (C) 2015 Sean Whitton + + This file is part of srem. + + srem is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + srem is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with srem. If not, see <http://www.gnu.org/licenses/>. + +-} + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +module Utility.Notify (module Utility.Notify.Windows) where +import Utility.Notify.Windows +#else +module Utility.Notify (module Utility.Notify.Posix) where +import Utility.Notify.Posix +#endif diff --git a/src/Utility/Notify/Posix.hs b/src/Utility/Notify/Posix.hs new file mode 100644 index 0000000..f7bb3dd --- /dev/null +++ b/src/Utility/Notify/Posix.hs @@ -0,0 +1,60 @@ +module Utility.Notify (sendNotifications) where + +import Control.Applicative ((<$>)) +import Control.Exception (catch) +import System.Environment (getEnvironment, setEnv) +import System.Process (readProcess, runCommand) + +import DBus (Address) +import DBus.Client (Client, ClientError, connect) +import DBus.Notify + +import qualified Control.SremConfig as SremConfig +import Data.List.Split (splitOn) +import Types.Reminder + +sendNotifications :: [Reminder] -> IO () +sendNotifications rems = do + client <- getDBusUserAddress >>= connect + -- `catch` ((\_ -> return ()) :: ClientError -> IO Client) -- TODO + mapM_ (sendNotification client) rems + +sendNotification :: Client -> Reminder -> IO Notification +sendNotification c rem = do + let (title:content) = words . getReminderText $ rem + soundFile <- SremConfig.notificationSound + runCommand $ "aplay " ++ soundFile + notify c blankNote { appName = "srem" + , body = (Just . Text . unwords) content + , summary = title + , expiry = Milliseconds 10000 + , hints = [ SoundFile soundFile ]} + +getDBusUserAddress :: IO Address +getDBusUserAddress = undefined + +-- fixDBusEnvironment :: IO () +-- fixDBusEnvironment = do +-- maybeVar <- lookup "DBUS_SYSTEM_BUS_ADDRESS" <$> getEnvironment +-- case maybeVar of +-- Just _ -> return () +-- Nothing -> do +-- -- TODO: error handling! no pid returned by pgrep! +-- pid <- init <$> readProcess "pgrep" [SremConfig.alwaysRunningInX11Process] "" +-- findDBusEnvironment <$> readFile ("/proc/" ++ pid ++ "/environ") +-- >>= putStrLn +-- -- >>= setEnv "DBUS_SYSTEM_BUS_ADDRESS" + +-- findDBusEnvironment :: String -> String +-- findDBusEnvironment = maybe "" id +-- . lookup "DBUS_SYSTEM_BUS_ADDRESS" +-- . parseEnviron + +-- -- | Parse @/proc/n/environ@ where @n@ is a PID. +-- parseEnviron :: String -> [(String, String)] +-- parseEnviron = foldr step [] . splitOn "\NUL" +-- where +-- step env envs = +-- case splitOn "=" env of +-- [key, value] -> (key, value) : envs +-- _ -> envs @@ -22,5 +22,7 @@ executable srem , split , old-locale , tuple + , fdo-notify + , dbus hs-source-dirs: src default-language: Haskell2010 |