~pvsr/mpd-status

ref: 4632e336c5d46fdafce59d46154c6e01318ce331 mpd-status/I3blocks/Block.hs -rw-r--r-- 1.8 KiB
4632e336Peter Rice Remove unused import 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
{-# LANGUAGE OverloadedStrings #-}

module I3blocks.Block
  ( block
  )
where

import qualified Data.Map                      as M
                                                ( lookup )
import           Data.Maybe                     ( fromMaybe )

import qualified Data.Text                     as T
                                                ( Text
                                                , pack
                                                )
import           Network.MPD

-- TODO color
-- colors set in i3blocks config are available in environment
-- with markup=pango: "<span color=\"#ff0000\">mpd stopped</span>"
block :: MPD T.Text
block = maybe "mpd stopped" . mappend <$> extractSong <*> statusInfo

statusInfo :: MPD (Maybe T.Text)
statusInfo = fmap statusInfo' status
 where
  statusInfo' Status { stState = state, stVolume = vol } = case (state, vol) of
    (Stopped, _       ) -> Nothing
    (Playing, Nothing ) -> Just ""
    (Playing, Just 100) -> Just ""
    (Playing, Just v  ) -> Just $ " [" <> volIndicator v <> "%]"
    (Paused , Nothing ) -> Just " [paused]"
    (Paused , Just 100) -> Just " [paused]"
    (Paused , Just v  ) -> Just $ " [paused | " <> volIndicator v <> "%]"
  volIndicator v = symbol v <> " " <> T.pack (show v)
  symbol v | v > 49    = "\xf028"
           | v > 0     = "\xf027"
           | otherwise = "\xf026"

extractSong :: MPD T.Text
extractSong = fmap extractSong' currentSong
 where
  extractSong' song = fromMaybe "no song" $ do
    tags <- sgTags <$> song
    path <- fmap (toText . sgFilePath) song
    return . fromMaybe path $ do
      title  <- extract =<< M.lookup Title tags
      artist <- extract =<< M.lookup Artist tags
      return $ artist <> " - " <> title
  extract []      = Nothing
  extract (b : _) = Just $ toText b