{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
module Libnotify
(
Notification
, display
, display_
, close
, Mod
, summary
, body
, icon
, timeout
, Timeout(..)
, category
, urgency
, Urgency(..)
, image
, Hint(..)
, nohints
, action
, noactions
, appName
, reuse
) where
import Control.Applicative ((<$))
import Data.ByteString (ByteString)
import Data.Int (Int32)
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(..), Last(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word (Word8)
import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf)
import System.Glib.Properties (objectSetPropertyString)
import Libnotify.C.Notify
import Libnotify.C.NotifyNotification
{-# ANN module "HLint: ignore Avoid lambda" #-}
data Notification = Notification
{ token :: !NotifyNotification
, name :: !String
} deriving (Show, Eq)
display :: Mod Notification -> IO Notification
display (Mod (Last reusedToken) (Last named) acts) = do
let name = fromMaybe defaultAppName named
_ <- notify_init name
token <- maybe (notify_notification_new "" "" "") return reusedToken
acts token name
_ <- notify_notification_show token
return Notification {token, name}
display_ :: Mod Notification -> IO ()
display_ m = () <$ display m
close :: Notification -> IO ()
close Notification {name, token} = () <$ do
_ <- notify_init name
notify_notification_close token
data Mod a =
Mod (Last NotifyNotification) (Last String) (NotifyNotification -> String -> IO ())
#if MIN_VERSION_base(4,9,0)
instance Semigroup (Mod a) where
Mod u x fx <> Mod v y fy =
Mod (u <> v) (x <> y) (\token name -> fx token name >> fy token name)
#endif
instance Monoid (Mod a) where
mempty = Mod mempty mempty (\_ _ -> return ())
#if MIN_VERSION_base(4,11,0)
#elif MIN_VERSION_base(4,9,0)
mappend = (<>)
#else
mappend (Mod u x fx) (Mod v y fy) =
Mod (mappend u v) (mappend x y) (\token name -> fx token name >> fy token name)
#endif
summary :: String -> Mod Notification
summary t = act (\n -> objectSetPropertyString "summary" n t)
body :: String -> Mod Notification
body t = act (\n -> objectSetPropertyString "body" n t)
icon :: String -> Mod Notification
icon t = act (\n -> objectSetPropertyString "icon-name" n t)
timeout :: Timeout -> Mod Notification
timeout t = act (\n -> notify_notification_set_timeout n t)
category :: String -> Mod Notification
category t = act (\n -> notify_notification_set_category n t)
urgency :: Urgency -> Mod Notification
urgency t = act (\n -> notify_notification_set_urgency n t)
image :: Pixbuf -> Mod Notification
image t = act (\n -> notify_notification_set_image_from_pixbuf n t)
class Hint v where
hint :: String -> v -> Mod Notification
instance Hint Int32 where
hint k v = act (\n -> notify_notification_set_hint_int32 n k v)
instance Hint Double where
hint k v = act (\n -> notify_notification_set_hint_double n k v)
instance Hint String where
hint k v = act (\n -> notify_notification_set_hint_string n k v)
instance Hint Word8 where
hint k v = act (\n -> notify_notification_set_hint_byte n k v)
instance Hint ByteString where
hint k v = act (\n -> notify_notification_set_hint_byte_array n k v)
nohints :: Mod Notification
nohints = act notify_notification_clear_hints
action
:: String
-> String
-> (Notification -> String -> IO a)
-> Mod Notification
action a l f =
Mod mempty mempty
(\token name -> notify_notification_add_action token a l (\p s' -> () <$ f (Notification p name) s'))
noactions :: Mod Notification
noactions = act notify_notification_clear_actions
appName :: String -> Mod Notification
appName name = Mod mempty (Last (Just name)) (\_ _ -> return ())
reuse :: Notification -> Mod Notification
reuse Notification {token, name} = Mod (Last (Just token)) (Last (Just name)) (\_ _ -> return ())
act :: (NotifyNotification -> IO ()) -> Mod Notification
act f = Mod mempty mempty (\token _name -> f token)
defaultAppName :: String
defaultAppName = "haskell-libnotify"