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 ""