    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -- | This widget listens on DBus for freedesktop notifications
    -- (<http://developer.gnome.org/notification-spec/>).  Currently it is
    -- somewhat ugly, but the format is somewhat configurable.
    --
    -- The widget only displays one notification at a time and
    -- notifications are cancellable.
    --
    -- The notificationDaemon thread handles new notifications
    -- and cancellation requests, adding or removing the notification
    -- to or from the queue. It additionally starts a timeout thread
    -- for each notification added to queue.
    --
    -- The display thread blocks idling until it is awakened to refresh the GUI
    --
    -- A timeout thread is associated with a notification id.
    -- It sleeps until the specific timeout and then removes every notification
    -- with that id from the queue

    module System.Taffybar.Widget.FreedesktopNotifications
      ( Notification(..)
      , NotificationConfig(..)
      , defaultNotificationConfig
      , notifyAreaNew
      ) where

    import           BroadcastChan
    import           Control.Concurrent
    import           Control.Concurrent.STM
    import           Control.Monad ( forever, void )
    import           Control.Monad.IO.Class
    import           DBus
    import           DBus.Client
    import           Data.Default ( Default(..) )
    import           Data.Foldable
    import           Data.Int ( Int32 )
    import           Data.Map ( Map )
    import           Data.Monoid
    import           Data.Sequence ( Seq, (|>), viewl, ViewL(..) )
    import qualified Data.Sequence as S
    import           Data.Text ( Text )
    import qualified Data.Text as T
    import           Data.Word ( Word32 )
    import           GI.GLib (markupEscapeText)
    import           GI.Gtk
    import qualified GI.Pango as Pango
    import           System.Taffybar.Util

    import Prelude

    -- | A simple structure representing a Freedesktop notification
    data Notification = Notification
      { Notification -> Text
    noteAppName :: Text
      , Notification -> Word32
    noteReplaceId :: Word32
      , Notification -> Text
    noteSummary :: Text
      , Notification -> Text
    noteBody :: Text
      , Notification -> Maybe Int32
    noteExpireTimeout :: Maybe Int32
      , Notification -> Word32
    noteId :: Word32
      } deriving (Int -> Notification -> ShowS
    [Notification] -> ShowS
    Notification -> String
    (Int -> Notification -> ShowS)
    -> (Notification -> String)
    -> ([Notification] -> ShowS)
    -> Show Notification
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Notification -> ShowS
    showsPrec :: Int -> Notification -> ShowS
    $cshow :: Notification -> String
    show :: Notification -> String
    $cshowList :: [Notification] -> ShowS
    showList :: [Notification] -> ShowS
    Show, Notification -> Notification -> Bool
    (Notification -> Notification -> Bool)
    -> (Notification -> Notification -> Bool) -> Eq Notification
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Notification -> Notification -> Bool
    == :: Notification -> Notification -> Bool
    $c/= :: Notification -> Notification -> Bool
    /= :: Notification -> Notification -> Bool
    Eq)

    data NotifyState = NotifyState
      { NotifyState -> Label
    noteWidget :: Label
      , NotifyState -> Widget
    noteContainer :: Widget
      , NotifyState -> NotificationConfig
    noteConfig :: NotificationConfig -- ^ The associated configuration
      , NotifyState -> TVar (Seq Notification)
    noteQueue :: TVar (Seq Notification) -- ^ The queue of active notifications
      , NotifyState -> TVar Word32
    noteIdSource :: TVar Word32 -- ^ A source of fresh notification ids
      , NotifyState -> BroadcastChan In ()
    noteChan :: BroadcastChan In () -- ^ Writing to this channel wakes up the display thread
      }

    initialNoteState :: Widget -> Label -> NotificationConfig -> IO NotifyState
    initialNoteState :: Widget -> Label -> NotificationConfig -> IO NotifyState
    initialNoteState Widget
    wrapper Label
    l NotificationConfig
    cfg = do
      TVar Word32
    m <- Word32 -> IO (TVar Word32)
    forall a. a -> IO (TVar a)
    newTVarIO Word32
    1
      TVar (Seq Notification)
    q <- Seq Notification -> IO (TVar (Seq Notification))
    forall a. a -> IO (TVar a)
    newTVarIO Seq Notification
    forall a. Seq a
    S.empty
      BroadcastChan In ()
    ch <- IO (BroadcastChan In ())
    forall (m :: * -> *) a. MonadIO m => m (BroadcastChan In a)
    newBroadcastChan
      NotifyState -> IO NotifyState
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NotifyState { noteQueue :: TVar (Seq Notification)
    noteQueue = TVar (Seq Notification)
    q
                         , noteIdSource :: TVar Word32
    noteIdSource = TVar Word32
    m
                         , noteWidget :: Label
    noteWidget = Label
    l
                         , noteContainer :: Widget
    noteContainer = Widget
    wrapper
                         , noteConfig :: NotificationConfig
    noteConfig = NotificationConfig
    cfg
                         , noteChan :: BroadcastChan In ()
    noteChan = BroadcastChan In ()
    ch
                         }

    -- | Removes every notification with id 'nId' from the queue
    notePurge :: NotifyState -> Word32 -> IO ()
    notePurge :: NotifyState -> Word32 -> IO ()
    notePurge NotifyState
    s Word32
    nId = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ())
    -> ((Seq Notification -> Seq Notification) -> STM ())
    -> (Seq Notification -> Seq Notification)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar (Seq Notification)
    -> (Seq Notification -> Seq Notification) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    modifyTVar' (NotifyState -> TVar (Seq Notification)
    noteQueue NotifyState
    s) ((Seq Notification -> Seq Notification) -> IO ())
    -> (Seq Notification -> Seq Notification) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      (Notification -> Bool) -> Seq Notification -> Seq Notification
    forall a. (a -> Bool) -> Seq a -> Seq a
    S.filter ((Word32
    nId Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) (Word32 -> Bool)
    -> (Notification -> Word32) -> Notification -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Notification -> Word32
    noteId)

    -- | Removes the first (oldest) notification from the queue
    noteNext :: NotifyState -> IO ()
    noteNext :: NotifyState -> IO ()
    noteNext NotifyState
    s = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TVar (Seq Notification)
    -> (Seq Notification -> Seq Notification) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    modifyTVar' (NotifyState -> TVar (Seq Notification)
    noteQueue NotifyState
    s) Seq Notification -> Seq Notification
    forall {a}. Seq a -> Seq a
    aux
      where
        aux :: Seq a -> Seq a
    aux Seq a
    queue = case Seq a -> ViewL a
    forall a. Seq a -> ViewL a
    viewl Seq a
    queue of
          ViewL a
    EmptyL -> Seq a
    forall a. Seq a
    S.empty
          a
    _ :< Seq a
    ns -> Seq a
    ns

    -- | Generates a fresh notification id
    noteFreshId :: NotifyState -> IO Word32
    noteFreshId :: NotifyState -> IO Word32
    noteFreshId NotifyState { TVar Word32
    noteIdSource :: NotifyState -> TVar Word32
    noteIdSource :: TVar Word32
    noteIdSource } = STM Word32 -> IO Word32
    forall a. STM a -> IO a
    atomically (STM Word32 -> IO Word32) -> STM Word32 -> IO Word32
    forall a b. (a -> b) -> a -> b
    $ do
      Word32
    nId <- TVar Word32 -> STM Word32
    forall a. TVar a -> STM a
    readTVar TVar Word32
    noteIdSource
      TVar Word32 -> Word32 -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Word32
    noteIdSource (Word32 -> Word32
    forall a. Enum a => a -> a
    succ Word32
    nId)
      Word32 -> STM Word32
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word32
    nId

    --------------------------------------------------------------------------------
    -- | Handles a new notification
    notify :: NotifyState
           -> Text -- ^ Application name
           -> Word32 -- ^ Replaces id
           -> Text -- ^ App icon
           -> Text -- ^ Summary
           -> Text -- ^ Body
           -> [Text] -- ^ Actions
           -> Map Text Variant -- ^ Hints
           -> Int32 -- ^ Expires timeout (milliseconds)
           -> IO Word32
    notify :: NotifyState
    -> Text
    -> Word32
    -> Text
    -> Text
    -> Text
    -> [Text]
    -> Map Text Variant
    -> Int32
    -> IO Word32
    notify NotifyState
    s Text
    appName Word32
    replaceId Text
    _ Text
    summary Text
    body [Text]
    _ Map Text Variant
    _ Int32
    timeout = do
      Word32
    realId <- if Word32
    replaceId Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0 then NotifyState -> IO Word32
    noteFreshId NotifyState
    s else Word32 -> IO Word32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word32
    replaceId
      let configTimeout :: Maybe Int32
    configTimeout = NotificationConfig -> Maybe Int32
    notificationMaxTimeout (NotifyState -> NotificationConfig
    noteConfig NotifyState
    s)
          realTimeout :: Maybe Int32
    realTimeout = if Int32
    timeout Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int32
    0 -- Gracefully handle out of spec negative values
                        then Maybe Int32
    configTimeout
                        else case Maybe Int32
    configTimeout of
                               Maybe Int32
    Nothing -> Int32 -> Maybe Int32
    forall a. a -> Maybe a
    Just Int32
    timeout
                               Just Int32
    maxTimeout -> Int32 -> Maybe Int32
    forall a. a -> Maybe a
    Just (Int32 -> Int32 -> Int32
    forall a. Ord a => a -> a -> a
    min Int32
    maxTimeout Int32
    timeout)

      Text
    escapedSummary <- Text -> Int64 -> IO Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    markupEscapeText Text
    summary (-Int64
    1)
      Text
    escapedBody <- Text -> Int64 -> IO Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    markupEscapeText Text
    body (-Int64
    1)
      let n :: Notification
    n = Notification { noteAppName :: Text
    noteAppName = Text
    appName
                           , noteReplaceId :: Word32
    noteReplaceId = Word32
    replaceId
                           , noteSummary :: Text
    noteSummary = Text
    escapedSummary
                           , noteBody :: Text
    noteBody = Text
    escapedBody
                           , noteExpireTimeout :: Maybe Int32
    noteExpireTimeout = Maybe Int32
    realTimeout
                           , noteId :: Word32
    noteId = Word32
    realId
                           }
      -- Either add the new note to the queue or replace an existing note if their ids match
      STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Seq Notification
    queue <- TVar (Seq Notification) -> STM (Seq Notification)
    forall a. TVar a -> STM a
    readTVar (TVar (Seq Notification) -> STM (Seq Notification))
    -> TVar (Seq Notification) -> STM (Seq Notification)
    forall a b. (a -> b) -> a -> b
    $ NotifyState -> TVar (Seq Notification)
    noteQueue NotifyState
    s
        TVar (Seq Notification) -> Seq Notification -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar (NotifyState -> TVar (Seq Notification)
    noteQueue NotifyState
    s) (Seq Notification -> STM ()) -> Seq Notification -> STM ()
    forall a b. (a -> b) -> a -> b
    $ case (Notification -> Bool) -> Seq Notification -> Maybe Int
    forall a. (a -> Bool) -> Seq a -> Maybe Int
    S.findIndexL (\Notification
    n_ -> Notification -> Word32
    noteId Notification
    n Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Notification -> Word32
    noteId Notification
    n_) Seq Notification
    queue of
          Maybe Int
    Nothing -> Seq Notification
    queue Seq Notification -> Notification -> Seq Notification
    forall a. Seq a -> a -> Seq a
    |> Notification
    n
          Just Int
    index -> Int -> Notification -> Seq Notification -> Seq Notification
    forall a. Int -> a -> Seq a -> Seq a
    S.update Int
    index Notification
    n Seq Notification
    queue
      NotifyState -> Notification -> IO ()
    startTimeoutThread NotifyState
    s Notification
    n
      NotifyState -> IO ()
    wakeupDisplayThread NotifyState
    s
      Word32 -> IO Word32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word32
    realId

    -- | Handles user cancellation of a notification
    closeNotification :: NotifyState -> Word32 -> IO ()
    closeNotification :: NotifyState -> Word32 -> IO ()
    closeNotification NotifyState
    s Word32
    nId = do
      NotifyState -> Word32 -> IO ()
    notePurge NotifyState
    s Word32
    nId
      NotifyState -> IO ()
    wakeupDisplayThread NotifyState
    s

    notificationDaemon :: (AutoMethod f1, AutoMethod f2)
                          => f1 -> f2 -> IO ()
    notificationDaemon :: forall f1 f2. (AutoMethod f1, AutoMethod f2) => f1 -> f2 -> IO ()
    notificationDaemon f1
    onNote f2
    onCloseNote = do
      Client
    client <- IO Client
    connectSession
      RequestNameReply
    _ <- Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
    requestName Client
    client BusName
    "org.freedesktop.Notifications" [RequestNameFlag
    nameAllowReplacement, RequestNameFlag
    nameReplaceExisting]
      Client -> ObjectPath -> Interface -> IO ()
    export Client
    client ObjectPath
    "/org/freedesktop/Notifications" Interface
    interface
      where
        getServerInformation :: IO (Text, Text, Text, Text)
        getServerInformation :: IO (Text, Text, Text, Text)
    getServerInformation = (Text, Text, Text, Text) -> IO (Text, Text, Text, Text)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "haskell-notification-daemon",
                                       Text
    "nochair.net",
                                       Text
    "0.0.1",
                                       Text
    "1.1")
        getCapabilities :: IO [Text]
        getCapabilities :: IO [Text]
    getCapabilities = [Text] -> IO [Text]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Text
    "body", Text
    "body-markup"]
        interface :: Interface
    interface = Interface
    defaultInterface
          { interfaceName = "org.freedesktop.Notifications"
          , interfaceMethods =
              [ autoMethod "GetServerInformation" getServerInformation
              , autoMethod "GetCapabilities" getCapabilities
              , autoMethod "CloseNotification" onCloseNote
              , autoMethod "Notify" onNote
              ]
          }

    --------------------------------------------------------------------------------
    wakeupDisplayThread :: NotifyState -> IO ()
    wakeupDisplayThread :: NotifyState -> IO ()
    wakeupDisplayThread NotifyState
    s = IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ BroadcastChan In () -> () -> IO Bool
    forall (m :: * -> *) a.
    MonadIO m =>
    BroadcastChan In a -> a -> m Bool
    writeBChan (NotifyState -> BroadcastChan In ()
    noteChan NotifyState
    s) ()

    -- | Refreshes the GUI
    displayThread :: NotifyState -> IO ()
    displayThread :: NotifyState -> IO ()
    displayThread NotifyState
    s = do
      BroadcastChan Out ()
    chan <- BroadcastChan In () -> IO (BroadcastChan Out ())
    forall (m :: * -> *) (dir :: Direction) a.
    MonadIO m =>
    BroadcastChan dir a -> m (BroadcastChan Out a)
    newBChanListener (NotifyState -> BroadcastChan In ()
    noteChan NotifyState
    s)
      IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe ()
    _ <- BroadcastChan Out () -> IO (Maybe ())
    forall (m :: * -> *) a.
    MonadIO m =>
    BroadcastChan Out a -> m (Maybe a)
    readBChan BroadcastChan Out ()
    chan
        Seq Notification
    ns <- TVar (Seq Notification) -> IO (Seq Notification)
    forall a. TVar a -> IO a
    readTVarIO (NotifyState -> TVar (Seq Notification)
    noteQueue NotifyState
    s)
        IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          if Seq Notification -> Int
    forall a. Seq a -> Int
    S.length Seq Notification
    ns Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
          then Widget -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetHide (NotifyState -> Widget
    noteContainer NotifyState
    s)
          else do
            Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Text -> m ()
    labelSetMarkup (NotifyState -> Label
    noteWidget NotifyState
    s) (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ NotificationConfig -> [Notification] -> Text
    formatMessage (NotifyState -> NotificationConfig
    noteConfig NotifyState
    s) (Seq Notification -> [Notification]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq Notification
    ns)
            Widget -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetShowAll (NotifyState -> Widget
    noteContainer NotifyState
    s)
      where
        formatMessage :: NotificationConfig -> [Notification] -> Text
    formatMessage NotificationConfig {Int
    Maybe Int32
    [Notification] -> Text
    notificationMaxTimeout :: NotificationConfig -> Maybe Int32
    notificationMaxTimeout :: Maybe Int32
    notificationMaxLength :: Int
    notificationFormatter :: [Notification] -> Text
    notificationMaxLength :: NotificationConfig -> Int
    notificationFormatter :: NotificationConfig -> [Notification] -> Text
    ..} [Notification]
    ns =
          Int -> Text -> Text
    T.take Int
    notificationMaxLength (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ [Notification] -> Text
    notificationFormatter [Notification]
    ns

    --------------------------------------------------------------------------------
    startTimeoutThread :: NotifyState -> Notification -> IO ()
    startTimeoutThread :: NotifyState -> Notification -> IO ()
    startTimeoutThread NotifyState
    s Notification {Maybe Int32
    Word32
    Text
    noteAppName :: Notification -> Text
    noteReplaceId :: Notification -> Word32
    noteSummary :: Notification -> Text
    noteBody :: Notification -> Text
    noteExpireTimeout :: Notification -> Maybe Int32
    noteId :: Notification -> Word32
    noteAppName :: Text
    noteReplaceId :: Word32
    noteSummary :: Text
    noteBody :: Text
    noteExpireTimeout :: Maybe Int32
    noteId :: Word32
    ..} = case Maybe Int32
    noteExpireTimeout of
      Maybe Int32
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      Just Int32
    timeout -> IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ do
        Int -> IO ()
    threadDelay (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    timeout Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    3 :: Int))
        NotifyState -> Word32 -> IO ()
    notePurge NotifyState
    s Word32
    noteId
        NotifyState -> IO ()
    wakeupDisplayThread NotifyState
    s

    --------------------------------------------------------------------------------
    data NotificationConfig = NotificationConfig
      { NotificationConfig -> Maybe Int32
    notificationMaxTimeout :: Maybe Int32 -- ^ Maximum time that a notification will be displayed (in seconds).  Default: None
      , NotificationConfig -> Int
    notificationMaxLength :: Int -- ^ Maximum length displayed, in characters.  Default: 100
      , NotificationConfig -> [Notification] -> Text
    notificationFormatter :: [Notification] -> T.Text -- ^ Function used to format notifications, takes the notifications from first to last
      }

    defaultFormatter :: [Notification] -> T.Text
    defaultFormatter :: [Notification] -> Text
    defaultFormatter [Notification]
    ns =
      let count :: Int
    count = [Notification] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Notification]
    ns
          n :: Notification
    n = [Notification] -> Notification
    forall a. HasCallStack => [a] -> a
    head [Notification]
    ns
          prefix :: Text
    prefix = if Int
    count Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
                   then Text
    ""
                   else Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    count) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ") "
          msg :: Text
    msg =  if Text -> Bool
    T.null (Notification -> Text
    noteBody Notification
    n)
                 then Notification -> Text
    noteSummary Notification
    n
                 else Notification -> Text
    noteSummary Notification
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Notification -> Text
    noteBody Notification
    n
      in Text
    "<span fgcolor='yellow'>" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    prefix Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "</span>" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    msg

    -- | The default formatter is one of
    -- * Summary : Body
    -- * Summary
    -- * (N) Summary : Body
    -- * (N) Summary
    -- depending on the presence of a notification body, and where N is the number of queued notifications.
    defaultNotificationConfig :: NotificationConfig
    defaultNotificationConfig :: NotificationConfig
    defaultNotificationConfig =
      NotificationConfig { notificationMaxTimeout :: Maybe Int32
    notificationMaxTimeout = Maybe Int32
    forall a. Maybe a
    Nothing
                         , notificationMaxLength :: Int
    notificationMaxLength = Int
    100
                         , notificationFormatter :: [Notification] -> Text
    notificationFormatter = [Notification] -> Text
    defaultFormatter
                         }

    instance Default NotificationConfig where
      def :: NotificationConfig
    def = NotificationConfig
    defaultNotificationConfig

    -- | Create a new notification area with the given configuration.
    notifyAreaNew :: MonadIO m => NotificationConfig -> m Widget
    notifyAreaNew :: forall (m :: * -> *). MonadIO m => NotificationConfig -> m Widget
    notifyAreaNew NotificationConfig
    cfg = IO Widget -> m Widget
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $ do
      Frame
    frame <- Maybe Text -> IO Frame
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Frame
    frameNew Maybe Text
    forall a. Maybe a
    Nothing
      Box
    box <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    boxNew Orientation
    OrientationHorizontal Int32
    3
      Label
    textArea <- Maybe Text -> IO Label
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Label
    labelNew (Maybe Text
    forall a. Maybe a
    Nothing :: Maybe Text)
      EventBox
    button <- IO EventBox
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
    eventBoxNew
      Separator
    sep <- Orientation -> IO Separator
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> m Separator
    separatorNew Orientation
    OrientationHorizontal

      Label
    bLabel <- Maybe Text -> IO Label
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Label
    labelNew (Maybe Text
    forall a. Maybe a
    Nothing :: Maybe Text)
      Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Text -> m ()
    widgetSetName Label
    bLabel Text
    "NotificationCloseButton"
      Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Text -> m ()
    labelSetMarkup Label
    bLabel Text
    "×"

      Label -> Int32 -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Int32 -> m ()
    labelSetMaxWidthChars Label
    textArea (Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int32) -> Int -> Int32
    forall a b. (a -> b) -> a -> b
    $ NotificationConfig -> Int
    notificationMaxLength NotificationConfig
    cfg)
      Label -> EllipsizeMode -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> EllipsizeMode -> m ()
    labelSetEllipsize Label
    textArea EllipsizeMode
    Pango.EllipsizeModeEnd

      EventBox -> Label -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    containerAdd EventBox
    button Label
    bLabel
      Box -> Label -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    boxPackStart Box
    box Label
    textArea Bool
    True Bool
    True Word32
    0
      Box -> Separator -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    boxPackStart Box
    box Separator
    sep Bool
    False Bool
    False Word32
    0
      Box -> EventBox -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    boxPackStart Box
    box EventBox
    button Bool
    False Bool
    False Word32
    0

      Frame -> Box -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    containerAdd Frame
    frame Box
    box

      Frame -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetHide Frame
    frame
      Widget
    w <- Frame -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget Frame
    frame

      NotifyState
    s <- Widget -> Label -> NotificationConfig -> IO NotifyState
    initialNoteState Widget
    w Label
    textArea NotificationConfig
    cfg
      SignalHandlerId
    _ <- EventBox
    -> ((?self::EventBox) => WidgetButtonReleaseEventCallback)
    -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a
    -> ((?self::a) => WidgetButtonReleaseEventCallback)
    -> m SignalHandlerId
    onWidgetButtonReleaseEvent EventBox
    button (NotifyState -> WidgetButtonReleaseEventCallback
    forall {p}. NotifyState -> p -> IO Bool
    userCancel NotifyState
    s)

      Box
    realizableWrapper <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    boxNew Orientation
    OrientationHorizontal Int32
    0
      Box -> Frame -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    boxPackStart Box
    realizableWrapper Frame
    frame Bool
    False Bool
    False Word32
    0
      Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetShow Box
    realizableWrapper

      -- We can't start the dbus listener thread until we are in the GTK
      -- main loop, otherwise things are prone to lock up and block
      -- infinitely on an mvar.  Bad stuff - only start the dbus thread
      -- after the fake invisible wrapper widget is realized.
      IO SignalHandlerId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Box -> ((?self::Box) => IO ()) -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> ((?self::a) => IO ()) -> m SignalHandlerId
    onWidgetRealize Box
    realizableWrapper (((?self::Box) => IO ()) -> IO SignalHandlerId)
    -> ((?self::Box) => IO ()) -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ do
        IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (NotifyState -> IO ()
    displayThread NotifyState
    s)
        (Text
     -> Word32
     -> Text
     -> Text
     -> Text
     -> [Text]
     -> Map Text Variant
     -> Int32
     -> IO Word32)
    -> (Word32 -> IO ()) -> IO ()
    forall f1 f2. (AutoMethod f1, AutoMethod f2) => f1 -> f2 -> IO ()
    notificationDaemon (NotifyState
    -> Text
    -> Word32
    -> Text
    -> Text
    -> Text
    -> [Text]
    -> Map Text Variant
    -> Int32
    -> IO Word32
    notify NotifyState
    s) (NotifyState -> Word32 -> IO ()
    closeNotification NotifyState
    s)

      -- Don't show the widget by default - it will appear when needed
      Box -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget Box
    realizableWrapper

      where
        -- | Close the current note and pull up the next, if any
        userCancel :: NotifyState -> p -> IO Bool
    userCancel NotifyState
    s p
    _ = do
          NotifyState -> IO ()
    noteNext NotifyState
    s
          NotifyState -> IO ()
    wakeupDisplayThread NotifyState
    s
          Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True