fdo-notify-0.3.1/ 0000755 0000000 0000000 00000000000 12314521222 011751 5 ustar 00 0000000 0000000 fdo-notify-0.3.1/Setup.lhs 0000644 0000000 0000000 00000000114 12314521222 013555 0 ustar 00 0000000 0000000 #!/usr/bin/env runhaskell
> import Distribution.Simple
> main = defaultMain
fdo-notify-0.3.1/fdo-notify.cabal 0000644 0000000 0000000 00000001336 12314521222 015016 0 ustar 00 0000000 0000000 name: fdo-notify
version: 0.3.1
synopsis: Desktop Notifications client
description:
A library for issuing notifications using FreeDesktop.org's Desktop
Notifications protcol. This protocol is supported by services such
as Ubuntu's NotifyOSD.
category: Desktop
license: BSD3
license-file: LICENSE
author: Max Rabkin
maintainer: max.rabkin@gmail.com
homepage: http://bitbucket.org/taejo/fdo-notify/
cabal-version: >= 1.2.1
build-type: Simple
extra-source-files:
examples/fib.hs
library
build-depends:
base >= 3 && < 5
, containers >= 0.1
, dbus >= 0.10.7
exposed-modules: DBus.Notify
fdo-notify-0.3.1/LICENSE 0000644 0000000 0000000 00000002660 12314521222 012762 0 ustar 00 0000000 0000000 Copyright (c) 2009, Max Rabkin
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the author nor the names of his contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.
fdo-notify-0.3.1/DBus/ 0000755 0000000 0000000 00000000000 12314521222 012606 5 ustar 00 0000000 0000000 fdo-notify-0.3.1/DBus/Notify.hs 0000644 0000000 0000000 00000023365 12314521222 014423 0 ustar 00 0000000 0000000 {-# 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.
module DBus.Notify
(
-- * Usage
-- $usage
-- * Displaying notifications
notify
, replace
, Notification
, mkSessionClient
, connectSession
, Client
-- * Constructing notifications
, blankNote
, Note (..)
, Body (..)
, URL
, Timeout (..)
, Action (..)
, Image
, Icon (..)
, Category (..)
, UrgencyLevel (..)
, Hint (..)
-- * Capabilities
, getCapabilities
, Capability (..)
) where
import DBus
import DBus.Client
import Control.Applicative
import Data.Maybe (fromMaybe, fromJust)
import Data.Int
import Data.Word
import Data.Char (isLower, toLower)
import Control.Arrow (first, second, (***))
import qualified Data.Map as M
-- $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
-- 'sessionConnect' 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 <- sessionConnect
-- 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
-- @
{-# DEPRECATED mkSessionClient "Use DBus.Client.connectSession" #-}
mkSessionClient :: IO Client
mkSessionClient = connectSession
-- |A 'Note' with default values.
-- All fields are blank except for 'expiry', which is 'Dependent'.
blankNote :: Note
blankNote = Note { appName=""
, appImage=Nothing
, summary=""
, body=Nothing
, actions=[]
, hints=[]
, expiry=Dependent
}
-- |Contents of a notification
data Note = Note { appName :: String
, appImage :: Maybe Icon
, summary :: String
, body :: Maybe Body
, actions :: [(Action, String)]
, hints :: [Hint]
, expiry :: Timeout
}
deriving (Eq, Show)
-- |Message bodies may contain simple markup.
-- NotifyOSD doesn't support any markup.
data Body = Text String
| Bold Body
| Italic Body
| Underline Body
| Hyperlink URL Body
| Img URL String
| Concat Body Body
deriving (Eq, Show)
type URL = String
-- |Length of time to display notifications. NotifyOSD seems to ignore these.
data Timeout = Never -- ^Wait to be dismissed by user
| Dependent -- ^Let the notification service decide
| Milliseconds Int32 -- ^Show notification for a fixed duration
-- (must be positive)
deriving (Eq, Show)
newtype Action = Action { actionName :: String }
deriving (Eq, Show)
-- |Images are not yet supported
newtype Image = Image { bitmap :: String }
deriving (Eq, Show)
-- |An Icon is either a path to an image, or a name in an icon theme
data Icon = File FilePath | Icon String
deriving (Eq, Show)
iconString (File fp) = "file://" ++ fp
iconString (Icon name) = name
-- |Urgency of the notification. Notifications may be prioritised by urgency.
data UrgencyLevel = Low
| Normal
| Critical -- ^Critical notifications require user attention
deriving (Eq, Ord, Enum, Show)
-- |Various hints about how the notification should be displayed
data Hint = Urgency UrgencyLevel
| Category Category
-- DesktopEntry ApplicationDesktopID
| ImageData Image
| ImagePath Icon
| SoundFile FilePath
| SuppressSound Bool
| X Int32
| Y Int32
deriving (Eq, Show)
-- |Categorisation of (some) notifications
data Category = Device | DeviceAdded | DeviceError | DeviceRemoved
| Email | EmailArrived | EmailBounced
| Im | ImError | ImReceived
| Network | NetworkConnected | NetworkDisconnected | NetworkError
| Presence | PresenceOffline | PresenceOnline
| Transfer | TransferComplete | TransferError
deriving (Eq, Show)
data ClosedReason = Expired | Dismissed | CloseNotificationCalled
data NotificationEvent = ActionInvoked Action | Closed ClosedReason
-- |A handle on a displayed notification
-- The notification may not have reached the screen yet, and may already have
-- been closed.
data Notification = Notification { notificationId :: Word32 }
-- |Display a notification.
-- Return a handle which can be used to replace the notification.
notify :: Client -> Note -> IO Notification
notify cl = replace cl (Notification { notificationId=0 })
callNotificationMethod client methodName args =
call_ client $ (methodCall path iface methodName)
{ methodCallDestination=Just busname
, methodCallBody=args
}
where
busname = "org.freedesktop.Notifications"
path = "/org/freedesktop/Notifications"
iface = "org.freedesktop.Notifications"
-- |Replace an existing notification.
-- If the notification has already been closed, a new one will be created.
replace :: Client -> Notification -> Note -> IO Notification
replace cl (Notification { notificationId=replaceId }) note =
Notification . fromJust . fromVariant . head . methodReturnBody <$>
callNotificationMethod cl "Notify" args
where
args = map ($ note)
[ toVariant . appName
, const $ toVariant (replaceId::Word32)
, toVariant . fromMaybe "" . fmap iconString . appImage
, toVariant . summary
, toVariant . fromMaybe "" . fmap flattenBody . body
, toVariant . actionsArray . actions
, toVariant . hintsDict . hints
, toVariant . timeoutInt . expiry
]
data Capability = ActionsCap | BodyCap | BodyHyperlinksCap | BodyImagesCap
| BodyMarkupCap | IconMultiCap | IconStaticCap | SoundCap
| UnknownCap String
deriving (Eq, Read, Show)
-- |Determine the server's capabilities
getCapabilities :: Client -> IO [Capability]
getCapabilities cl = map readCapability . fromJust
. fromVariant . head . methodReturnBody
<$> callNotificationMethod cl "GetCapabilities" []
readCapability :: String -> Capability
readCapability s = case s of
"actions" -> ActionsCap
"body" -> BodyCap
"body-hyperlinks" -> BodyHyperlinksCap
"body-images" -> BodyImagesCap
"body-markup" -> BodyMarkupCap
"icon-multi" -> IconMultiCap
"icon-static" -> IconStaticCap
"sound" -> SoundCap
s -> UnknownCap s
timeoutInt :: Timeout -> Int32
timeoutInt Never = 0
timeoutInt Dependent = -1
timeoutInt (Milliseconds n)
| n > 0 = n
| otherwise = error "notification timeout not positive"
flattenBody :: Body -> String
flattenBody (Text s) = concatMap escape s
where
escape '>' = ">"
escape '<' = "<"
escape '&' = "&"
escape x = [x]
flattenBody (Bold b) = "" ++ flattenBody b ++ ""
flattenBody (Italic b) = "" ++ flattenBody b ++ ""
flattenBody (Underline b) = "" ++ flattenBody b ++ ""
flattenBody (Hyperlink h b) = "" ++ flattenBody b ++ ""
flattenBody (Img h alt) = "![\""](\"")
"
flattenBody (Concat b1 b2) = flattenBody b1 ++ flattenBody b2
--actionsArray :: [(Action, String)] -> [[String]]
actionsArray = concatMap pairList
where
pairList (a, b) = [actionName a, b]
hintsDict :: [Hint] -> M.Map String Variant
hintsDict = M.fromList . map hint
where
hint :: Hint -> (String, Variant)
hint (Urgency u) = ("urgency", toVariant (fromIntegral $ fromEnum u :: Word8))
hint (Category c) = ("category", toVariant $ catName c)
hint (ImagePath p) = ("image-path", toVariant $ iconString p)
hint (ImageData i) = ("image-data", toVariant $ bitmap i)
hint (SoundFile s) = ("sound-file", toVariant s)
hint (SuppressSound b) = ("suppress-sound", toVariant b)
hint (X x) = ("x", toVariant x)
hint (Y y) = ("x", toVariant y)
-- HACK: Assumes the constructor for category foo.bar is FooBar and
-- categories have no capital letters
catName :: Category -> String
catName c = catName' (show c)
where
catName' (c:cs) = map toLower $ c: (uncurry (++) . second ('.':) . span isLower $ cs)
fdo-notify-0.3.1/examples/ 0000755 0000000 0000000 00000000000 12314521222 013567 5 ustar 00 0000000 0000000 fdo-notify-0.3.1/examples/fib.hs 0000644 0000000 0000000 00000001133 12314521222 014661 0 ustar 00 0000000 0000000 import DBus.Notify
main = do
client <- connectSession
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