blob: f7bb3dd0eede406843327b05541f39812a4cb842 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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
|
