lord 2.20140324 → 2.20140625
raw patch · 8 files changed
+63/−33 lines, 8 filesdep +HTTPdep +conduit-extradep +resourcet
Dependencies added: HTTP, conduit-extra, resourcet
Files
- CHANGELOG +8/−0
- Web/Radio.hs +10/−11
- Web/Radio/Douban.hs +22/−8
- Web/Radio/Jing.hs +2/−1
- bash_completion.d/lord +1/−1
- lord.cabal +10/−3
- main.hs +6/−9
- test/main.hs +4/−0
CHANGELOG view
@@ -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
Web/Radio.hs view
@@ -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
Web/Radio/Douban.hs view
@@ -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/"
Web/Radio/Jing.hs view
@@ -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
bash_completion.d/lord view
@@ -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
lord.cabal view
@@ -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 (<http://musicpd.org>) as backend by default. Will fallback to mplayer (<http://www.mplayerhq.hu>) when mpd is unavailable.@@ -29,7 +29,7 @@ > lord cmd listen <genre> [--no-daemon] > lord cmd genres >- > lord douban listen [<channel_id> | <album_url> | <musician_url> | <musician_name>] [--no-daemon]+ > lord douban listen [<channel_id> | <album_url> | <musician_url> | <musician_name> | <programme_url>] [--no-daemon] > lord douban search <keywords> > 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,
main.hs view
@@ -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 "[<channel_id> | <album_url> | <muscian_url> | <musician_name>]")))- (progDesc "Provide channel_id/album_url/musician_url/musician_name to listen to douban.fm"))+ metavar "[<channel_id> | <album_url> | <muscian_url> | <musician_name> | <programme_url>]")))+ (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
test/main.hs view
@@ -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