diff --git a/XMonad/Actions/Volume.hs b/XMonad/Actions/Volume.hs --- a/XMonad/Actions/Volume.hs +++ b/XMonad/Actions/Volume.hs @@ -55,21 +55,13 @@ import Control.Monad import Control.Monad.Trans -import Data.List.Split (splitOn) import Data.Maybe -import System.IO -import System.Process -import Text.ParserCombinators.Parsec import XMonad.Core - -#if MIN_VERSION_base(4,8,0) -import Prelude hiding ((<*)) +import Sound.ALSA.Mixer +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>), (<*>)) #endif -infixl 1 <* -(<*) :: Monad m => m a -> m b -> m a -pa <* pb = pa >>= \a -> pb >> return a - {- $usage You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -145,13 +137,13 @@ raiseVolumeChannels cs = modifyVolumeChannels cs . (+) lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract) -getVolumeChannels = liftIO . fmap fst . amixerGetAll -getMuteChannels = liftIO . fmap snd . amixerGetAll -getVolumeMuteChannels = liftIO . amixerGetAll +getVolumeChannels = liftIO . fmap fst . alsaGetAll +getMuteChannels = liftIO . fmap snd . alsaGetAll +getVolumeMuteChannels = liftIO . alsaGetAll -setVolumeChannels cs v = liftIO (amixerSetVolumeOnlyAll v cs) -setMuteChannels cs m = liftIO (amixerSetMuteOnlyAll m cs) -setVolumeMuteChannels cs v m = liftIO (amixerSetAll v m cs) +setVolumeChannels cs v = liftIO (alsaSetVolumeAll v cs) +setMuteChannels cs m = liftIO (alsaSetMuteAll m cs) +setVolumeMuteChannels cs v m = liftIO (alsaSetAll v m cs) modifyVolumeChannels = modify getVolumeChannels setVolumeChannels modifyMuteChannels = modify getMuteChannels setMuteChannels @@ -164,90 +156,65 @@ clip :: (Num t, Ord t) => t -> t clip = min 100 . max 0 +toRange :: (Integer, Integer) -> Double -> Integer +toRange (x, y) d = floor (d * (y' - x') / 100 + x') + where x' = fromIntegral x + y' = fromIntegral y + +fromRange :: (Integer, Integer) -> Integer -> Double +fromRange (x, y) z = fromIntegral (z - x) / fromIntegral (y - x) * 100 + modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value modify get set cs f = do v <- liftM f $ get cs set cs v return v -outputOf :: String -> IO String -outputOf s = do - uninstallSignalHandlers - (hIn, hOut, hErr, p) <- runInteractiveCommand s - mapM_ hClose [hIn, hErr] - hGetContents hOut <* waitForProcess p <* installSignalHandlers - -amixerSetAll :: Double -> Bool -> [String] -> IO () -amixerSet :: Double -> Bool -> String -> IO String -amixerGetAll :: [String] -> IO (Double, Bool) -amixerGet :: String -> IO String -amixerSetAll = (mapM_ .) . amixerSet -amixerSet v m s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ show (clip v) ++ "% " ++ (if m then "" else "un") ++ "mute" -amixerGetAll = fmap parseAmixerGetAll . mapM amixerGet -amixerGet s = outputOf $ "amixer get \'" ++ s ++ "\'" - -amixerSetVolumeOnlyAll :: Double -> [String] -> IO () -amixerSetVolumeOnly :: Double -> String -> IO String -amixerSetVolumeOnlyAll = mapM_ . amixerSetVolumeOnly -amixerSetVolumeOnly v s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ show (clip v) ++ "%" - -amixerSetMuteOnlyAll :: Bool -> [String] -> IO () -amixerSetMuteOnly :: Bool -> String -> IO String -amixerSetMuteOnlyAll = mapM_ . amixerSetMuteOnly -amixerSetMuteOnly m s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ (if m then "" else "un") ++ "mute" +withControl :: (Control -> IO a) -> [String] -> IO a +withControl f cs = withMixer "default" $ \mixer -> do + (control:_) <- catMaybes <$> mapM (getControlByName mixer) cs + f control -parseAmixerGetAll :: [String] -> (Double, Bool) -parseAmixerGetAll ss = (geomMean vols, mute) where - (vols, mutings) = unzip [v | Right p <- map (parse amixerGetParser "") ss, v <- p] - mute = or . catMaybes $ mutings +alsaGetAll :: [String] -> IO (Double, Bool) +alsaGetAll = withControl $ \control -> (,) <$> alsaGetVolume control + <*> alsaGetMute control -amixerGetParser :: Parser [(Double, Maybe Bool)] -amixerGetParser = headerLine >> playbackChannels >>= volumes <* eof +alsaGetVolume :: Control -> IO Double +alsaGetVolume control = do + let Just playbackVolume = playback $ volume control + volChans = value playbackVolume + range <- getRange playbackVolume + vals <- mapM (\chan -> getChannel chan volChans) (channels volChans) + return $ geomMean $ map (fromRange range . fromJust) vals -headerLine :: Parser String -playbackChannels :: Parser [String] -volumes :: [String] -> Parser [(Double, Maybe Bool)] -headerLine = string "Simple mixer control " >> upTo '\n' -playbackChannels = keyValueLine >>= \kv -> case kv of - ("Playback channels", v) -> return (splitOn " - " v) - _ -> playbackChannels -volumes channels = fmap concat . many1 $ keyValueLine >>= \kv -> return $ case kv of - (k, v) | k `elem` channels -> parseChannel v - | otherwise -> [] +alsaGetMute :: Control -> IO Bool +alsaGetMute control = do + let Just muteChans = playback $ switch control + all id . map fromJust <$> mapM (\chan -> getChannel chan muteChans) (channels muteChans) -upTo :: Char -> Parser String -keyValueLine :: Parser (String, String) -upTo c = many (satisfy (/= c)) <* char c -keyValueLine = do - string " " - key <- upTo ':' - value <- upTo '\n' - return (key, drop 1 value) +alsaSetVolumeAll :: Double -> [String] -> IO () +alsaSetVolumeAll v = withControl (alsaSetVolume v) -parseChannel :: String -> [(Double, Maybe Bool)] -channelParser :: Parser [(Double, Maybe Bool)] -parseChannel = either (const []) id . parse channelParser "" -channelParser = fmap catMaybes (many1 playbackOrCapture) <* eof +alsaSetVolume :: Double -> Control -> IO () +alsaSetVolume v control = do + let Just playbackVolume = playback $ volume control + volChans = value playbackVolume + range <- getRange playbackVolume + forM_ (channels volChans) $ \chan -> do + setChannel chan volChans (toRange range (clip v)) -playbackOrCapture :: Parser (Maybe (Double, Maybe Bool)) -playbackOrCapture = do - f <- (string "Playback " >> return Just) <|> - (string "Capture " >> return (const Nothing)) - many1 digit - char ' ' - es <- extras - case filter ('%' `elem`) es of - [volume] -> return . f . (,) (read (init volume) :: Double) $ case ("off" `elem` es, "on" `elem` es) of - (False, False) -> Nothing - (mute, _) -> Just mute - _ -> fail "no percentage-volume found in playback section" +alsaSetMuteAll :: Bool -> [String] -> IO () +alsaSetMuteAll m = withControl (alsaSetMute m) -extras :: Parser [String] -extras = sepBy' (char '[' >> upTo ']') (char ' ') +alsaSetMute :: Bool -> Control -> IO () +alsaSetMute m control = do + let Just muteChans = playback $ switch control + forM_ (channels muteChans) $ \chan -> setChannel chan muteChans m -sepBy' :: Parser a -> Parser b -> Parser [a] -sepBy' p sep = liftM2 (:) p loop where - loop = (sep >> (liftM2 (:) p loop <|> return [])) <|> return [] +alsaSetAll :: Double -> Bool -> [String] -> IO () +alsaSetAll v m = withControl $ \control -> do + alsaSetVolume v control + alsaSetMute m control -- | Helper function to output current volume via osd_cat. (Needs the osd_cat executable). -- The second parameter is passed True when the speakers are muted and should diff --git a/XMonad/Config/Alt/Internal.hs b/XMonad/Config/Alt/Internal.hs --- a/XMonad/Config/Alt/Internal.hs +++ b/XMonad/Config/Alt/Internal.hs @@ -194,13 +194,7 @@ data Id = Id deriving Show --- | The difference between HNats. Clamped to HZero -type family HSubtract (a :: HNat) (b :: HNat) :: HNat -type instance HSubtract (HSucc a) (HSucc b) = HSubtract a b -type instance HSubtract a HZero = a -type instance HSubtract HZero b = HZero - -hSubtract :: Proxy a -> Proxy b -> Proxy (HSubtract a b) +hSubtract :: Proxy a -> Proxy b -> Proxy (MergeEither (HSubtract a b)) hSubtract _ _ = undefined type family MergeEither (x :: Either HNat HNat) :: HNat @@ -270,11 +264,11 @@ insGeq n a f l = let (b,g) = hLookupByHNat n l - h = (hOr b a, composeIf (hNot b) f g) + h = (hOr b a, composeIf (hNotTF b) f g) in hUpdateAtHNat n h l -hNot :: Proxy b -> Proxy (HNot b) -hNot _ = Proxy +hNotTF :: Proxy a -> Proxy (HNot a) +hNotTF _ = Proxy -- | utility class, so that we can use contexts that may not be satisfied, @@ -292,7 +286,7 @@ l2 ~ HAppendListR (HAppendListR l1 ids) '[(Proxy hold, t1)], HAppendList l1 ids, HLengthEq l1 b, - HReplicateFD (HSubtract n b) id ids, + HReplicateFD (MergeEither (HSubtract n b)) id ids, id ~ (Proxy 'False, Id)) => Ins2 True n hold t1 l1 l2 where ins2 _ = insLt diff --git a/XMonad/Prompt/MPD.hs b/XMonad/Prompt/MPD.hs --- a/XMonad/Prompt/MPD.hs +++ b/XMonad/Prompt/MPD.hs @@ -1,4 +1,6 @@ {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | @@ -25,7 +27,6 @@ ,findOrAdd ) where import Control.Monad -import qualified Data.ByteString as B import Data.Char import qualified Data.Map as M import Data.Maybe @@ -100,7 +101,7 @@ -- returns the songs from that album. findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song] findMatching runMPD xp metas = do - resp <- io . runMPD . fmap extractSongs . listAllInfo $ Path B.empty + resp <- io . runMPD . fmap extractSongs . listAllInfo $ ("" :: Path) case resp of Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err) >> return [] diff --git a/xmonad-extras.cabal b/xmonad-extras.cabal --- a/xmonad-extras.cabal +++ b/xmonad-extras.cabal @@ -1,6 +1,6 @@ name: xmonad-extras -version: 0.12.1 -homepage: http://projects.haskell.org/xmonad-extras +version: 0.13.0 +homepage: https://github.com/xmonad/xmonad-extras synopsis: Third party extensions for xmonad with wacky dependencies description: Various modules for xmonad that cannot be added to xmonad-contrib because of additional dependencies. @@ -8,18 +8,15 @@ license: BSD3 license-file: LICENSE author: The Daniels Schoepe and Wagner -maintainer: daniel@wagner-home.com, daniel.schoepe@googlemail.com +maintainer: Sibi , daniel@wagner-home.com, daniel.schoepe@googlemail.com cabal-version: >= 1.2.1 build-type: Simple flag small_base description: Choose the new smaller, split-up base package. -flag with_parsec - description: Build modules depending on the parsec package - -flag with_split - description: Build modules depending on Data.Split +flag with_sound + description: Build modules depending on the alsa-mixer package flag with_hint description: Build modules depending on hint(for evaluating Haskell expressions at runtime). @@ -47,31 +44,33 @@ else build-depends: base < 3 - build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.10 && <0.13, xmonad-contrib>=0.10 && <0.13 + build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.10 && <0.14, xmonad-contrib>=0.10 && <0.14 if true ghc-options: -fwarn-tabs -Wall - if flag(testing) - ghc-options: -Werror + -- Upload blocked by this: https://github.com/haskell/cabal/issues/2527 + -- Uncomment when it's fixed + -- if flag(testing) + -- ghc-options: -Werror if impl (ghc == 6.10.1) && arch (x86_64) ghc-options: --disable-optimizations - if flag(with_parsec) && flag(with_split) - build-depends: parsec >= 2 && < 4, split >= 0.1 && < 0.3 + if flag(with_sound) + build-depends: alsa-mixer >= 0.2 exposed-modules: XMonad.Actions.Volume if flag(with_hint) if impl(ghc < 7.2) build-depends: hint >= 0.3 && < 0.4, network else - build-depends: hint >= 0.3.3.3 && < 0.5, network + build-depends: hint >= 0.3.3.3 && < 0.8, network exposed-modules: XMonad.Actions.Eval XMonad.Prompt.Eval -- XMonad.Hooks.EvalServer if flag(with_mpd) - build-depends: libmpd >= 0.8 && < 0.9, bytestring >= 0.9 && < 0.11 + build-depends: libmpd >= 0.9 && < 0.10, bytestring >= 0.9 && < 0.11 exposed-modules: XMonad.Prompt.MPD if flag(with_regex_posix)