lord-1.20131124: Radio/Jing.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-- | Module of http://jing.fm
-- It's a bit tricky to play jing.fm
-- Notice the `play` function of **instance Radio**
module Radio.Jing where
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
import Data.ByteString (ByteString)
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.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
, an :: String -- album name
, atn :: String -- artist name
, d :: String
, fid :: String
, fs :: Int -- file size
, mid :: ByteString
, n :: String -- song name
, tid :: Int
--, y :: Bool
} deriving (Show, Generic)
instance FromJSON Jing
data Usr = Usr
{ userid :: Int
, usernick :: ByteString
} deriving Show
instance FromJSON Usr where
parseJSON (Object v) = Usr <$>
v .: "id" <*>
v .: "nick"
parseJSON _ = mzero
instance Radio.Radio Jing where
data Param Jing = Token
{ aToken :: ByteString
, rToken :: ByteString
, uid :: Int
, nick :: ByteString
, cmbt :: String
, highquality :: Bool
} deriving (Show, Generic)
parsePlaylist (Object hm) = do
let songs = HM.lookup "result" hm >>=
\(Object hm') -> HM.lookup "items" hm'
case fromJSON $ fromMaybe Null songs of
Success s -> s
Error err -> error $ "Parse playlist failed: " ++ show err
parsePlaylist _ = error "Unrecognized playlist format."
getPlaylist tok = do
let url = "http://jing.fm/api/v1/search/jing/fetch_pls"
query = [ ("q", C.pack $ encodeString $ cmbt tok)
, ("ps", "10")
, ("st", "0")
, ("u", C.pack $ show $ uid tok)
, ("tid", "0")
, ("mt", "")
, ("ss", "true")
]
aHdr = (mk "Jing-A-Token-Header", aToken tok) :: Header
rHdr = (mk "Jing-R-Token-Header", rToken tok) :: Header
initReq <- parseUrl url
let req = initReq { requestHeaders = [aHdr, rHdr] }
-- urlEncodeBody adds a content-type request header and
-- changes the method to POST.
let req' = urlEncodedBody query req
withManager $ \manager -> do
res <- http req' manager
liftM Radio.parsePlaylist (responseBody res $$+- sinkParser json)
songUrl tok x = E.catch
(do
let url = "http://jing.fm/api/v1/media/song/surl"
type_ = if highquality tok then "NO" else "MM"
query = [ ("type", Just type_)
, ("mid", Just $ mid x)
] :: Query
aHdr = (mk "Jing-A-Token-Header", aToken tok) :: Header
rHdr = (mk "Jing-R-Token-Header", rToken tok) :: Header
initReq <- parseUrl url
let req = initReq { method = "POST"
, requestHeaders = [aHdr, rHdr]
, queryString = renderQuery False query
}
(Object hm) <- withManager $ \manager -> do
res <- http req manager
responseBody res $$+- sinkParser json
let (String surl) = fromJust $ HM.lookup "result" hm
return $ T.unpack surl)
(\e -> print (e :: E.SomeException) >> 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
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
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)
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"
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