Scroller.hs

{-# LANGUAGE RecordWildCards #-}
module XNobar.Internal.Scroller where

import Control.Arrow ((&&&))
import Data.Function ((&))
import Data.List (genericLength)
import Data.List.Extra (groupOn)
import Data.Semigroup (Max(Max))
import Data.Tuple.Extra (first, second, third3)
import Flow ((.>))

import XNobar.Internal.Notification (Notification(..), urgency, Id)
import XNobar.Internal.Positive32 (toWord32)

type Offset = Int

-- |Configuration. In fact, this is the way to instantiate and customize the plugin,
-- but it's just more practical to use 'xNobar', as it sets some decent default values.
data Config = Config {
    idleText :: !String -- ^ Default string (to be shown steady) when no notification is left.
  , marqueeLength :: !Int -- ^ Width (in number of characters) of the scrolling marquee (this is unrelated ot the length of the first argument).
  , fontNumber :: !Int -- ^ Number of the font used for notifications, as per xmobar config (it's not applied to the idleText).
  , scrollPeriod :: !Int -- ^ Scrolling rate (in tenths of seconds per character).
  , noNewsPrefix :: !String -- ^ Prefix to the idleText.
  , newsPrefix :: !String -- ^ Prefix to the scrolling marquee.
  , criticalPrefix :: !String -- ^ Prefix to the critical nontification.
  , nonCriticalPrefix :: !String -- ^ Prefix to the non-critical nontification.
  , lineBreak :: !String -- ^ String to render a line break.
  } deriving (Read, -- ^ For integration with [XMobar](https://codeberg.org/xmobar/xmobar).
              Show) -- ^ For integration with [XMobar](https://codeberg.org/xmobar/xmobar).

theId = fst

scroll :: (Show n) => Maybe (Id, Offset, [(Id, n)]) -> Maybe (Id, Offset, [(Id, n)])
scroll Nothing = Nothing
scroll (Just (i, o, notifs)) = let notifs' = cycle notifs & dropWhile (theId .> (/= i))
                                   (i', n') = head notifs'
                                   (i'', n'') = notifs' !! 1
                               in Just (if o < genericLength (show n') - 1
                                     then (i', o + 1, notifs)
                                     else (i'',    0, notifs))

enableClick p ((Max i, u), s) = attachAction ("echo " ++ show i ++ " > " ++ p)
                                             1
                                             ((if u == 2 then red else id) s)
  where
    red = wrap "<fc=#ff0000>" "</fc>"

attachAction a b = wrap ("<action=`" ++ a ++ "` button=" ++ show b ++ ">")
                        "</action>"

wrap a c b = a ++ b ++ c

-- TODO: probably Offset should be a class
merge :: [(Id, n)] -> Maybe (Id, Offset, [(Id, n)]) -> Maybe (Id, Offset, [(Id, n)])
merge news Nothing     = Just (theId $ head news, 0, news)
merge news (Just olds) = Just $ third3 (`combine` news) olds

remove :: Num offset => Id -> Maybe (Id, offset, [(Id, n)]) -> Maybe (Id, offset, [(Id, n)])
remove _ Nothing           = error "This should not be possible!"
remove _ (Just (_, _, [])) = error "This should not be possible!"
remove i (Just (i', _, [_])) = if i /= i'
                                then error "This should not be possible!"
                                else Nothing
remove i (Just (i', o, ns)) = let l = length ns
                                  (b, a) = second tail $ break ((== i) . theId) $ cycle ns
                                  ns' = take (l - 1) $ b ++ a
                                  newCurr = head $ if null a then b else a
                              in Just (if i == i'
                                            then (theId newCurr, 0, ns')
                                            else (i',            o, ns'))

combine :: [(Id, n)] -> [(Id, n)] -> [(Id, n)]
combine olds news = let olds' =  olds `suchThat` (theId .> (not . (`elem` (theId <$> news))))
                    in olds' <> news
  where
    suchThat = flip filter

onlyIf b a = if b then a else id

showNotifs :: Config -> [Char] -> (Id, Int, [(Id, Notification)]) -> [Char]
showNotifs (Config{..})
           pipe
           (curId, curOffset, oldNotifs') =
  oldNotifs' & cycle
             & dropWhile (theId .> (/= curId))
             & concatMap (((theId &&& getNotif .> urgency) &&& getNotif .> showNotif) .> spreadChars)
             & drop curOffset
             & take marqueeLength
             & groupOn theId
             & concatMap (joinChars .> toWord32' .> enableClick pipe .> niceLineBreak)
             & (newsPrefix ++)
             & (`withFont` fontNumber)
        where
          t `withFont` f = wrap ("<fn=" ++ show f ++ ">") "</fn>" t
          getNotif = snd
          toWord32' = first (first toWord32)
          spreadChars = sequence
          joinChars l = (theId (head l), map getNotif l)
          niceLineBreak = (=<<) (\c -> if c `elem` ['\r', '\n'] then lineBreak else pure c)
          showNotif n = let emoji = if urgency n /= 2 then nonCriticalPrefix else criticalPrefix
                        in emoji ++ show n

instance Show Notification where
  show n = summary n ++ maybeBody ++ "  "
    where
      maybeBody = if not $ null $ body n
                    then " | " ++ body n
                    else ""