module Network.MPD.Parse where
import Control.Monad.Error
import Network.MPD.Utils
import Network.MPD.Core (MPD, MPDError(Unexpected))
type Seconds = Integer
data PLIndex = Pos Integer
| ID Integer
deriving (Show, Eq)
data State = Playing
| Stopped
| Paused
deriving (Show, Eq)
data Count =
Count { cSongs :: Integer
, cPlaytime :: Seconds
}
deriving (Eq, Show)
parseCount :: [String] -> Either String Count
parseCount = foldM f empty . toAssoc
where f a ("songs", x) = parse parseNum
(\x' -> a { cSongs = x'}) x
f a ("playtime", x) = parse parseNum
(\x' -> a { cPlaytime = x' }) x
f _ x = Left $ show x
empty = Count { cSongs = 0, cPlaytime = 0 }
data Device =
Device { dOutputID :: Int
, dOutputName :: String
, dOutputEnabled :: Bool }
deriving (Eq, Show)
parseOutputs :: [String] -> Either String [Device]
parseOutputs = mapM (foldM f empty) . splitGroups [("outputid",id)] . toAssoc
where f a ("outputid", x) = parse parseNum (\x' -> a { dOutputID = x' }) x
f a ("outputname", x) = return a { dOutputName = x }
f a ("outputenabled", x) = parse parseBool
(\x' -> a { dOutputEnabled = x'}) x
f _ x = fail $ show x
empty = Device 0 "" False
data Stats =
Stats { stsArtists :: Integer
, stsAlbums :: Integer
, stsSongs :: Integer
, stsUptime :: Seconds
, stsPlaytime :: Seconds
, stsDbPlaytime :: Seconds
, stsDbUpdate :: Integer
}
deriving (Eq, Show)
parseStats :: [String] -> Either String Stats
parseStats = foldM f defaultStats . toAssoc
where
f a ("artists", x) = parse parseNum (\x' -> a { stsArtists = x' }) x
f a ("albums", x) = parse parseNum (\x' -> a { stsAlbums = x' }) x
f a ("songs", x) = parse parseNum (\x' -> a { stsSongs = x' }) x
f a ("uptime", x) = parse parseNum (\x' -> a { stsUptime = x' }) x
f a ("playtime", x) = parse parseNum (\x' -> a { stsPlaytime = x' }) x
f a ("db_playtime", x) = parse parseNum
(\x' -> a { stsDbPlaytime = x' }) x
f a ("db_update", x) = parse parseNum (\x' -> a { stsDbUpdate = x' }) x
f _ x = fail $ show x
defaultStats =
Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0
, stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 }
data Song =
Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer
, sgPerformer :: String
, sgLength :: Seconds
, sgDate :: Int
, sgTrack :: (Int, Int)
, sgDisc :: (Int, Int)
, sgIndex :: Maybe PLIndex }
deriving Show
instance Eq Song where
(==) x y = sgFilePath x == sgFilePath y
parseSong :: [(String, String)] -> Either String Song
parseSong xs = foldM f song xs
where f a ("Artist", x) = return a { sgArtist = x }
f a ("Album", x) = return a { sgAlbum = x }
f a ("Title", x) = return a { sgTitle = x }
f a ("Genre", x) = return a { sgGenre = x }
f a ("Name", x) = return a { sgName = x }
f a ("Composer", x) = return a { sgComposer = x }
f a ("Performer", x) = return a { sgPerformer = x }
f a ("Date", x) = parse parseDate (\x' -> a { sgDate = x' }) x
f a ("Track", x) = parse parseTuple (\x' -> a { sgTrack = x'}) x
f a ("Disc", x) = parse parseTuple (\x' -> a { sgDisc = x'}) x
f a ("file", x) = return a { sgFilePath = x }
f a ("Time", x) = parse parseNum (\x' -> a { sgLength = x'}) x
f a ("Id", x) = parse parseNum
(\x' -> a { sgIndex = Just (ID x') }) x
f a ("Pos", x) =
maybe (parse parseNum (\x' -> a { sgIndex = Just (Pos x') }) x)
(const $ return a)
(sgIndex a)
f _ x = fail $ show x
parseTuple s = let (x, y) = breakChar '/' s in
case (parseNum x, parseNum y) of
(Just x', Nothing) -> Just (x', x')
(Just x', Just y') -> Just (x', y')
_ -> Nothing
song = Song { sgArtist = "", sgAlbum = "", sgTitle = ""
, sgGenre = "", sgName = "", sgComposer = ""
, sgPerformer = "", sgDate = 0, sgTrack = (0,0)
, sgDisc = (0,0), sgFilePath = "", sgLength = 0
, sgIndex = Nothing }
data Status =
Status { stState :: State
, stVolume :: Int
, stRepeat :: Bool
, stRandom :: Bool
, stPlaylistVersion :: Integer
, stPlaylistLength :: Integer
, stSongPos :: Maybe PLIndex
, stSongID :: Maybe PLIndex
, stTime :: (Seconds, Seconds)
, stBitrate :: Int
, stXFadeWidth :: Seconds
, stAudio :: (Int, Int, Int)
, stUpdatingDb :: Integer
, stError :: String }
deriving (Eq, Show)
parseStatus :: [String] -> Either String Status
parseStatus = foldM f empty . toAssoc
where f a ("state", x) = parse state (\x' -> a { stState = x'}) x
f a ("volume", x) = parse parseNum (\x' -> a { stVolume = x'}) x
f a ("repeat", x) = parse parseBool
(\x' -> a { stRepeat = x' }) x
f a ("random", x) = parse parseBool
(\x' -> a { stRandom = x' }) x
f a ("playlist", x) = parse parseNum
(\x' -> a { stPlaylistVersion = x'}) x
f a ("playlistlength", x) = parse parseNum
(\x' -> a { stPlaylistLength = x'}) x
f a ("xfade", x) = parse parseNum
(\x' -> a { stXFadeWidth = x'}) x
f a ("song", x) = parse parseNum
(\x' -> a { stSongPos = Just (Pos x') }) x
f a ("songid", x) = parse parseNum
(\x' -> a { stSongID = Just (ID x') }) x
f a ("time", x) = parse time (\x' -> a { stTime = x' }) x
f a ("bitrate", x) = parse parseNum
(\x' -> a { stBitrate = x'}) x
f a ("audio", x) = parse audio (\x' -> a { stAudio = x' }) x
f a ("updating_db", x) = parse parseNum
(\x' -> a { stUpdatingDb = x' }) x
f a ("error", x) = return a { stError = x }
f _ x = fail $ show x
state "play" = Just Playing
state "pause" = Just Paused
state "stop" = Just Stopped
state _ = Nothing
time s = pair parseNum $ breakChar ':' s
audio s = let (u, u') = breakChar ':' s
(v, w) = breakChar ':' u' in
case (parseNum u, parseNum v, parseNum w) of
(Just a, Just b, Just c) -> Just (a, b, c)
_ -> Nothing
empty = Status Stopped 0 False False 0 0 Nothing Nothing (0,0) 0 0
(0,0,0) 0 ""
runParser :: (input -> Either String a) -> input -> MPD a
runParser f = either (throwError . Unexpected) return . f
parse :: Monad m => (String -> Maybe a) -> (a -> b) -> String -> m b
parse p g x = maybe (fail x) (return . g) (p x)
pair :: (String -> Maybe a) -> (String, String) -> Maybe (a, a)
pair p (x, y) = case (p x, p y) of
(Just a, Just b) -> Just (a, b)
_ -> Nothing