{-# LANGUAGE OverloadedStrings #-}-- |A library for issuing notifications using FreeDesktop.org Desktop-- Notifications protocol. This protocol is used to communicate with services-- such as Ubuntu's NotifyOSD.---- This library does not yet support receiving events relating to notifications,-- or images in notifications: if you need that functionality please contact the maintainer.moduleDBus.Notify(-- * Usage-- $usage-- * Displaying notificationsnotify,replace,Notification,mkSessionClient,Client-- * Constructing notifications,blankNote,Note(..),Body(..),URL,Timeout(..),Action(..),Image,Category(..),UrgencyLevel(..),Hint(..)-- * Capabilities,getCapabilities,Capability(..))whereimportDBus.MessageimportDBus.ClientimportDBus.BusimportDBus.TypesimportControl.ApplicativeimportData.Maybe(fromMaybe,fromJust)importData.IntimportData.WordimportData.Char(isLower,toLower)importControl.Arrow(first,second,(***))-- $usage-- A DBUS 'Client' is needed to display notifications, so the first step is to-- create one. The notification service will usually run on the session bus (the DBUS-- instance responsible for messages within a desktop session) so you can use-- 'mkSessionClient' to create the client.---- To display a notification, first construct a 'Note'. This can be done in pure-- code. Notifications can have actions, categories, etc. associated to them but-- we will just show a simple example (these features are not supported by all-- notification services anyway).---- Use the function 'notify' to display a 'Note'. This returns a handle which-- can be passed to 'replace' to replace a notification.---- @--import DBus.Notify----main = do-- client <- mkSessionClient-- let startNote = appNote { summary=\"Starting\"-- , body=(Just $ Text \"Calculating fib(33).\") }-- notification <- notify client startNote-- let endNote = appNote { summary=\"Finished\"-- , body=(Just . Text . show $ fib33) }-- fib33 \`seq\` replace client notification endNote-- where-- appNote = blankNote { appName=\"Fibonacci Demonstration\" }-- fib 0 = 0-- fib 1 = 1-- fib n = fib (n-1) + fib (n-2)-- fib33 = fib 33-- @-- |Create a 'Client' connected to the session bus.-- Note that this opens a socket and spawns a thread,-- so it's best to reuse a single client.mkSessionClient::IOClientmkSessionClient=mkClient=<<getSessionBus-- |A 'Note' with default values.-- All fields are blank except for 'expiry', which is 'Dependent'.blankNote::NoteblankNote=Note{appName="",appImage=Nothing,summary="",body=Nothing,actions=[],hints=[],expiry=Dependent}proxy=Proxy(RemoteObjectbusnamepath)ifacewherebusname="org.freedesktop.Notifications"path="/org/freedesktop/Notifications"iface="org.freedesktop.Notifications"-- |Contents of a notificationdataNote=Note{appName::String,appImage::MaybeImage,summary::String,body::MaybeBody,actions::[(Action,String)],hints::[Hint],expiry::Timeout}deriving(Eq,Show)-- |Message bodies may contain simple markup.-- NotifyOSD doesn't support any markup.dataBody=TextString|BoldBody|ItalicBody|UnderlineBody|HyperlinkURLBody|ImgURLString|ConcatBodyBodyderiving(Eq,Show)typeURL=String-- |Length of time to display notifications. NotifyOSD seems to ignore these.dataTimeout=Never-- ^Wait to be dismissed by user|Dependent-- ^Let the notification service decide|MillisecondsInt32-- ^Show notification for a fixed duration-- (must be positive)deriving(Eq,Show)newtypeAction=Action{actionName::String}deriving(Eq,Show)-- |Images are not yet supportednewtypeImage=Image{bitmap::String}deriving(Eq,Show)-- |Urgency of the notification. Notifications may be prioritised by urgency.dataUrgencyLevel=Low|Normal|Critical-- ^Critical notifications require user attentionderiving(Eq,Ord,Enum,Show)-- |Various hints about how the notification should be displayeddataHint=UrgencyUrgencyLevel|CategoryCategory-- DesktopEntry ApplicationDesktopID|ImageDataImage|SoundFileFilePath|SuppressSoundBool|XInt32|YInt32deriving(Eq,Show)-- |Categorisation of (some) notificationsdataCategory=Device|DeviceAdded|DeviceError|DeviceRemoved|Email|EmailArrived|EmailBounced|Im|ImError|ImReceived|Network|NetworkConnected|NetworkDisconnected|NetworkError|Presence|PresenceOffline|PresenceOnline|Transfer|TransferComplete|TransferErrorderiving(Eq,Show)dataClosedReason=Expired|Dismissed|CloseNotificationCalleddataNotificationEvent=ActionInvokedAction|ClosedClosedReason-- |A handle on a displayed notification-- The notification may not have reached the screen yet, and may already have-- been closed.dataNotification=Notification{notificationId::Word32}-- |Display a notification.-- Return a handle which can be used to replace the notification.notify::Client->Note->IONotificationnotifycl=replacecl(Notification{notificationId=0})-- |Replace an existing notification.-- If the notification has already been closed, a new one will be created.replace::Client->Notification->Note->IONotificationreplacecl(Notification{notificationId=replaceId})note=Notification.fromJust.fromVariant.head.methodReturnBody<$>callProxyBlocking_clproxy"Notify"[]argswhereargs=map($note)[toVariant.appName,const$toVariant(replaceId::Word32),toVariant.fromMaybe"".fmapbitmap.appImage,toVariant.summary,toVariant.fromMaybe"".fmapflattenBody.body,toVariant.actionsArray.actions,toVariant.hintsDict.hints,toVariant.timeoutInt.expiry]dataCapability=ActionsCap|BodyCap|BodyHyperlinksCap|BodyImagesCap|BodyMarkupCap|IconMultiCap|IconStaticCap|SoundCap|UnknownCapStringderiving(Eq,Read,Show)-- |Determine the server's capabilitiesgetCapabilities::Client->IO[Capability]getCapabilitiescl=mapreadCapability.fromJust.fromArray.fromJust.fromVariant.head.methodReturnBody<$>callProxyBlocking_clproxy"GetCapabilities"[][]readCapability::String->CapabilityreadCapabilitys=casesof"actions"->ActionsCap"body"->BodyCap"body-hyperlinks"->BodyHyperlinksCap"body-images"->BodyImagesCap"body-markup"->BodyMarkupCap"icon-multi"->IconMultiCap"icon-static"->IconStaticCap"sound"->SoundCaps->UnknownCapstimeoutInt::Timeout->Int32timeoutIntNever=0timeoutIntDependent=-1timeoutInt(Millisecondsn)|n>0=n|otherwise=error"notification timeout not positive"flattenBody::Body->StringflattenBody(Texts)=concatMapescapeswhereescape'>'="&gt;"escape'<'="&lt;"escape'&'="&amp;"escapex=[x]flattenBody(Boldb)="<b>"++flattenBodyb++"</b>"flattenBody(Italicb)="<i>"++flattenBodyb++"</i>"flattenBody(Underlineb)="<u>"++flattenBodyb++"</u>"flattenBody(Hyperlinkhb)="<a href=\""++h++"\">"++flattenBodyb++"</a>"flattenBody(Imghalt)="<img src=\""++h++"\" alt=\""++alt++"\"/>"flattenBody(Concatb1b2)=flattenBodyb1++flattenBodyb2actionsArray::[(Action,String)]->ArrayactionsArray=fromJust.arrayFromItemsDBusString.concatMappairListwherepairList(a,b)=[toVariant$actionNamea,toVariant$b]hintsDict::[Hint]->DictionaryhintsDict=fromJust.dictionaryFromItemsDBusStringDBusVariant.map((toVariant***toVariant).hint)wherehint::Hint->(String,Variant)hint(Urgencyu)=("urgency",toVariant(fromIntegral$fromEnumu::Word8))hint(Categoryc)=("category",toVariant$catNamec)hint(ImageDatai)=("image_data",toVariant$bitmapi)hint(SoundFiles)=("sound-file",toVariants)hint(SuppressSoundb)=("suppress-sound",toVariantb)hint(Xx)=("x",toVariantx)hint(Yy)=("x",toVarianty)-- HACK: Assumes the constructor for category foo.bar is FooBar and-- categories have no capital letterscatName::Category->StringcatNamec=catName'(showc)wherecatName'(c:cs)=maptoLower$c:(uncurry(++).second('.':).spanisLower$cs)