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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{-
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/>.
-}
module Utility.Notify.Posix (sendNotifications) where
import Control.Applicative (pure, (<$>), (<*>))
import Control.Exception (try)
import Control.Monad (filterM, foldM, liftM, mapM)
import Data.Function (on)
import Data.List (sortBy)
import Data.Time.Clock (UTCTime)
import System.Directory (doesDirectoryExist, getDirectoryContents,
getHomeDirectory, getModificationTime)
import System.Environment (getEnvironment, setEnv)
import System.FilePath ((</>))
import System.Process (readProcessWithExitCode)
import DBus (Address, parseAddress)
import DBus.Client (Client, ClientError, connect)
import DBus.Notify
import DBus.Socket (SocketError)
import qualified Control.SremConfig as SremConfig
import Data.List.Split (splitOn)
import Types.Reminder
sendNotifications :: [Reminder] -> IO ()
sendNotifications rems =
getDBusUserAddress >>=
maybe (return ()) (\address -> do
maybeClient <- (try $ connect address) :: IO (Either SocketError Client)
either (\_ -> return ()) (\client -> mapM_ (sendNotification client) rems) maybeClient)
sendNotification :: Client -> Reminder -> IO ()
sendNotification c rem = do
let (title:content) = words . getReminderText $ rem
soundFile <- SremConfig.notificationSound
notify c blankNote { appName = "srem"
, body = (Just . Text . unwords) content
, summary = title
, expiry = Milliseconds 10000
, hints = [ SoundFile soundFile ]}
(_, _, _) <- readProcessWithExitCode "aplay" [soundFile] ""
return ()
getDBusUserAddress :: IO (Maybe Address)
getDBusUserAddress = do
-- TODO: catch various IO exceptions!
dir <- (</>) <$> getHomeDirectory <*> pure (".dbus" </> "session-bus")
socketFile <- getNewestRealFile dir
-- let realContents = filter (`notElem` [".", ".."]) contents
-- socketFile <- return realContents
-- >>= mapM (return . ((dir ++ "/") ++))
-- >>= newestFile
addr <- dropWhile (/= 'u') . head . filter findSocketLine . lines
<$> readFile socketFile
return (return addr >>= parseAddress)
where
findSocketLine line = takeWhile (/= '=') line == "DBUS_SESSION_BUS_ADDRESS"
-- | Return the full path to the newest file in a directory, or the
-- empty string if passed a file or empty directory or a path that
-- doesn't exist.
getNewestRealFile :: FilePath -> IO FilePath
getNewestRealFile dir = do
doesDirectoryExist dir >>= \exists ->
if exists then do
contents <- map (dir </>). filter (`notElem` [".", ".."])
<$> getDirectoryContents dir
contentsWithModTimes <- foldM step [] contents
let sorted = sortBy
(flip $ (compare `on` snd))
contentsWithModTimes
if null sorted
then return ""
else return . fst . head $ sorted
else return ""
where
step pairs file = do
fileModTime <- getModificationTime file
return $ (file, fileModTime) : pairs
-- newestFile :: [FilePath] -> IO FilePath
-- newestFile xs = do
-- modTimes <- getModTimes xs
-- let sorted = sortBy (compare `on` snd) modTimes
-- return $ (fst . head) sorted
-- -- expects absolute paths
-- getModTimes :: [FilePath] -> IO [(FilePath, UTCTime)]
-- getModTimes xs = do
-- modTimes <- foldM (\ts f -> do; modTime <- getModificationTime f; return (ts ++ [modTime])) [] xs
-- return $ zip xs modTimes
-- 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
|
