lord 2.20131203 → 2.20131220
raw patch · 9 files changed
+209/−220 lines, 9 filesdep +wai-loggerdep −configuratordep ~fast-logger
Dependencies added: wai-logger
Dependencies removed: configurator
Dependency ranges changed: fast-logger
Files
- CHANGELOG +6/−0
- Radio.hs +49/−102
- Radio/Cmd.hs +5/−5
- Radio/Douban.hs +47/−17
- Radio/EightTracks.hs +0/−2
- Radio/Jing.hs +0/−2
- lord.cabal +42/−42
- main.hs +50/−48
- test/main.hs +10/−2
CHANGELOG view
@@ -1,5 +1,11 @@ CHANGELOG +2.20131203 -> 2.20131220+ - Update to fast-logger-2.0+ - New command: lord douban listen [<album_url> | <musician_url>]+ - New command: lord toggle+ - Adjust for new cmd.fm api+ 2.20131201 -> 2.20131203 - Bug fixes
Radio.hs view
@@ -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
Radio/Cmd.hs view
@@ -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"
Radio/Douban.hs view
@@ -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/"
Radio/EightTracks.hs view
@@ -142,8 +142,6 @@ tagged _ = False - playable _ = False- reportRequired _ = True -- From api-doc: In order to be legal and pay royalties properly,
Radio/Jing.hs view
@@ -122,8 +122,6 @@ -- Songs from jing.fm comes with tags! tagged _ = True- - playable _ = False instance FromJSON JingParam instance ToJSON JingParam
lord.cabal view
@@ -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 (<http://musicpd.org>) as backend by default. Will fallback to mplayer (<http://www.mplayerhq.hu>) when mpd is unavailable. . Supported radios:@@ -29,7 +29,7 @@ > lord cmd listen <genre> [--no-daemon] > lord cmd genres >- > lord douban listen [<channel_id> | <musician>] [--no-daemon]+ > lord douban listen [<channel_id> | <album_url> | <musician_url> | <musician_name>] [--no-daemon] > lord douban search <keywords> > lord douban [hot | trending] >@@ -37,7 +37,7 @@ > > lord reddit listen <genre> [--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
main.hs view
@@ -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 "[<channel_id> | <musician>]")))- (progDesc "Provide cid/musician to listen to douban.fm"))- <> command "search" +doubanOptions = DoubanFM <$> subparser+ ( command "listen"+ (info (helper <*> (DoubanListen <$> argument str (+ metavar "[<channel_id> | <album_url> | <muscian_url> | <musician_name>]")))+ (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 "[<mix_id> | <mix_url>]")))+ (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
test/main.hs view
@@ -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