module Monky.Examples.MPD
( MPDHandle
, getMPDHandle
, getMPDHandleF
)
where
import Data.Text (Text)
import qualified Data.Text as T
import Data.IORef
import System.IO (hPutStrLn, stderr)
import System.Posix.Types (Fd)
import Monky.MPD
import Monky.Modules
import Monky.Examples.Utility
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>), pure, (<*>))
#endif
type ConvertFun = (State, Maybe SongInfo) -> Text
getSongTitle :: MPDSocket -> ConvertFun -> IO Text
getSongTitle sock fun = (fmap state <$> getMPDStatus sock) >>= getSong
where getSong (Left x) = return . T.pack $ x
getSong (Right Playing) = do
info <- getMPDSong sock
case info of
Right x -> pure $ fun (Playing, Just x)
Left x -> pure $ T.pack x
getSong (Right x) = pure $ fun (x, Nothing)
data MPDHandle = MPDHandle
{ _host :: String
, _port :: String
, _sock :: IORef (Maybe MPDSocket)
, _convert :: ConvertFun
}
getEvent :: MPDSocket -> ConvertFun -> IO Text
getEvent s fun = do
_ <- readOk s
t <- getSongTitle s fun
_ <- goIdle s " player"
return t
getFd :: MPDSocket -> IO [Fd]
getFd s = do
fd <- getMPDFd s
_ <- goIdle s " player"
return [fd]
instance PollModule MPDHandle where
getOutput (MPDHandle _ _ s f) = do
r <- readIORef s
case r of
Nothing -> return [MonkyPlain "Broken"]
(Just x) -> do
ret <- getSongTitle x f
return [MonkyPlain ret]
initialize (MPDHandle h p r _) = do
s <- getMPDSocket h p
case s of
(Right x) -> writeIORef r (Just x)
(Left _) -> return ()
instance EvtModule MPDHandle where
startEvtLoop h@(MPDHandle _ _ s f) fun = do
initialize h
fun =<< getOutput h
r <- readIORef s
case r of
Nothing -> hPutStrLn stderr "Could not initialize MPDHandle :("
(Just x) -> do
[fd] <- getFd x
loopFd x fd fun (fmap (\y -> [MonkyPlain y]) . flip getEvent f)
defaultConvert :: (State, Maybe SongInfo) -> Text
defaultConvert (Playing, Just x) = case tagTitle . songTags $ x of
Nothing -> "Can't extract song title"
Just y -> y
defaultConvert (Playing, Nothing) = "Can't extract song"
defaultConvert _ = "Not Playing"
getMPDHandle
:: String
-> String
-> IO MPDHandle
getMPDHandle h p =
MPDHandle h p <$> newIORef Nothing <*> pure defaultConvert
getMPDHandleF
:: String
-> String
-> ConvertFun
-> IO MPDHandle
getMPDHandleF h p f =
MPDHandle h p <$> newIORef Nothing <*> pure f