~pvsr/mpd-status

4e3fcabf6b3f89de36083f1acb6c7c25a75e1520 — Peter Rice 2 years ago 2ecae09
use i3blocks' new IPC format
5 files changed, 64 insertions(+), 75 deletions(-)

M Click.hs
M Operation.hs
M README.md
M Status.hs
M mpd-status.cabal
M Click.hs => Click.hs +16 -37
@@ 1,12 1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Click (Button(..), Click(..), buttonFromId) where

import GHC.Generics (Generic)
module Click (Button(..)) where

import Data.Aeson
import Data.Text (Text)

data Button = LeftClick
            | MiddleClick


@@ 17,35 14,17 @@ data Button = LeftClick
            | ScrollRight
            | Back
            | Forward
            | None

buttonFromId :: Int -> Maybe Button
buttonFromId 1 = Just LeftClick
buttonFromId 2 = Just MiddleClick
buttonFromId 3 = Just RightClick
buttonFromId 4 = Just ScrollUp
buttonFromId 5 = Just ScrollDown
buttonFromId 6 = Just ScrollLeft
buttonFromId 7 = Just ScrollRight
buttonFromId 8 = Just Back
buttonFromId 9 = Just Forward
buttonFromId _ = Nothing

data Click = Click {
      name :: Text
    , inst :: Text
    , button :: Int
    , x :: Int
    , y :: Int
    } deriving (Generic, Show)

instance ToJSON Click where
  toEncoding = genericToEncoding defaultOptions

instance FromJSON Click where
  parseJSON = withObject "Click" $ \v -> Click
      <$> v .: "name"
      <*> v .: "instance"
      <*> v .: "button"
      <*> v .: "x"
      <*> v .: "y"
            deriving (Show)

instance FromJSON Button where
  parseJSON = withScientific "Button" $ \case
      1 -> pure LeftClick
      2 -> pure MiddleClick
      3 -> pure RightClick
      4 -> pure ScrollUp
      5 -> pure ScrollDown
      6 -> pure ScrollLeft
      7 -> pure ScrollRight
      8 -> pure Back
      9 -> pure Forward
      _ -> fail "expected an integer in [1, 9]"

M Operation.hs => Operation.hs +10 -10
@@ 1,4 1,5 @@
{-# LANGUAGE OverloadedStrings #-}

module Operation(Operation(..), op) where

import Network.MPD


@@ 13,17 14,16 @@ data Operation = Toggle
               | Next
               | AllRandom

op :: Maybe Operation -> MPD ()
op (Just Toggle) = toggle
op (Just AllRandom) = clear >> add "" >> random True >> play Nothing
op (Just Stop) = stop
op (Just (VolumeUp volStep)) = status >>= maybe (return ()) (setVolume . inc volStep) . stVolume
op (Just (VolumeDown volStep)) = status >>= maybe (return ()) (setVolume . dec volStep) . stVolume
op :: Operation -> MPD ()
op Toggle = toggle
op AllRandom = clear >> add "" >> random True >> play Nothing
op Stop = stop
op (VolumeUp volStep) = status >>= maybe (return ()) (setVolume . inc volStep) . stVolume
op (VolumeDown volStep) = status >>= maybe (return ()) (setVolume . dec volStep) . stVolume
-- TODO it would be nice to be able to toggle mute. is that info stored?
op (Just Mute) = setVolume 0
op (Just Previous) = previous
op (Just Next) = next
op Nothing = return ()
op Mute = setVolume 0
op Previous = previous
op Next = next

inc :: Int -> Int -> Int
inc step vol = min 100 $ (vol `div` step + 1) * step

M README.md => README.md +20 -9
@@ 1,14 1,25 @@
# mpd-status
# `mpd-status`
This is a block for [`i3blocks`](https://github.com/vivien/i3blocks) that can show
and easily manipulate MPD's status.
`mpd-status`'s main distinguishing feature over similar blocks is that it can
both display song changes as they happen *and* control MPD's state.
Now that
[i3blocks#228](https://github.com/vivien/i3blocks/issues/228) is resolved,
that's not actually very difficult,
so others will probably have their own blocks that can do the same thing soon
enough,
but as far as I know this is the first!

I use this with i3blocks to show and easily manipulate MPD's status. It started off as a pretty simple bash script that wrapped mpc and then  rewrote that in haskell with [turtle](https://github.com/Gabriel439/Haskell-Turtle-Library) and then I discovered [libmpd-haskell](https://github.com/vimus/libmpd-haskell) and lost control.

### Pros
### Cool things about mpd-status
* Automatically updates when the song changes!
* Complex MPD operations can be expressed simply
	* E.g. `clear >> add "" >> random True >> play Nothing` replaces the queue with your library and shuffles it
* MPD actions can be expressed using
	[`libmpd-haskell`](https://github.com/vimus/libmpd-haskell)'s DSL
	* E.g. `clear >> add "" >> random True >> play Nothing` replaces the queue
		with your library and shuffles it
* Haskell
### Cons
* Requires my fork of i3blocks for click events to do anything
### Not so cool things
* Requires the latest master of i3blocks for now
* Haskell
	* Most i3blocks scripts are just that—scripts—and are easy to download and run. This isn't so much
	* Most i3blocks scripts are just that—scripts—and are easy to just download
		and run. That's not exactly a strong suit of Haskell's, partially thanks to:
	* So many dependencies

M Status.hs => Status.hs +16 -19
@@ 1,6 1,7 @@
{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO, killThread)
import Control.Monad (forever, (>=>))
import qualified Data.Map as M (lookup)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))


@@ 12,28 13,25 @@ import qualified Data.Text as T (Text, pack)
import qualified Data.Text.IO as T (putStrLn)
import Network.MPD

import Click
import Config
import Operation

main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  sequence_ . Prelude.repeat $ do
  forever $ do
    run block
    tid <- forkIO . sequence_ . Prelude.repeat . run $ idle [PlayerS] >> block
    json <- B.getLine
    tid <- forkIO . forever . run $ idle [PlayerS] >> block
    b <- decodeStrict <$> B.getLine
    killThread tid
    withMPD . op $ (button <$> decodeStrict json) >>= buttonFromId >>= buttonToOp

    withMPD . maybe (return ()) op $ b >>= buttonToOp

run :: MPD T.Text -> IO ()
run m = do
  out <- withMPD m
  case out of
    (Left msg) -> print msg
    (Right l) -> T.putStrLn l
run = withMPD >=> either print T.putStrLn

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



@@ 58,13 56,12 @@ statusInfo = fmap statusInfo' status
extractSong :: MPD T.Text
extractSong = fmap extractSong' currentSong
  where extractSong' song =
          fromMaybe "no song" $
          do tags <- sgTags <$> song
             if null tags
               then fmap (toText . sgFilePath) song
               else do
                 title <- extract =<< M.lookup Title tags
                 artist <- extract =<< M.lookup Artist tags
                 return $ artist <> " - " <> title
          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

M mpd-status.cabal => mpd-status.cabal +2 -0
@@ 20,6 20,8 @@ source-repository head
    location:   https://github.com/pvsr/mpd-status

executable mpd-status
  default-extensions:  OverloadedStrings
  other-extensions:    LambdaCase
  ghc-options:         -Wall
  main-is:             Status.hs
  other-modules:       Click