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 "" ""
attachAction a b = wrap ("")
""
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 { fontNumber = fontNumber
, lineBreak = lineBreak
, newsPrefix = newsPrefix
, marqueeLength = marqueeLength
, criticalPrefix = criticalPrefix
, nonCriticalPrefix = nonCriticalPrefix
})
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 ("") "" 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 ""