~pvsr/mpd-status

8723515379b7352eeac89ae19eba2f77ebfc3e0a — Peter Rice 2 years ago 4e3bc60
break Status.hs into several files
5 files changed, 88 insertions(+), 61 deletions(-)

R Button.hs => Click.hs
A Config.hs
A Operation.hs
M Status.hs
M mpd-status.cabal
R Button.hs => Click.hs +28 -5
@@ 1,14 1,37 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

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

import GHC.Generics (Generic)

import Data.Aeson
import Data.Text (Text)

data Button = Button {
data Button = LeftClick
            | MiddleClick
            | RightClick
            | ScrollUp
            | ScrollDown
            | ScrollLeft
            | 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


@@ 16,11 39,11 @@ data Button = Button {
    , y :: Int
    } deriving (Generic, Show)

instance ToJSON Button where
instance ToJSON Click where
  toEncoding = genericToEncoding defaultOptions

instance FromJSON Button where
  parseJSON = withObject "Button" $ \v -> Button
instance FromJSON Click where
  parseJSON = withObject "Click" $ \v -> Click
      <$> v .: "name"
      <*> v .: "instance"
      <*> v .: "button"

A Config.hs => Config.hs +17 -0
@@ 0,0 1,17 @@
module Config(buttonToOp, volStep) where

import Click
import Operation

volStep :: Int
volStep = 5

buttonToOp :: Button -> Maybe Operation
buttonToOp LeftClick = Just Toggle
buttonToOp MiddleClick = Just AllRandom
buttonToOp RightClick = Just Stop
buttonToOp ScrollUp = Just $ VolumeUp volStep
buttonToOp ScrollDown = Just $ VolumeDown volStep
buttonToOp Back = Just Previous
buttonToOp Forward = Just Next
buttonToOp _ = Nothing

A Operation.hs => Operation.hs +36 -0
@@ 0,0 1,36 @@
{-# LANGUAGE OverloadedStrings #-}
module Operation(Operation(..), op) where

import Network.MPD
import Network.MPD.Commands.Extensions

data Operation = Toggle
               | Stop
               | VolumeUp Int
               | VolumeDown Int
               | Mute
               | Previous
               | 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
-- 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 ()

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

dec :: Int -> Int -> Int
dec step vol = max 0 (baseN `div` step) * step
  where
    baseN = if vol `mod` step == 0
               then vol - 1
               else vol

M Status.hs => Status.hs +4 -55
@@ 11,51 11,10 @@ import qualified Data.ByteString as B (getLine)
import qualified Data.Text as T (Text, pack)
import qualified Data.Text.IO as T (putStrLn)
import Network.MPD
import Network.MPD.Commands.Extensions

import Button (button)

data Operation = Toggle
               | Stop
               | VolumeUp
               | VolumeDown
               | Mute
               | Previous
               | Next
               | AllRandom
               | None

buttonMap :: Maybe Int -> Operation
-- left button
buttonMap (Just 1) = Toggle
-- middle button
buttonMap (Just 2) = AllRandom
-- right button
buttonMap (Just 3) = Stop
-- scroll up
buttonMap (Just 4) = VolumeUp
-- scroll down
buttonMap (Just 5) = VolumeDown
-- back button
buttonMap (Just 8) = Previous
-- forward button
buttonMap (Just 9) = Next
buttonMap _ = None

volStep :: Int
volStep = 5

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

main :: IO ()
main = do


@@ 65,7 24,7 @@ main = do
    tid <- forkIO . sequence_ . Prelude.repeat . run $ idle [PlayerS] >> block
    json <- B.getLine
    killThread tid
    withMPD . op . buttonMap . fmap button $ decodeStrict json
    withMPD . op $ (button <$> decodeStrict json) >>= buttonFromId >>= buttonToOp


run :: MPD T.Text -> IO ()


@@ 109,13 68,3 @@ extractSong = fmap extractSong' currentSong
                 return $ artist <> " - " <> title
        extract [] = Nothing
        extract (b:_) = Just $ toText b

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

dec :: Int -> Int -> Int
dec step vol = max 0 (baseN `div` step) * step
  where
    baseN = if vol `mod` step == 0
               then vol - 1
               else vol

M mpd-status.cabal => mpd-status.cabal +3 -1
@@ 22,7 22,9 @@ source-repository head
executable mpd-status
  ghc-options:         -Wall
  main-is:             Status.hs
  other-modules:       Button
  other-modules:       Config
                       Button
                       Operation

  build-depends:       base >=4.11 && <4.12
                     , aeson >=1.4 && <1.5