diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,13 @@ CHANGELOG +2.20140324 -> 2.20140625 + - Update to optpare-applicative-0.8 + - Fix 8tracks.com api + - Fix douban search api and musician url parse + - Fix log encoding + - Can listen to douban programme + - Depends on conduit-extra and resourcet + 2.20140323 -> 2.20140324 - Update to optparse-applicative-0.8 - Slight fix to 8tracks.com api diff --git a/Web/Radio.hs b/Web/Radio.hs --- a/Web/Radio.hs +++ b/Web/Radio.hs @@ -14,7 +14,6 @@ , writeLog ) where -import Codec.Binary.UTF8.String (encodeString) import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar @@ -186,12 +185,10 @@ saveToken :: Param a -> IO () saveToken tok = do - home <- getLordDir - let yml = home ++ "/lord.yml" + yml <- getConfig exist <- doesFileExist yml - bs <- if exist - then B.readFile yml - else return "" + 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 @@ -201,11 +198,10 @@ readToken :: FromJSON (Config a) => (Config a -> Param a) -> String -> IO (Maybe (Param a)) readToken selector keywords = do - home <- getLordDir - let yml = home ++ "/lord.yml" + yml <- getConfig exist <- doesFileExist yml if exist - then do + then do conf <- decodeFile yml case conf of Nothing -> error $ "Invalid YAML file: " ++ show conf @@ -216,11 +212,14 @@ Error err -> do print $ "Parse token failed: " ++ show err return Nothing - else return Nothing + else return Nothing getLordDir :: IO FilePath getLordDir = (++ "/.lord") <$> getHomeDirectory +getConfig :: IO FilePath +getConfig = (++ "/lord.yml") <$> getLordDir + getPidFile :: IO FilePath getPidFile = (++ "/lord.pid") <$> getLordDir @@ -233,7 +232,7 @@ formatLogMessage :: IO ZonedDate -> String -> IO LogStr formatLogMessage getdate msg = do now <- getdate - return $ toLogStr now <> " : " <> toLogStr (encodeString msg) <> "\n" + return $ toLogStr now <> " : " <> toLogStr msg <> "\n" writeLog :: LoggerSet -> String -> IO () writeLog l msg = do diff --git a/Web/Radio/Douban.hs b/Web/Radio/Douban.hs --- a/Web/Radio/Douban.hs +++ b/Web/Radio/Douban.hs @@ -16,6 +16,7 @@ import Control.Monad import Data.Aeson import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy.Char8 as LC import Data.Char (isDigit) import Data.Conduit (($$+-)) import Data.Conduit.Attoparsec (sinkParser) @@ -23,7 +24,11 @@ import Data.List (isPrefixOf) import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as T +import Network.Browser (browse, request, setOutHandler) +import Network.HTTP (getRequest) +import Network.HTTP.Base (rspBody) import Network.HTTP.Conduit +--import Network.HTTP.Conduit.Browser (browse, makeRequestLbs) import Network.HTTP.Types (urlEncode, renderQuery, Query) import Prelude hiding (id) import System.Console.ANSI @@ -112,6 +117,7 @@ | Album Int | MusicianId Int | MusicianName String + | Programme Int -- TODO: those without ssid filed are ads, filter them out! parsePlaylist (Object hm) = do @@ -132,6 +138,8 @@ getPlaylist (MusicianName mname) = do mmid <- musicianId mname Radio.getPlaylist (MusicianId $ read $ fromJust mmid) + getPlaylist (Programme pid) = + getPlaylist' $ mkQuery 0 $ "channel:0|programme_id:" ++ show pid songUrl _ x = return $ url x @@ -203,14 +211,15 @@ C.unpack (urlEncode True (C.pack $ encodeString key)) +-- As http-conduit-browser can't build with http-conduit-2.0, add +-- additional dependency on HTTP package. search' :: String -> IO [Channel] search' rurl = do - req <- parseUrl rurl - (Object hm) <- withManager $ \manager -> do - res <- http req manager - responseBody res $$+- sinkParser json - - let (Object hm') = fromJust $ HM.lookup "data" hm + (_, rsp) <- browse $ do + setOutHandler $ const (return ()) + request $ getRequest rurl + let (Object hm) = fromJust $ decode $ LC.pack $ rspBody rsp + (Object hm') = fromJust $ HM.lookup "data" hm resData = fromJust $ HM.lookup "channels" hm' channels = fromJSON resData :: Result [Channel] case channels of @@ -220,10 +229,15 @@ 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 + | aPattern `isPrefixOf` k = + Album $ read $ takeWhile isDigit $ drop (length aPattern) k + | mPattern `isPrefixOf` k = + MusicianId $ read $ takeWhile isDigit $ drop (length mPattern) k + | pPattern `isPrefixOf` k = + Programme $ read $ takeWhile isDigit $ drop (length pPattern) k | otherwise = MusicianName k where isChId = and . fmap isDigit aPattern = "http://music.douban.com/subject/" mPattern = "http://music.douban.com/musician/" + pPattern = "http://music.douban.com/programme/" diff --git a/Web/Radio/Jing.hs b/Web/Radio/Jing.hs --- a/Web/Radio/Jing.hs +++ b/Web/Radio/Jing.hs @@ -14,13 +14,14 @@ import Control.Applicative ((<$>), (<*>)) import qualified Control.Exception as E import Control.Monad (liftM, mzero) +import Control.Monad.Trans.Resource (runResourceT) import Data.Aeson import qualified Data.ByteString.Char8 as C import qualified Data.HashMap.Strict as HM import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as T import Data.CaseInsensitive (mk) -import Data.Conduit (runResourceT, ($$+-)) +import Data.Conduit (($$+-)) import Data.Conduit.Attoparsec (sinkParser) import GHC.Generics (Generic) import Network.HTTP.Types diff --git a/bash_completion.d/lord b/bash_completion.d/lord --- a/bash_completion.d/lord +++ b/bash_completion.d/lord @@ -7,7 +7,7 @@ CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg) done - COMPREPLY=( $(/home/rnons/.cabal/bin/lord "${CMDLINE[@]}") ) + COMPREPLY=( $(~/.cabal/bin/lord "${CMDLINE[@]}") ) } complete -o filenames -F _lord lord diff --git a/lord.cabal b/lord.cabal --- a/lord.cabal +++ b/lord.cabal @@ -1,5 +1,5 @@ name: lord -version: 2.20140324 +version: 2.20140625 synopsis: A command line interface to online radios. description: A unified command line interface to several online radios, use mpd () as backend by default. Will fallback to mplayer () when mpd is unavailable. @@ -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] > @@ -47,7 +47,7 @@ category: Web, Music build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 7.6.3 +tested-with: GHC == 7.8.2 data-files: bash_completion.d/lord extra-source-files: CHANGELOG @@ -63,14 +63,17 @@ bytestring >= 0.9, case-insensitive >= 1.0, conduit >= 1.0, + conduit-extra >= 1.1, data-default >= 0.5, directory >= 1.1, fast-logger >= 2.0, html-conduit >= 1.1, + HTTP >= 4000.2, http-conduit >= 1.9, http-types >= 0.8, libmpd >= 0.8, process >= 1.1, + resourcet >= 1.1, text >= 0.11, transformers >= 0.3, unix >= 2.5, @@ -100,16 +103,19 @@ bytestring >= 0.9, case-insensitive >= 1.0, conduit >= 1.0, + conduit-extra >= 1.1, daemons >= 0.1.2, data-default >= 0.5, directory >= 1.1, fast-logger >= 2.0, html-conduit >= 1.1, + HTTP >= 4000.2, http-conduit >= 1.9, http-types >= 0.8, libmpd >= 0.8, optparse-applicative >= 0.8, process >= 1.1, + resourcet >= 1.1, text >= 0.11, transformers >= 0.3, unix >= 2.5, @@ -138,6 +144,7 @@ fast-logger >= 2.0, hspec >= 1.6, html-conduit >= 1.1, + HTTP >= 4000.2, http-conduit >= 1.9, http-types >= 0.8, HUnit >= 1.2, diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -7,8 +7,7 @@ import System.Environment (getArgs, getProgName) import System.Exit (exitWith, exitSuccess, ExitCode(..)) import System.IO (hPutStrLn, stderr, SeekMode(..)) -import System.Log.FastLogger ( newFileLoggerSet, newStdoutLoggerSet - , defaultBufSize ) +import System.Log.FastLogger ( newFileLoggerSet, newStdoutLoggerSet ) import System.Posix.Daemon import System.Posix.Files (stdFileMode) import System.Posix.IO ( fdWrite, createFile, setLock @@ -145,7 +144,7 @@ progn <- getProgName msg <- execCompletion compl progn putStr msg - exitWith ExitSuccess + exitSuccess cmdOptions :: Parser Command cmdOptions = CmdFM <$> subparser @@ -160,8 +159,8 @@ 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")) + metavar "[ | | | | ]"))) + (progDesc "Provide channel_id/album_url/musician_url/musician_name/programme_url to listen to douban.fm")) <> command "search" (info (helper <*> (DoubanSearch <$> argument str (metavar "KEYWORDS"))) (progDesc "Search channels")) @@ -245,10 +244,8 @@ return True pid <- getPidFile - logger <- if nodaemon' then newStdoutLoggerSet defaultBufSize - else do - fp <- getLogFile - newFileLoggerSet defaultBufSize fp + logger <- if nodaemon' then newStdoutLoggerSet 0 + else getLogFile >>= newFileLoggerSet 0 let listen' = play logger param [] running <- isRunning pid when running $ killAndWait pid diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -36,6 +36,10 @@ ss <- getPlaylist $ douban "Sigur Rós" assert $ artist (head ss) == "Sigur Rós" + it "douban: given programme url" $ do + ss <- getPlaylist $ douban "http://music.douban.com/programme/284459" + assertNotNull ss + it "8tracks: given mix id" $ do tok <- readToken eight "14" ss <- getPlaylist $ fromJust tok