diff --git a/Radio.hs b/Radio.hs --- a/Radio.hs +++ b/Radio.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} @@ -5,6 +6,7 @@ module Radio ( SongMeta(..) , Radio(..) + , NeedLogin(..) , getLordDir , getPidFile , getLogFile @@ -14,16 +16,24 @@ import Codec.Binary.UTF8.String (encodeString) import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar -import Control.Monad (when) -import Data.Aeson (FromJSON, Value) +import qualified Control.Exception as E +import Control.Monad (liftM, when, void) +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C +import Data.Conduit (runResourceT, ($$+-)) +import Data.Conduit.Binary (sinkFile) +import Data.Yaml +import Network.HTTP.Conduit hiding (path) import Network.MPD hiding (play, Value) import qualified Network.MPD as MPD -import System.Directory (getHomeDirectory) +import System.Directory (doesFileExist, getHomeDirectory) +import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Log.FastLogger +eof :: MVar () eof = unsafePerformIO newEmptyMVar data SongMeta = SongMeta @@ -45,38 +55,162 @@ 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 + + report :: Param a -> a -> IO () + report _ _ = return () + + reportLoop :: Param a -> a -> IO () + reportLoop param x = do + time <- liftM stTime <$> withMPD status + case time of + Right (elapsed, _) -> + 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 logger reqData [] = getPlaylist reqData >>= play logger reqData - play logger reqData (x:xs) = do + play logger reqData (x:xs) + | playable x = do surl <- songUrl reqData x print surl when (surl /= "") $ do let song = artist (songMeta x) ++ " - " ++ title (songMeta x) writeLog logger song getStateFile >>= flip writeFile song + -- Report song played if needed + when (reportRequired x) $ void (forkIO $ reportLoop reqData x) mpdLoad $ Path $ C.pack surl takeMVar eof -- Finished play logger reqData xs + | otherwise = do + surl <- songUrl reqData x + print surl + req <- parseUrl surl + home <- getLordDir + manager <- newManager def + forkIO $ E.catch + (do + let song = artist (songMeta x) ++ " - " ++ title (songMeta x) + writeLog logger song + getStateFile >>= flip writeFile song + -- Report song played if needed + when (reportRequired x) $ void (forkIO $ reportLoop reqData x) -mpdLoad :: Path -> IO () -mpdLoad path = do - withMPD $ do - clear - add path - withMPD $ MPD.play Nothing - mpdPlay + runResourceT $ do + res <- http req manager + responseBody res $$+- sinkFile (home ++ "/lord.m4a") + -- This will block until eof. -mpdPlay :: IO () -mpdPlay = do - withMPD $ idle [PlayerS] - -- This will block until paused/finished. + putMVar eof ()) + (\e -> do + print (e :: E.SomeException) + writeLog logger $ show e + play logger reqData xs + ) + threadDelay (3*1000000) + mpdLoad m4a + play logger reqData xs + where + m4a = "lord/lord.m4a" - st <- withMPD status - let st' = fmap stState st - print st' - if st' == Right Stopped - then putMVar eof () - else mpdPlay + mpdLoad :: Path -> IO () + mpdLoad path + | playable x = do + withMPD $ do + clear + add path + withMPD $ MPD.play Nothing + mpdPlay + | otherwise = do + s <- withMPD $ do + clear + update [Path "lord"] + add path + case s of + Right _ -> do + withMPD $ MPD.play Nothing + mpdPlay + _ -> mpdLoad path + + mpdState :: IO (MPD.Response State) + mpdState = do + withMPD $ idle [PlayerS] + -- This will block until paused/finished. + + st <- liftM stState <$> withMPD status + print st + return st + + mpdPlay :: IO () + mpdPlay + | playable x = do + st <- mpdState + if st == Right Stopped + then putMVar eof () + else mpdPlay + | otherwise = 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 + +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 + putStrLn "Please Log in" + putStr "Email: " + email <- getLine + putStr "Password: " + hSetEcho stdin False + pwd <- getLine + hSetEcho stdin True + putStrLn "" + mtoken <- createSession keywords email pwd + case mtoken of + Just tok -> do + saveToken tok + return tok + Nothing -> do + putStrLn "ERROR: Invalid email or password!" + login keywords + + createSession :: String -> String -> String -> IO (Maybe (Param a)) + + data Config a :: * + + mkConfig :: Param a -> Config a + + saveToken :: Param a -> IO () + saveToken tok = do + home <- getLordDir + let yml = home ++ "/lord.yml" + exist <- doesFileExist yml + bs <- if exist + then B.readFile yml + else return "" + let config = mkConfig tok + B.writeFile yml $ B.append bs (encode config) + putStrLn $ "Your token has been saved to " ++ yml + + readToken :: String -> IO (Maybe (Param a)) getLordDir :: IO FilePath getLordDir = (++ "/.lord") <$> getHomeDirectory diff --git a/Radio/Douban.hs b/Radio/Douban.hs --- a/Radio/Douban.hs +++ b/Radio/Douban.hs @@ -61,8 +61,8 @@ getPlaylist' :: Query -> IO [Douban] getPlaylist' query = do - let url = "http://douban.fm/j/mine/playlist" - initReq <- parseUrl url + let rurl = "http://douban.fm/j/mine/playlist" + initReq <- parseUrl rurl let req = initReq { method = "GET" , queryString = renderQuery False query } @@ -71,10 +71,10 @@ liftM Radio.parsePlaylist (responseBody res $$+- sinkParser json) musicianID :: String -> IO (Maybe String) -musicianID name = do - let url = "http://music.douban.com/search/" ++ - (C.unpack $ urlEncode True (C.pack $ encodeString name)) - rsp <- simpleHttp url +musicianID mname = do + let rurl = "http://music.douban.com/search/" ++ + (C.unpack $ urlEncode True (C.pack $ encodeString mname)) + rsp <- simpleHttp rurl let cursor = fromDocument $ parseLBS rsp href = cursor $// element "a" >=> attributeIs "class" "ll musician_title " @@ -98,8 +98,8 @@ , ("from", Just "lord") ] getPlaylist' query - getPlaylist (Musician name) = do - mId <- musicianID name + 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)) @@ -113,7 +113,7 @@ -- Songs from douban.fm comes with no tags! tagged _ = False - + data Channel = Channel { intro :: String , name :: String @@ -155,31 +155,31 @@ -- | Return a list of hot channels. hot :: IO [Channel] -hot = search' url +hot = search' rurl where - url = "http://douban.fm/j/explore/hot_channels" + rurl = "http://douban.fm/j/explore/hot_channels" -- | Return a list of up trending channels. trending :: IO [Channel] -trending = search' url +trending = search' rurl where - url = "http://douban.fm/j/explore/up_trending_channels" + rurl = "http://douban.fm/j/explore/up_trending_channels" -- | Return a list of channels matching provided keywords. search :: String -> IO [Channel] search [] = return [] -search key = search' url +search key = search' rurl where - url = "http://douban.fm/j/explore/search?query=" ++ + rurl = "http://douban.fm/j/explore/search?query=" ++ -- encodeString: encode chinese characters (C.unpack $ urlEncode True (C.pack $ encodeString key)) search' :: String -> IO [Channel] -search' url = do - req <- parseUrl url +search' rurl = do + req <- parseUrl rurl (Object hm) <- withManager $ \manager -> do res <- http req manager responseBody res $$+- sinkParser json diff --git a/Radio/EightTracks.hs b/Radio/EightTracks.hs new file mode 100644 --- /dev/null +++ b/Radio/EightTracks.hs @@ -0,0 +1,232 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Module of http://8tracks.com +-- API documentation: http://8tracks.com/developers/api_v3 +module Radio.EightTracks where + +import qualified Control.Exception as E +import Control.Monad (forM_, liftM) +import Control.Concurrent.MVar +import Data.Aeson +import Data.Aeson.Types (defaultOptions, Options(..)) +import qualified Data.ByteString.Char8 as C +import Data.Maybe (fromJust) +import Data.Yaml hiding (decode) +import Data.CaseInsensitive (mk) +import Data.Conduit (($$+-)) +import Data.Conduit.Attoparsec (sinkParser) +import GHC.Generics (Generic) +import Network.HTTP.Types +import Network.HTTP.Conduit +import Prelude hiding (id) +import System.Console.ANSI +import System.Directory (doesFileExist) +import System.IO.Unsafe (unsafePerformIO) + +import Radio +import qualified Radio.EightTracks.Explore as Exp +import qualified Radio.EightTracks.User as U + + +running :: MVar () +running = unsafePerformIO newEmptyMVar + +apiKey :: String +apiKey = "1de30eb2b8fe85b1740cfbee3fdbb928e2c7249b" + +verHdr, keyHdr :: Header +verHdr = (mk "X-Api-Version", "3") +keyHdr = (mk "X-Api-Key", C.pack apiKey) + +type Param a = Radio.Param EightTracks + +data PlaySession = PlaySession + { play_token :: String + , status :: String + , errors :: Maybe String + , notices :: Maybe String + , api_version :: Int + } deriving (Show, Generic) + +data EightTracks = EightTracks + { id :: Int + , track_file_stream_url :: String + , name :: String + , performer :: String + , release_name :: String + , url :: String + } deriving (Show, Generic) + +data MixSet = MixSet + { at_beginning :: Bool + , at_last_track :: Bool + , at_end :: Bool + , skip_allowed :: Bool + , track :: EightTracks + } deriving (Show, Generic) + +data MixResponse = MixResponse + { mix_set :: MixSet + , mix_status :: String + } deriving (Show, Generic) + +instance FromJSON PlaySession +instance FromJSON EightTracks +instance FromJSON MixSet + +instance FromJSON MixResponse where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 4 } + +instance Radio.Radio EightTracks where + data Param EightTracks = Token + { userToken :: String + , userName :: String + , playToken :: Int + , mixId :: Int + } deriving (Show, Generic) + + parsePlaylist val = + case fromJSON val of + Success s -> [track $ mix_set s] + Error err -> error $ "Parse playlist failed: " ++ show err + + -- Request play.json will record current mix to listening history. + -- Request next.json won't. + getPlaylist tok = E.catch + (do + justStarted <- isEmptyMVar running + rurl <- if justStarted + then do + putMVar running () + return $ "http://8tracks.com/sets/" ++ (show $ playToken tok) ++ "/play.json" + else + return $ "http://8tracks.com/sets/" ++ (show $ playToken tok) ++ "/next.json" + getPlaylist' rurl) + (\e -> do + -- When reached the last track in this mix. Play it again + print (e :: E.SomeException) + let rurl = "http://8tracks.com/sets/" ++ (show $ playToken tok) ++ "/play.json" + getPlaylist' rurl) + where + usrHdr = (mk "X-User-Token", C.pack $ userToken tok) + + getPlaylist' rurl = do + let query = [ ("mix_id", C.pack $ show $ mixId tok) ] + + initReq <- parseUrl rurl + let req = initReq { requestHeaders = [verHdr, keyHdr, usrHdr] + , queryString = renderSimpleQuery False query } + withManager $ \manager -> do + res <- http req manager + liftM Radio.parsePlaylist (responseBody res $$+- sinkParser json) + + songUrl _ x = return $ track_file_stream_url x + + songMeta x = Radio.SongMeta (performer x) (release_name x) (name x) + + tagged _ = False + + playable _ = False + + reportRequired _ = True + + -- From api-doc: In order to be legal and pay royalties properly, + -- at 30 seconds, report song played + report tok x = do + initReq <- parseUrl rurl + let usrHdr = (mk "X-User-Token", C.pack $ userToken tok) + req = initReq { requestHeaders = [verHdr, keyHdr, usrHdr] + , queryString = renderSimpleQuery False query } + res <- withManager $ \manager -> httpLbs req manager + print $ responseBody res + where + rurl = "http://8tracks.com/sets/" ++ (show $ playToken tok) ++ "/report.json" + query = [ ("track_id", C.pack $ show $ id x) + , ("mix_id", C.pack $ show $ mixId tok) ] + +instance FromJSON (Radio.Param EightTracks) +instance ToJSON (Radio.Param EightTracks) + +instance NeedLogin EightTracks where + createSession strMixId email pwd = do + initReq <- parseUrl rurl + let req = initReq { method = "POST" + , queryString = renderSimpleQuery False query + , requestHeaders = [verHdr] } + res <- withManager $ \manager -> httpLbs req manager + case eitherDecode $ responseBody res of + Right r -> do + pTok <- newPlayToken + return $ Just $ Token (U.user_token $ U.user r) + (U.login $ U.user r) pTok mId + Left err -> print err >> return Nothing + where + rurl = "http://8tracks.com/sessions.json" + query = [ ("login", C.pack email), ("password", C.pack pwd) ] + mId = read strMixId :: Int + + data Config EightTracks = Config { eight :: Radio.Param EightTracks } deriving Generic + + mkConfig tok = Config tok + + readToken mid = do + home <- Radio.getLordDir + let yml = home ++ "/lord.yml" + exist <- doesFileExist yml + if exist + then do + conf <- decodeFile yml + case conf of + Nothing -> error $ "Invalid YAML file: " ++ show conf + Just c -> + case fromJSON c of + Success tok -> return $ Just $ (eight tok) { mixId = read mid } + Error err -> do + print $ "Parse token failed: " ++ show err + return Nothing + else return Nothing + +instance FromJSON (Radio.Config EightTracks) +instance ToJSON (Radio.Config EightTracks) + +newPlayToken :: IO Int +newPlayToken = do + res <- simpleHttp rurl + let ses = fromJust (decode res :: Maybe PlaySession) + return $ read $ play_token ses + where + rurl = "http://8tracks.com/sets/new.json?api_version=3&api_key=" ++ apiKey + +search :: String -> IO [Exp.Mix] +search [] = return [] +search key = search' rurl + where + rurl = "http://8tracks.com/mix_sets/keyword:" ++ key ++ ".json?include=mixes" + +search' :: String -> IO [Exp.Mix] +search' rurl = do + initReq <- parseUrl rurl + let req = initReq { requestHeaders = [verHdr, keyHdr] } + val <- withManager $ \manager -> do + res <- http req manager + responseBody res $$+- sinkParser json + + case fromJSON val of + Success v -> return $ Exp.mixes $ Exp.mix_set v + Error err -> putStrLn err >> return [] + +pprMixes :: [Exp.Mix] -> IO () +pprMixes mixes = + forM_ mixes (\m -> do + setSGR [SetConsoleIntensity BoldIntensity] + putStr $ "* " ++ Exp.name m + setSGR [SetColor Foreground Vivid Green] + putStrLn $ " id=" ++ show (Exp.id m) + setSGR [Reset] + putStrLn $ " Description: " ++ Exp.description m + putStrLn $ " Tags: " ++ Exp.tag_list_cache m + putStrLn "" + ) diff --git a/Radio/EightTracks/Explore.hs b/Radio/EightTracks/Explore.hs new file mode 100644 --- /dev/null +++ b/Radio/EightTracks/Explore.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Radio.EightTracks.Explore where +import Data.Aeson (FromJSON) +import GHC.Generics (Generic) + +data Mix = Mix + { id :: Int + , path :: String + , web_path :: String + , name :: String + , description :: String + , tag_list_cache :: String + } deriving (Show, Generic) + +instance FromJSON Mix + +data MixSet = MixSet + { mixes :: [Mix] + , smart_id :: String + , smart_type:: String + } deriving (Show, Generic) + +instance FromJSON MixSet + +data MixExplore = MixExplore + { mix_set :: MixSet + , status :: String + } deriving (Show, Generic) + +instance FromJSON MixExplore + diff --git a/Radio/EightTracks/User.hs b/Radio/EightTracks/User.hs new file mode 100644 --- /dev/null +++ b/Radio/EightTracks/User.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Radio.EightTracks.User where +import Data.Aeson (FromJSON) +import GHC.Generics (Generic) + +data User = User + { user_token:: String + , id :: Int + , login :: String + , web_path :: String + } deriving (Show, Generic) +instance FromJSON User + +data Session = Session + { user :: User + , status :: String + , errors :: Maybe String + , notices :: String + , logged_in :: Bool + , api_version :: Int + } deriving (Show, Generic) + +instance FromJSON Session + diff --git a/Radio/Jing.hs b/Radio/Jing.hs --- a/Radio/Jing.hs +++ b/Radio/Jing.hs @@ -9,8 +9,6 @@ import Codec.Binary.UTF8.String (encodeString) import Control.Applicative ((<$>), (<*>)) -import Control.Concurrent (forkIO, threadDelay) -import Control.Concurrent.MVar import qualified Control.Exception as E import Control.Monad (liftM, mzero) import Data.Aeson @@ -22,23 +20,16 @@ import Data.Yaml import Data.CaseInsensitive (mk) import Data.Conduit (runResourceT, ($$+-)) -import Data.Conduit.Binary (sinkFile) import Data.Conduit.Attoparsec (sinkParser) import GHC.Generics (Generic) import Network.HTTP.Types import Network.HTTP.Conduit -import Network.MPD hiding (play, Value, Query) -import qualified Network.MPD as MPD -import System.IO -import System.IO.Unsafe (unsafePerformIO) import System.Directory (doesFileExist) import Radio type Param a = Radio.Param Jing -downloaded = unsafePerformIO newEmptyMVar - data Jing = Jing { abid :: Int -- album id , aid :: Int -- artist id @@ -127,146 +118,61 @@ responseBody res $$+- sinkParser json let (String surl) = fromJust $ HM.lookup "result" hm return $ T.unpack surl) - (\e -> print (e :: E.SomeException) >> songUrl tok x) + (\e -> print (e :: E.SomeException) >> Radio.songUrl tok x) songMeta x = Radio.SongMeta (atn x) (an x) (n x) -- Songs from jing.fm comes with tags! tagged _ = True - - -- The media file jing.fm provides is of m4a type. - -- MPD is unable to stream m4a file, as a result, lord streams it to - -- ~/.lord/lord.m4a - play logger reqData [] = Radio.getPlaylist reqData >>= Radio.play logger reqData - play logger reqData (x:xs) = do - surl <- Radio.songUrl reqData x - print surl - req <- parseUrl surl - home <- Radio.getLordDir - manager <- newManager def - threadId <- forkIO $ E.catch - (do - let song = artist (songMeta x) ++ " - " ++ title (songMeta x) - getStateFile >>= flip writeFile song - - runResourceT $ do - res <- http req manager - responseBody res $$+- sinkFile (home ++ "/lord.m4a") - -- This will block until downloaded. - - writeLog logger song - putMVar downloaded ()) - (\e -> do - print (e :: E.SomeException) - Radio.writeLog logger $ show e - Radio.play logger reqData xs - ) - --mtid <- newMVar threadId - threadDelay 3000000 - mpdLoad - Radio.play logger reqData xs - -mpdLoad :: IO () -mpdLoad = do - --m4a <- (++ "/lord.m4a") <$> Radio.getLordDir - let m4a = "lord/lord.m4a" - s <- withMPD $ do - clear - update [Path "lord"] - add m4a - case s of - Right _ -> do - withMPD $ MPD.play Nothing - mpdPlay - _ -> mpdLoad - -mpdPlay :: IO () -mpdPlay = do - withMPD $ idle [PlayerS] - -- This will block until paused/finished. - - st <- withMPD status - let st' = fmap stState st - print st' - bd <- isEmptyMVar downloaded - if st' == Right Stopped - then if bd - then do -- Slow Network - withMPD $ MPD.play Nothing - mpdPlay - else do - withMPD clear - takeMVar downloaded -- Finished - else mpdPlay -- Pause + + playable _ = False instance FromJSON (Radio.Param Jing) instance ToJSON (Radio.Param Jing) -login :: String -> IO (Radio.Param Jing) -login keywords = do - hSetBuffering stdout NoBuffering - hSetEcho stdin True - putStrLn "Please Log in" - putStr "Email: " - email <- getLine - putStr "Password: " - hSetEcho stdin False - pwd <- getLine - hSetEcho stdin True - putStrLn "" - mtoken <- createSession keywords email pwd - case mtoken of - Just tok -> do - saveToken tok - return tok - Nothing -> do - putStrLn "ERROR: Invalid email or password!" - login keywords +instance NeedLogin Jing where + createSession keywords email pwd = do + let url = "http://jing.fm/api/v1/sessions/create" + query = [ ("email", C.pack email) , ("pwd", C.pack pwd) ] + req <- parseUrl url + let req' = urlEncodedBody query req + res <- withManager $ \manager -> http req' manager + let hmap = HM.fromList $ responseHeaders res + atoken = HM.lookup "Jing-A-Token-Header" hmap + rtoken = HM.lookup "Jing-R-Token-Header" hmap + parseToken :: Value -> Maybe (Radio.Param Jing) + parseToken (Object hm) = do + let user = HM.lookup "result" hm >>= + \(Object hm') -> HM.lookup "usr" hm' + case fromJSON $ fromMaybe Null user of + Success u -> Token <$> atoken + <*> rtoken + <*> (Just $ userid u) + <*> (Just $ usernick u) + <*> Just keywords + <*> Just True + Error err -> error $ "Retrieve token failed: " ++ show err + parseToken _ = error "Unrecognized token format." + liftM parseToken (runResourceT $ responseBody res $$+- sinkParser json) -createSession :: String -> String -> String -> IO (Maybe (Radio.Param Jing)) -createSession keywords email pwd = do - let url = "http://jing.fm/api/v1/sessions/create" - query = [ ("email", C.pack email) , ("pwd", C.pack pwd) ] - req <- parseUrl url - let req' = urlEncodedBody query req - res <- withManager $ \manager -> http req' manager - let hmap = HM.fromList $ responseHeaders res - atoken = HM.lookup "Jing-A-Token-Header" hmap - rtoken = HM.lookup "Jing-R-Token-Header" hmap - parseToken :: Value -> Maybe (Radio.Param Jing) - parseToken (Object hm) = do - let user = HM.lookup "result" hm >>= - \(Object hm') -> HM.lookup "usr" hm' - case fromJSON $ fromMaybe Null user of - Success u -> Token <$> atoken - <*> rtoken - <*> (Just $ userid u) - <*> (Just $ usernick u) - <*> Just keywords - <*> Just True - Error err -> error $ "Retrieve token failed: " ++ show err - parseToken _ = error "Unrecognized token format." - liftM parseToken (runResourceT $ responseBody res $$+- sinkParser json) + data Config Jing = Config { jing :: Radio.Param Jing } deriving Generic -saveToken :: Radio.Param Jing -> IO () -saveToken tok = do - home <- Radio.getLordDir - let yml = home ++ "/lord.yml" - encodeFile yml tok - putStrLn "Your token has been saved to ~/lord.yml" + mkConfig tok = Config tok -readToken :: String -> IO (Maybe (Radio.Param Jing)) -readToken keywords = do - home <- Radio.getLordDir - let yml = home ++ "/lord.yml" - exist <- doesFileExist yml - if exist - then do - conf <- decodeFile yml - case conf of - Nothing -> error $ "Invalid YAML file: " ++ show conf - Just c -> - case fromJSON c of - Success tok -> return $ Just $ tok { cmbt = keywords } - Error err -> error $ "Parse token failed: " ++ show err - else return Nothing + readToken keywords = do + home <- Radio.getLordDir + let yml = home ++ "/lord.yml" + exist <- doesFileExist yml + if exist + then do + conf <- decodeFile yml + case conf of + Nothing -> error $ "Invalid YAML file: " ++ show conf + Just c -> + case fromJSON c of + Success tok -> return $ Just $ (jing tok) { cmbt = keywords } + Error err -> error $ "Parse token failed: " ++ show err + else return Nothing + +instance FromJSON (Radio.Config Jing) +instance ToJSON (Radio.Config Jing) diff --git a/lord.cabal b/lord.cabal --- a/lord.cabal +++ b/lord.cabal @@ -1,21 +1,50 @@ name: lord -version: 1.20131124 +version: 1.20131130 synopsis: A command line interface to online radios. description: - A unified interface to online radio service providers, use mpd as backend. + A unified interface to several online radio service providers, use @mpd@ () as backend. . Supported radios: - - - - + . + * + . + * + . + * + . + * + . + * + . + Commands: + . + > lord -h + > lord status + > lord kill + > + > lord 8tracks listen [--no-daemon] + > lord 8tracks search + > + > lord cmd listen [--no-daemon] + > lord cmd genres + > + > lord douban listen [ | ] [--no-daemon] + > lord douban search + > lord douban hot + > lord douban trending + > + > lord jing listen [--no-daemon] + > + > lord reddit listen [--no-daemon] + > lord reddit genres + homepage: https://github.com/rnons/lord bug-reports: https://github.com/rnons/lord/issues license: PublicDomain license-file: LICENSE author: rnons maintainer: remotenonsense@gmail.com -category: Web +category: Web, Music build-type: Simple cabal-version: >=1.10 tested-with: GHC == 7.6.3 @@ -30,6 +59,9 @@ other-modules: Radio, Radio.Cmd, Radio.Douban, + Radio.EightTracks, + Radio.EightTracks.Explore, + Radio.EightTracks.User, Radio.Jing, Radio.Reddit ghc-options: -Wall -fno-warn-unused-do-bind diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -20,6 +20,7 @@ import Radio import qualified Radio.Cmd as Cmd import Radio.Douban +import qualified Radio.EightTracks as ET import Radio.Jing import qualified Radio.Reddit as Reddit @@ -30,6 +31,7 @@ data Command = CmdFM CmdSubCommand | DoubanFM DoubanSubCommand + | EightTracks ETSubCommand | JingFM JingSubCommand | RedditFM RedditSubCommand | Status @@ -46,6 +48,10 @@ | DoubanSearch String deriving (Eq, Show) +data ETSubCommand = ETListen String + | ETSearch String + deriving (Eq, Show) + data JingSubCommand = JingListen String deriving (Eq, Show) @@ -61,6 +67,8 @@ (progDesc "cmd.fm commander")) <> command "douban" (info (helper <*> doubanOptions) (progDesc "douban.fm commander")) + <> command "8tracks" (info (helper <*> etOptions) + (progDesc "8tracks.com commander")) <> command "jing" (info (helper <*> jingOptions) (progDesc "jing.fm commander")) <> command "reddit" (info (helper <*> redditOptions) @@ -88,6 +96,10 @@ DoubanHot -> doubanHot DoubanTrending -> doubanTrending DoubanSearch key -> doubanSearch key + EightTracks subCommand -> + case subCommand of + ETListen mId -> etListen nodaemon mId + ETSearch key -> etSearch key JingFM (JingListen key) -> jingListen nodaemon key RedditFM subCommand -> case subCommand of @@ -142,6 +154,16 @@ (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")) + <> command "search" + (info (helper <*> (ETSearch <$> argument str (metavar "KEYWORDS"))) + (progDesc "search mixes")) + ) + jingOptions :: Parser Command jingOptions = JingFM <$> subparser ( command "listen" @@ -174,6 +196,20 @@ where isChId = and . fmap isDigit +etListen :: Bool -> Keywords -> IO () +etListen nodaemon k = do + tok <- readToken k + case tok of + Just tok' -> do + putStrLn $ "Welcome back, " ++ ET.userName tok' + listen nodaemon tok' + _ -> do + param <- login k :: IO (Radio.Param ET.EightTracks) + listen nodaemon param + +etSearch :: String -> IO () +etSearch key = ET.search key >>= ET.pprMixes + jingListen :: Bool -> Keywords -> IO () jingListen nodaemon k = do tok <- readToken k @@ -181,7 +217,9 @@ Just tok' -> do putStrLn $ "Welcome back, " ++ C.unpack (nick tok') listen nodaemon tok' - _ -> login k >>= listen nodaemon + _ -> do + param <- login k :: IO (Radio.Param Jing) + listen nodaemon param listen :: Radio a => Bool -> Radio.Param a -> IO () listen nodaemon param = do diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -5,8 +5,9 @@ import Radio import qualified Radio.Cmd as Cmd -import Radio.Jing +import qualified Radio.EightTracks as ET import Radio.Douban +import Radio.Jing import qualified Radio.Reddit as Reddit @@ -29,8 +30,13 @@ ss <- Radio.getPlaylist (Musician "Sigur RóS") assert $ length ss > 0 - it "jing" $ do - tok <- readToken "postrock" + it "8tracks: given mix id" $ do + tok <- readToken "14" :: IO (Maybe (Radio.Param ET.EightTracks)) + ss <- Radio.getPlaylist $ fromJust tok + assert $ length ss > 0 + + it "jing: given keywords" $ do + tok <- readToken "postrock" :: IO (Maybe (Radio.Param Jing)) ss <- Radio.getPlaylist $ fromJust tok assert $ length ss > 0