Downloads DI.fm playlists in pls format, optionally taking your listen key to download premium 256K mp3 lists.

difm.hs

{-# LANGUAGE TemplateHaskell #-}

import Data.Aeson (decode)
import Data.Aeson.TH (deriveFromJSON)
import Data.ByteString.Char8 (pack,unpack) 
import Network.HTTP.Types (renderQuery)
import Data.Conduit.Binary (sinkFile)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Conduit as C
import qualified Data.ByteString.Lazy as LBS
import System.Environment (getArgs,getProgName)
import System.Exit (exitWith,ExitCode(ExitSuccess))
import System.IO (stderr,hPutStrLn)
import Network.HTTP.Conduit (parseUrl,queryString,httpLbs,http)
import Network.HTTP.Conduit (
  host
  , Request
  , Response(Response)
  , withManager
  , responseBody
  )
import System.Console.GetOpt (
  getOpt
  , usageInfo
  , ArgOrder(Permute)
  , OptDescr(Option)
  , ArgDescr(ReqArg,NoArg)
  )
  
--------------------------------------------------------------------------------
-- Synopsis
--------------------------------------------------------------------------------
-- Idea of this script is to download every playlist from DI.fm to the current  
-- directory. It does this by:
-- 1) Hitting http://listen.di.fm/public3 to get the list of playlists in JSON
-- 2) For every playlist, download playlist to CWD from either:
--  * the public url in the JSON response ( if no listen key option given )
--  * the 256K premium link at listen.di.fm/premium_high/<name>.pls?<listen_key>
--
-- Listen keys are only available to premium di.fm members. See this page if 
-- you are a member to figure out what your key is: 
-- http://www.di.fm/member/listen_key
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- To get this working:
--------------------------------------------------------------------------------
-- 1) Install the haskell platform: http://hackage.haskell.org/platform/
-- 2) cabal install http-conduit aeson
-- 3) "runhaskell difm.hs" or "runhaskell -k <key>"
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Datatypes for representing the playlist list from /public3
--------------------------------------------------------------------------------

data Playlists = Playlists [ Playlist ] deriving Show
data Playlist  = Playlist {
  id            :: Integer
  , key         :: String
  , name        :: String
  , description :: String
  , playlist    :: String
  } deriving Show
                 
$(deriveFromJSON Prelude.id ''Playlist)             
$(deriveFromJSON Prelude.id ''Playlists)             
             
--------------------------------------------------------------------------------
-- Retreiving / decoding JSON from /public3 resource
--------------------------------------------------------------------------------

getPlaylists manager opts = do 
  req  <- parseUrl $ ( baseURI opts ) ++  "/public3"
  res  <- httpLbs req manager
  return $ responseBody res

decodePlaylists json = case decode json of
  Just (Playlists l) -> l 
  Nothing            -> error "Could not parse JSON"

getDecodedPlaylists manager opts = 
  fmap decodePlaylists $ getPlaylists manager opts

--------------------------------------------------------------------------------
-- Retrieving a playlist and storing to the current folder
--------------------------------------------------------------------------------

playlistReq (Just pkey) base (Playlist _ key _ _ _ ) = 
  let uri   = concat [ base , "/premium_high/" , key , ".pls" ]
  in do
    initR <- parseUrl uri
    return initR { queryString = renderQuery False [(pack pkey,Nothing)] }

playlistReq Nothing _ (Playlist _ _ _ _ uri ) = parseUrl uri

downloadPL manager opts pl = do
  let file     = (key pl) ++ ".pls"
    in do 
    req <- playlistReq (listenKey opts) (baseURI opts) pl
    liftIO $ putStrLn $ "Downloading: " ++ file 
    res <- http req manager
    (responseBody res) C.$$+- sinkFile file

--------------------------------------------------------------------------------
-- Command line argument handling       
--------------------------------------------------------------------------------
  
data Options = Options {
  listenKey :: Maybe String
  , baseURI  :: String
  }
            
defaultOptions = Options { 
  listenKey = Nothing 
  , baseURI = "http://listen.di.fm" 
  }

options = [ 
  Option "k" ["listen_key"] 
  (ReqArg (\arg opt -> return opt { listenKey = Just arg }) "KEY")
  "Premium DI.fm key. See http://www.di.fm/member/listen_key"
  , Option "V"  ["version"] (NoArg exitVersion) "Print version" 
  , Option "h?" ["help"]    (NoArg exitHelpOpt) "Show help"      
  ]

exitVersion _ = do
  hPutStrLn stderr "Version 0.01"
  exitWith ExitSuccess
  
exitHelpOpt _ = do
  errMsg <- exitHelp []
  hPutStrLn stderr errMsg
  exitWith ExitSuccess

exitHelp errs = do 
  prg <- getProgName
  return $ unlines (
    errs ++ ["Usage: " ++ (usageInfo (prg ++ " [options]") options)]
    )

getOptions = do
  argv <- getArgs
  case getOpt Permute options argv of
    (actions,[],[]  ) -> foldl (>>=) (return defaultOptions) actions
    (_,_,errs)        -> (exitHelp errs) >>= error

--------------------------------------------------------------------------------
-- Main method         
--------------------------------------------------------------------------------

main :: IO ()
main = do
  opts      <- getOptions
  withManager (main' opts)
  where 
    main' opts manager = do 
      playlists <- getDecodedPlaylists manager opts
      mapM_ (downloadPL manager opts) playlists