From 1a0b1c7f26be8ead9861e7f1d1fe4b1c23b483c7 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sat, 4 Apr 2015 09:13:08 +0900
Subject: beginnings of cross-platform reminders

---
 src/Control/SremConfig.hs   |  9 +++++++
 src/Main.hs                 |  2 +-
 src/Utility/Notify.hs       | 34 ++++++++++++++++++++++---
 src/Utility/Notify/Posix.hs | 60 +++++++++++++++++++++++++++++++++++++++++++++
 srem.cabal                  |  2 ++
 5 files changed, 102 insertions(+), 5 deletions(-)
 create mode 100644 src/Utility/Notify/Posix.hs

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
diff --git a/srem.cabal b/srem.cabal
index b38d43a..e4c3b89 100644
--- a/srem.cabal
+++ b/srem.cabal
@@ -22,5 +22,7 @@ executable srem
                      , split
                      , old-locale
                      , tuple
+                     , fdo-notify
+                     , dbus
   hs-source-dirs:      src
   default-language:    Haskell2010
-- 
cgit v1.2.3