1 files changed, 50 insertions, 0 deletions

diff --git a/custom/notify-user.hs b/custom/notify-user.hs
new file mode 100644
index 00000000..f9cc2369
--- /dev/null
+++ b/custom/notify-user.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE ViewPatterns, StandaloneDeriving #-}
+  
+import System.FilePath.Glob (glob)
+import System.Environment (setEnv, getArgs)
+import System.Process (spawnProcess, waitForProcess)
+import System.Exit (exitWith, ExitCode(..))
+
+import Data.List (isPrefixOf, dropWhile, dropWhileEnd, init)
+import Data.Char (isSpace, toLower, toUpper)
+
+import Control.Monad (forM_, void)
+
+import qualified Libnotify as Notify
+import Data.Monoid
+
+import System.Console.GetOpt.Simple
+
+import qualified Data.Map as Map
+
+import Data.Maybe
+import Text.Read (readMaybe)
+
+deriving instance Read Notify.Urgency
+
+main :: IO ()
+main = do
+  envFiles <- glob "@userHome@/.dbus/session-bus/*"
+  forM_ envFiles $ \envFile -> do
+    sessionAddr <- unQuote . tail . snd . break (== '=') . head . filter ("DBUS_SESSION_BUS_ADDRESS=" `isPrefixOf`) . lines <$> readFile envFile
+    setEnv "DBUS_SESSION_BUS_ADDRESS" sessionAddr
+    lines <- lines <$> getContents
+    case lines of
+      ((trim -> summary):(trim . unlines -> contents)) -> do
+        (opts, _) <- flip getUsingConf [] [ (arg, "urgency", Optional, "")
+                                          , (arg, "app-name", Optional, "")
+                                          , (arg, "category", Optional, "")
+                                          ]
+        let
+          urgency = fromMaybe Notify.Normal $ readMaybe . caseForRead =<< Map.lookup "urgency" opts
+          appName = fromMaybe "notify-@userName@" $ Map.lookup "app-name" opts
+          category = fromMaybe "" $ Map.lookup "category" opts
+        Notify.display_ $ Notify.summary summary <> Notify.body contents <> Notify.appName appName <> Notify.urgency urgency <> Notify.category category
+      _ -> exitWith $ ExitFailure 2
+  where
+    trim = dropWhileEnd isSpace . dropWhile isSpace
+    unQuote ('\'':xs) = init xs
+    unQuote ('"':xs) = init xs
+    unQuote xs = xs
+    caseForRead [] = []
+    caseForRead (x:xs) = toUpper x : map toLower xs