diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ CHANGELOG +2.20131203 -> 2.20131220 + - Update to fast-logger-2.0 + - New command: lord douban listen [ | ] + - New command: lord toggle + - Adjust for new cmd.fm api + 2.20131201 -> 2.20131203 - Bug fixes diff --git a/Radio.hs b/Radio.hs --- a/Radio.hs +++ b/Radio.hs @@ -18,17 +18,17 @@ import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar -import qualified Control.Exception as E import Control.Monad (liftM, when, void) import Data.Aeson hiding (encode) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C -import Data.Conduit (runResourceT, ($$+-)) -import Data.Conduit.Binary (sinkFile) +import Data.Maybe (isJust, fromJust) +import Data.Monoid ((<>)) import Data.Yaml -import Network.HTTP.Conduit hiding (path) import Network.MPD hiding (play, pause, Value) import qualified Network.MPD as MPD +import Network.MPD.Core (getResponse) +import Network.Wai.Logger (ZonedDate, clockDateCacher) import System.Directory (doesFileExist, getHomeDirectory) import System.IO import System.IO.Unsafe (unsafePerformIO) @@ -39,14 +39,14 @@ eof :: MVar () eof = unsafePerformIO newEmptyMVar -data SongMeta = SongMeta +data SongMeta = SongMeta { artist :: String , album :: String , title :: String - } + } instance Show SongMeta where - show meta = artist meta ++ " - " ++ title meta + show meta = artist meta ++ " - " ++ title meta class FromJSON a => Radio a where data Param a :: * @@ -61,11 +61,6 @@ tagged :: a -> Bool - -- Mpd can play remote mp3 files directly. - -- For m4a files, lord download it as ~/.lord/lord.m4a - playable :: a -> Bool - playable _ = True - reportRequired :: a -> Bool reportRequired _ = False @@ -77,36 +72,30 @@ time <- liftM stTime <$> withMPD status case time of Right (elapsed, _) -> - if elapsed < 30 + if elapsed < 30 then threadDelay (5*1000000) >> reportLoop param x else report param x Left err -> print err - play :: Logger -> Param a -> [a] -> IO () + play :: LoggerSet -> Param a -> [a] -> IO () play logger reqData xxs = do st <- withMPD status case st of Right _ -> playWithMPD logger reqData xxs Left _ -> playWithMplayer logger reqData xxs -playWithMPD :: Radio a => Logger -> Param a -> [a] -> IO () -playWithMPD logger reqData [] = +-- MPD can play remote m4a files directly since version-0.18 +playWithMPD :: Radio a => LoggerSet -> Param a -> [a] -> IO () +playWithMPD logger reqData [] = getPlaylist reqData >>= playWithMPD logger reqData -playWithMPD logger reqData (x:xs) - | playable x = loadAndPlay logger reqData (x:xs) - | otherwise = downloadAndPlay logger reqData (x:xs) - -loadAndPlay :: Radio a => Logger -> Param a -> [a] -> IO () -loadAndPlay logger reqData [] = - getPlaylist reqData >>= loadAndPlay logger reqData -loadAndPlay logger reqData (x:xs) = do +playWithMPD logger reqData (x:xs) = do surl <- songUrl reqData x print surl when (surl /= "") $ do logAndReport logger reqData x mpdLoad $ Path $ C.pack surl takeMVar eof -- Finished - loadAndPlay logger reqData xs + playWithMPD logger reqData xs where mpdLoad :: Path -> IO () mpdLoad path = do @@ -114,73 +103,18 @@ clear add path withMPD $ MPD.play Nothing - mpdPlay + mpdTag $ songMeta x + mpdPlay mpdPlay :: IO () mpdPlay = do st <- mpdState - if st == Right Stopped + if st == Right Stopped then putMVar eof () else mpdPlay -downloadAndPlay :: Radio a => Logger -> Param a -> [a] -> IO () -downloadAndPlay logger reqData [] = - getPlaylist reqData >>= downloadAndPlay logger reqData -downloadAndPlay logger reqData (x:xs) = do - surl <- songUrl reqData x - print surl - req <- parseUrl surl - home <- getLordDir - manager <- newManager def - forkIO $ E.catch - (do - logAndReport logger reqData x - - runResourceT $ do - res <- http req manager - responseBody res $$+- sinkFile (home ++ "/lord.m4a") - -- This will block until eof. - - putMVar eof ()) - (\e -> do - print (e :: E.SomeException) - writeLog logger $ show e - downloadAndPlay logger reqData xs - ) - threadDelay (3*1000000) - mpdLoad m4a - downloadAndPlay logger reqData xs - where - m4a = "lord/lord.m4a" - - mpdLoad :: Path -> IO () - mpdLoad path = do - s <- withMPD $ do - clear - update [Path "lord"] - add path - case s of - Right _ -> do - withMPD $ MPD.play Nothing - mpdPlay - _ -> mpdLoad path - - mpdPlay :: IO () - mpdPlay = do - st <- mpdState - bd <- isEmptyMVar eof - if st == Right Stopped - then if bd - then do -- Slow Network - withMPD $ MPD.play Nothing - mpdPlay - else do - withMPD clear - takeMVar eof -- Finished - else mpdPlay -- Pause - -playWithMplayer :: Radio a => Logger -> Param a -> [a] -> IO () -playWithMplayer logger reqData [] = +playWithMplayer :: Radio a => LoggerSet -> Param a -> [a] -> IO () +playWithMplayer logger reqData [] = getPlaylist reqData >>= playWithMplayer logger reqData playWithMplayer logger reqData (x:xs) = do surl <- songUrl reqData x @@ -190,34 +124,50 @@ void $ waitForProcess =<< runCommand sh playWithMplayer logger reqData xs -logAndReport :: Radio a => Logger -> Param a -> a -> IO () +logAndReport :: Radio a => LoggerSet -> Param a -> a -> IO () logAndReport logger reqData x = do - writeLog logger (show $ songMeta x) + writeLog logger (show $ songMeta x) getStateFile >>= flip writeFile (show $ songMeta x) -- Report song played if needed when (reportRequired x) $ void (forkIO $ reportLoop reqData x) mpdState :: IO (MPD.Response State) mpdState = do - withMPD $ idle [PlayerS] + withMPD $ idle [PlayerS] -- This will block until paused/finished. st <- liftM stState <$> withMPD status print st return st +-- "addtagid" command is available since mpd-0.19 +mpdTag :: SongMeta -> IO () +mpdTag meta = void $ withMPD $ do + cs <- currentSong + when (isJust cs) $ do + let (Id sid) = fromJust $ sgId $ fromJust cs + void $ do + addTag sid arTag + addTag sid alTag + addTag sid tiTag + where + addTag sid tag = getResponse $ "addtagid " ++ show sid ++ tag + arTag = " artist \"" ++ artist meta ++ "\"" + alTag = " album \"" ++ album meta ++ "\"" + tiTag = " title \"" ++ title meta ++ "\"" + class (Radio a, ToJSON (Param a), ToJSON (Config a)) => NeedLogin a where login :: String -> IO (Param a) login keywords = do hSetBuffering stdout NoBuffering - hSetEcho stdin True + hSetEcho stdin True putStrLn "Please Log in" putStr "Email: " email <- getLine putStr "Password: " - hSetEcho stdin False + hSetEcho stdin False pwd <- getLine - hSetEcho stdin True + hSetEcho stdin True putStrLn "" mtoken <- createSession keywords email pwd case mtoken of @@ -259,9 +209,9 @@ conf <- decodeFile yml case conf of Nothing -> error $ "Invalid YAML file: " ++ show conf - Just c -> + Just c -> case fromJSON c of - Success tok -> return $ Just $ + Success tok -> return $ Just $ mkParam (selector tok) keywords Error err -> do print $ "Parse token failed: " ++ show err @@ -280,15 +230,12 @@ getStateFile :: IO FilePath getStateFile = (++ "/lordstate") <$> getLordDir -formatLogMessage :: IO ZonedDate -> String -> IO [LogStr] +formatLogMessage :: IO ZonedDate -> String -> IO LogStr formatLogMessage getdate msg = do now <- getdate - return - [ LB now - , LB " : " - , LS $ encodeString msg - , LB "\n" - ] + return $ toLogStr now <> " : " <> toLogStr (encodeString msg) <> "\n" -writeLog :: Logger -> String -> IO () -writeLog l msg = formatLogMessage (loggerDate l) msg >>= loggerPutStr l +writeLog :: LoggerSet -> String -> IO () +writeLog l msg = do + (loggerDate, _) <- clockDateCacher + formatLogMessage loggerDate msg >>= pushLogStr l diff --git a/Radio/Cmd.hs b/Radio/Cmd.hs --- a/Radio/Cmd.hs +++ b/Radio/Cmd.hs @@ -26,7 +26,7 @@ , artwork_url :: String , description :: String , duration :: Int - , genre :: String + --, genre :: String , tag_list :: String , waveform_url :: String , stream_url :: String @@ -63,18 +63,18 @@ let req = initReq { method = "GET" , queryString = renderQuery False query } - E.catch (withManager $ \manager -> + E.catch (withManager $ \manager -> httpLbs req { redirectCount = 0 } manager >> return "") (\e -> case e of (StatusCodeException s hdr _) -> - if s == status302 then redirect hdr + if s == status302 then redirect hdr else return "" otherException -> print otherException >> return "" ) where url = stream_url x query = [("client_id", Just $ C.pack "2b659ea66970555922d89ce9c07b2d0d")] - redirect hdr = case HM.lookup hLocation $ HM.fromList hdr of + redirect hdr = case HM.lookup hLocation $ HM.fromList hdr of Just u -> return $ C.unpack u Nothing -> return "" @@ -84,7 +84,7 @@ -- Currently, no api is provided to retrieve genre list. genres :: IO [String] -genres = return +genres = return ["80s","Abstract","Acid Jazz","Acoustic" ,"Acoustic Rock","Alternative","Ambient","Avantgarde" ,"Ballads","Blues","Blues Rock","Breakbeats" diff --git a/Radio/Douban.hs b/Radio/Douban.hs --- a/Radio/Douban.hs +++ b/Radio/Douban.hs @@ -12,6 +12,7 @@ import Data.Conduit (($$+-)) import Data.Conduit.Attoparsec (sinkParser) import qualified Data.HashMap.Strict as HM +import Data.List (isPrefixOf) import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as T import Network.HTTP.Conduit @@ -69,8 +70,8 @@ res <- http req manager liftM Radio.parsePlaylist (responseBody res $$+- sinkParser json) -musicianID :: String -> IO (Maybe String) -musicianID mname = do +musicianId :: String -> IO (Maybe String) +musicianId mname = do let rurl = "http://music.douban.com/subject_search/?search_text=" ++ C.unpack (urlEncode True (C.pack $ encodeString mname)) rsp <- simpleHttp rurl @@ -80,8 +81,29 @@ &| attribute "href" return $ Just $ filter isDigit $ T.unpack $ head $ head href +albumPlayable :: Int -> IO Bool +albumPlayable aId = do + res <- simpleHttp $ aPattern ++ show aId + let cursor = fromDocument $ parseLBS res + start_radio = cursor $// element "div" + >=> attributeIs "class" "start_radio" + return $ not $ null start_radio + where + aPattern = "http://music.douban.com/subject/" + +mkQuery :: Int -> String -> Query +mkQuery cid context = + [ ("type", Just "n") + , ("channel", Just $ C.pack $ show cid) + , ("context", Just $ C.pack context) + , ("from", Just "lord") + ] + instance Radio.Radio Douban where - data Param Douban = Cid Int | Musician String + data Param Douban = ChannelId Int + | Album Int + | MusicianId Int + | MusicianName String -- TODO: those without ssid filed are ads, filter them out! parsePlaylist (Object hm) = do @@ -91,20 +113,17 @@ Error _ -> [] parsePlaylist _ = error "Unrecognized playlist format." - getPlaylist (Cid cid) = do - let query = [ ("type", Just "n") - , ("channel", Just $ C.pack $ show cid) - , ("from", Just "lord") - ] - getPlaylist' query - getPlaylist (Musician mname) = do - mId <- musicianID mname - let query = [ ("type", Just "n") - , ("channel", Just "0") - , ("context", Just $ C.pack ("channel:0|musician_id:" ++ fromJust mId)) - , ("from", Just "lord") - ] - getPlaylist' query + getPlaylist (ChannelId cid) = getPlaylist' $ mkQuery cid "" + getPlaylist (Album aId) = do + playable <- albumPlayable aId + if playable then getPlaylist' $ + mkQuery 0 $ "channel:0|subjetc_id:" ++ show aId + else error "This album can not be played." + getPlaylist (MusicianId mid) = + getPlaylist' $ mkQuery 0 $ "channel:0|musician_id" ++ show mid + getPlaylist (MusicianName mname) = do + mmid <- musicianId mname + Radio.getPlaylist (MusicianId $ read $ fromJust mmid) songUrl _ x = return $ url x @@ -189,3 +208,14 @@ case channels of Success c -> return c Error err -> putStrLn err >> print resData >> return [] + +douban :: String -> Radio.Param Douban +douban k + | isChId k = ChannelId $ read k + | aPattern `isPrefixOf` k = Album $ read $ init $ drop (length aPattern) k + | mPattern `isPrefixOf` k = MusicianId $ read $ init $ drop (length mPattern) k + | otherwise = MusicianName k + where + isChId = and . fmap isDigit + aPattern = "http://music.douban.com/subject/" + mPattern = "http://music.douban.com/musician/" diff --git a/Radio/EightTracks.hs b/Radio/EightTracks.hs --- a/Radio/EightTracks.hs +++ b/Radio/EightTracks.hs @@ -142,8 +142,6 @@ tagged _ = False - playable _ = False - reportRequired _ = True -- From api-doc: In order to be legal and pay royalties properly, diff --git a/Radio/Jing.hs b/Radio/Jing.hs --- a/Radio/Jing.hs +++ b/Radio/Jing.hs @@ -122,8 +122,6 @@ -- Songs from jing.fm comes with tags! tagged _ = True - - playable _ = False instance FromJSON JingParam instance ToJSON JingParam diff --git a/lord.cabal b/lord.cabal --- a/lord.cabal +++ b/lord.cabal @@ -1,7 +1,7 @@ name: lord -version: 2.20131203 +version: 2.20131220 synopsis: A command line interface to online radios. -description: +description: A unified command line interface to several online radios, use mpd () as backend by default. Will fallback to mplayer () when mpd is unavailable. . Supported radios: @@ -29,7 +29,7 @@ > lord cmd listen [--no-daemon] > lord cmd genres > - > lord douban listen [ | ] [--no-daemon] + > lord douban listen [ | | | ] [--no-daemon] > lord douban search > lord douban [hot | trending] > @@ -37,7 +37,7 @@ > > lord reddit listen [--no-daemon] > lord reddit genres - + homepage: https://github.com/rnons/lord bug-reports: https://github.com/rnons/lord/issues license: PublicDomain @@ -55,7 +55,7 @@ location: git://github.com/rnons/lord.git executable lord - main-is: main.hs + main-is: main.hs other-modules: Radio, Radio.Cmd, Radio.Douban, @@ -65,29 +65,29 @@ Radio.Jing, Radio.Reddit ghc-options: -Wall -fno-warn-unused-do-bind - build-depends: base >= 4 && < 5, - aeson >= 0.6, - ansi-terminal >= 0.6, - attoparsec-conduit >= 1.0, - bytestring >= 0.9, - case-insensitive >= 1.0, - conduit >= 1.0, - configurator >= 0.2, + build-depends: base >= 4 && < 5, + aeson >= 0.6, + ansi-terminal >= 0.6, + attoparsec-conduit >= 1.0, + bytestring >= 0.9, + case-insensitive >= 1.0, + conduit >= 1.0, daemons >= 0.1.2, data-default >= 0.5, - directory >= 1.1, - fast-logger >= 0.3, - html-conduit >= 1.1, - http-conduit >= 1.9, - http-types >= 0.8, - libmpd >= 0.8, + directory >= 1.1, + fast-logger >= 2.0, + html-conduit >= 1.1, + http-conduit >= 1.9, + http-types >= 0.8, + libmpd >= 0.8, optparse-applicative >= 0.5, process >= 1.1, - text >= 0.11, - transformers >= 0.3, - unix >= 2.5, - unordered-containers >= 0.2, - utf8-string >= 0.3, + text >= 0.11, + transformers >= 0.3, + unix >= 2.5, + unordered-containers >= 0.2, + wai-logger >= 2.0, + utf8-string >= 0.3, xml-conduit >= 1.1, yaml >= 0.8 default-language: Haskell2010 @@ -98,30 +98,30 @@ ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: . build-depends: base >= 4 && < 5, - aeson >= 0.6, - ansi-terminal >= 0.6, - attoparsec-conduit >= 1.0, - bytestring >= 0.9, - case-insensitive >= 1.0, - conduit >= 1.0, - configurator >= 0.2, + aeson >= 0.6, + ansi-terminal >= 0.6, + attoparsec-conduit >= 1.0, + bytestring >= 0.9, + case-insensitive >= 1.0, + conduit >= 1.0, daemons >= 0.1.2, data-default >= 0.5, - directory >= 1.1, - fast-logger >= 0.3, + directory >= 1.1, + fast-logger >= 2.0, hspec >= 1.6, - html-conduit >= 1.1, - http-conduit >= 1.9, - http-types >= 0.8, + html-conduit >= 1.1, + http-conduit >= 1.9, + http-types >= 0.8, HUnit >= 1.2, - libmpd >= 0.8, + libmpd >= 0.8, optparse-applicative >= 0.5, process >= 1.1, - text >= 0.11, - transformers >= 0.3, - unix >= 2.5, - unordered-containers >= 0.2, - utf8-string >= 0.3, + text >= 0.11, + transformers >= 0.3, + unix >= 2.5, + unordered-containers >= 0.2, + utf8-string >= 0.3, + wai-logger >= 2.0, xml-conduit >= 1.1, yaml >= 0.8 default-language: Haskell2010 diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -1,16 +1,17 @@ -import Control.Monad (when) +import Control.Monad (void, when) import qualified Data.ByteString.Char8 as C -import Data.Char (isDigit) import Data.Default (def) +import GHC.IO.FD (openFile, stdout) import Network.MPD (withMPD, clear, status, stState) +import Network.MPD.Commands.Extensions (toggle) import Options.Applicative import Options.Applicative.Types (ParserPrefs) import System.Directory (createDirectoryIfMissing) import System.Environment (getArgs, getProgName) import System.Exit (exitWith, exitSuccess, ExitCode(..)) -import System.IO ( openFile, IOMode(AppendMode) - , hPutStr, stdout, stderr, SeekMode(..) ) -import System.Log.FastLogger (mkLogger) +import System.IO ( IOMode(AppendMode) + , hPutStr, stderr, SeekMode(..) ) +import System.Log.FastLogger (newLoggerSet, defaultBufSize) import System.Posix.Daemon import System.Posix.Files (stdFileMode) import System.Posix.IO ( fdWrite, createFile, setLock @@ -21,7 +22,7 @@ import qualified Radio.Cmd as Cmd import Radio.Douban import qualified Radio.EightTracks as ET -import Radio.Jing +import Radio.Jing import qualified Radio.Reddit as Reddit data Options = Options @@ -35,6 +36,7 @@ | JingFM JingSubCommand | RedditFM RedditSubCommand | Status + | Toggle | Kill deriving (Eq, Show) @@ -65,7 +67,7 @@ type Keywords = String optParser :: Parser Options -optParser = Options +optParser = Options <$> subparser ( command "cmd" (info (helper <*> cmdOptions) (progDesc "cmd.fm commander")) <> command "douban" (info (helper <*> doubanOptions) @@ -77,18 +79,20 @@ <> command "reddit" (info (helper <*> redditOptions) (progDesc "radioreddit.com commander")) <> command "status" (info (pure Status) - (progDesc "show current status")) + (progDesc "Show current status")) + <> command "toggle" (info (pure Toggle) + (progDesc "Toggles play/pause. Plays if stopped")) <> command "kill" (info (pure Kill) - (progDesc "kill the current running lord session")) + (progDesc "Kill the current running lord session")) ) - <*> switch (long "no-daemon" <> help "don't detach from console") + <*> switch (long "no-daemon" <> help "Don't detach from console") main :: IO () main = do -- Make sure ~/.lord exists getLordDir >>= createDirectoryIfMissing False - o <- execParser' $ info (helper <*> optParser) + o <- execParser' $ info (helper <*> optParser) (fullDesc <> header "Lord: radio commander") let nodaemon = optDaemon o case optCommand o of @@ -96,7 +100,7 @@ case subCommand of CmdListen genre -> listen nodaemon (Cmd.Genre genre) CmdGenreList -> Cmd.genres >>= Cmd.pprGenres - DoubanFM subCommand -> + DoubanFM subCommand -> case subCommand of DoubanListen key -> listen nodaemon (douban key) DoubanHot -> doubanHot @@ -115,6 +119,7 @@ RedditListen genre -> listen nodaemon (Reddit.Genre genre) RedditGenreList -> Reddit.genres >>= Reddit.pprGenres Status -> lordStatus + Toggle -> void $ withMPD toggle Kill -> killLord -- Taken from Options.Applicative.Extra @@ -125,11 +130,11 @@ customExecParser' :: ParserPrefs -> ParserInfo a -> IO a customExecParser' pprefs pinfo = do args <- getArgs - + -- My modification! -- Run lord with no args is equivalent to run lord status. when (null args) $ lordStatus >> exitSuccess - + case execParserPure pprefs pinfo args of Right a -> return a Left failure -> do @@ -143,52 +148,53 @@ cmdOptions :: Parser Command cmdOptions = CmdFM <$> subparser - ( command "listen" + ( command "listen" (info (helper <*> (CmdListen <$> argument str (metavar "GENRE"))) (progDesc "Provide genre to listen to cmd.fm")) - <> command "genres" + <> command "genres" (info (pure CmdGenreList) (progDesc "List available genres")) ) doubanOptions :: Parser Command -doubanOptions = DoubanFM <$> subparser - ( command "listen" - (info (helper <*> (DoubanListen <$> argument str (metavar "[ | ]"))) - (progDesc "Provide cid/musician to listen to douban.fm")) - <> command "search" +doubanOptions = DoubanFM <$> subparser + ( command "listen" + (info (helper <*> (DoubanListen <$> argument str ( + metavar "[ | | | ]"))) + (progDesc "Provide channel_id/album_url/musician_url/musician_name to listen to douban.fm")) + <> command "search" (info (helper <*> (DoubanSearch <$> argument str (metavar "KEYWORDS"))) - (progDesc "search channels")) - <> command "hot" (info (pure DoubanHot) (progDesc "hot channels")) - <> command "trending" - (info (pure DoubanTrending) (progDesc "trending up channels")) + (progDesc "Search channels")) + <> command "hot" (info (pure DoubanHot) (progDesc "Hot channels")) + <> command "trending" + (info (pure DoubanTrending) (progDesc "Trending up channels")) ) etOptions :: Parser Command etOptions = EightTracks <$> subparser ( command "listen" - (info (helper <*> (ETListen <$> argument str (metavar "mix id"))) - (progDesc "Provide mix id to listen to 8tracks.com")) + (info (helper <*> (ETListen <$> argument str (metavar "[ | ]"))) + (progDesc "Provide mix_id/mix_url to listen to 8tracks.com")) <> command "featured" (info (pure ETFeatured) (progDesc "Featured mixes")) <> command "trending" (info (pure ETFeatured) (progDesc "Trending mixes")) <> command "newest" (info (pure ETFeatured) (progDesc "Newest mixes")) <> command "search" (info (helper <*> (ETSearch <$> argument str (metavar "KEYWORDS"))) - (progDesc "search mixes")) + (progDesc "Search mixes")) ) jingOptions :: Parser Command -jingOptions = JingFM <$> subparser - ( command "listen" +jingOptions = JingFM <$> subparser + ( command "listen" (info (helper <*> (JingListen <$> argument str (metavar "KEYWORDS"))) (progDesc "Provide keywords to listen to jing.fm")) ) redditOptions :: Parser Command redditOptions = RedditFM <$> subparser - ( command "listen" + ( command "listen" (info (helper <*> (RedditListen <$> argument str (metavar "GENRE"))) (progDesc "Provide genre to listen to radioreddit.com")) - <> command "genres" + <> command "genres" (info (pure RedditGenreList) (progDesc "List available genres")) ) @@ -201,13 +207,6 @@ doubanSearch :: String -> IO () doubanSearch key = search key >>= pprChannels -douban :: Keywords -> Radio.Param Douban -douban k - | isChId k = Cid $ read k - | otherwise = Musician k - where - isChId = and . fmap isDigit - etListen :: Bool -> Keywords -> IO () etListen nodaemon k = do mId <- ET.getMixId k @@ -216,7 +215,7 @@ Just tok' -> do putStrLn $ "Welcome back, " ++ ET.userName tok' listen nodaemon tok' - _ -> do + _ -> do param <- login k :: IO (Radio.Param ET.EightTracks) listen nodaemon param @@ -230,7 +229,7 @@ Just tok' -> do putStrLn $ "Welcome back, " ++ C.unpack (nick tok') listen nodaemon tok' - _ -> do + _ -> do param <- login k :: IO (Radio.Param Jing) listen nodaemon param @@ -238,18 +237,21 @@ listen nodaemon param = do -- mplayer backend won't work in daemon mode! st <- withMPD status - nodaemon' <- case st of + nodaemon' <- case st of Right _ -> return nodaemon - Left e -> print e >> + Left e -> print e >> putStrLn "Lord will run in foreground" >> return True pid <- getPidFile - logger <- if nodaemon' then mkLogger True stdout - else getLogFile >>= flip openFile AppendMode >>= mkLogger True + logger <- if nodaemon' then newLoggerSet defaultBufSize stdout + else do + fp <- getLogFile + (fd, _) <- openFile fp AppendMode True + newLoggerSet defaultBufSize fd let listen' = play logger param [] running <- isRunning pid - when running $ killAndWait pid + when running $ killAndWait pid if nodaemon' then runInForeground pid listen' else runDetached (Just pid) def listen' @@ -268,13 +270,13 @@ lordStatus :: IO () lordStatus = do running <- getPidFile >>= isRunning - myStatus <- + myStatus <- if running then do st <- fmap stState <$> withMPD status let state = case st of Right s -> show s Left err -> error $ show err - song <- getStateFile >>= readFile + song <- getStateFile >>= readFile return $ "[" ++ state ++ "] " ++ song else return "Not running!" putStrLn myStatus diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -21,11 +21,19 @@ assertNotNull ss it "douban: given channel id" $ do - ss <- getPlaylist (Cid 6) + ss <- getPlaylist $ douban "6" assertNotNull ss + it "douban: given album url" $ do + ss <- getPlaylist $ douban "http://music.douban.com/subject/3044758/" + assertNotNull ss + + it "douban: given musician url" $ do + ss <- getPlaylist $ douban "http://music.douban.com/musician/104585/" + assertNotNull ss + it "douban: given musician name" $ do - ss <- getPlaylist (Musician "Sigur RóS") + ss <- getPlaylist $ douban "Sigur RóS" assertNotNull ss it "8tracks: given mix id" $ do