getemx (empty) → 0.1
raw patch · 9 files changed
+509/−0 lines, 9 filesdep +basedep +curldep +directorysetup-changed
Dependencies added: base, curl, directory, filepath, haskell98, hxt, mtl, old-locale, process, time
Files
- Emx/Dl.hs +66/−0
- Emx/Emx.hs +85/−0
- Emx/Options.hs +87/−0
- Emx/Track.hs +5/−0
- LICENSE +30/−0
- README.rst +89/−0
- Setup.hs +2/−0
- getemx.cabal +62/−0
- getemx.hs +83/−0
+ Emx/Dl.hs view
@@ -0,0 +1,66 @@+module Emx.Dl where++import System.FilePath+import System.Directory+import System.IO+import Control.Applicative+import System.Process (runProcess, waitForProcess)+import Text.Printf (printf)+import Control.Monad+import Network.Curl+import Network.Curl.Easy+import Network.Curl.Opts+import Data.Ratio+import Data.Char+import Data.List+import Data.IORef+++dl :: String -> String -> IO (String, String) -> IO ()+dl a epath remloc = do+ (rem, loc) <- remloc+ notexists <- not <$> doesFileExist loc+ when notexists $ runProcess epath [rem, a, loc] Nothing Nothing Nothing Nothing Nothing >>= waitForProcess >> return ()+dlcurl = dl "-o"+dlwget = dl "-O"++-- native download. How likely is it that curl(1) won't be available+-- but libcurl will be?+colheaders :: IORef Integer -> String -> IO ()+colheaders tot s = do+ (key, val) <- return $ parseHeader $ map toLower s+ when (key == "content-length") $ writeIORef tot $ read val++writebody sofar tot handle s = do+ clen <- readIORef tot+ modifyIORef sofar (+ genericLength s)+ sof <- readIORef sofar+ if clen /= 0+ then do+ if sof == clen + then putStrLn "\b\b\b100%"+ else putStr $ printf "\b\b\b%2.0f%%" (fromRational (100*sof%clen)::Float)+ hFlush stdout+ else when (sof == clen) $ putStrLn "... Done"+ hPutStr handle s+ return ()++dlnative :: IO (String, String) -> IO ()+dlnative remloc = do + (rem, loc) <- remloc+ tot <- newIORef (0::Integer)+ sofar <- newIORef (0::Integer)+ curl <- initialize+ h <- openFile loc WriteMode+ setopts curl [CurlHeaderFunction $ callbackWriter (colheaders tot),+ CurlWriteFunction $ callbackWriter (writebody sofar tot h),+ CurlURL rem,+ CurlFailOnError True]+ setDefaultSSLOpts curl rem+ putStrLn $ printf "Downloading %s ..." rem+ putStrLn $ printf "To %s" loc+ perform curl+ rspCode <- getResponseCode curl+ hFlush h+ hClose h+ return ()
+ Emx/Emx.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE Arrows, ScopedTypeVariables, NamedFieldPuns #-}++module Emx.Emx where+import Control.Applicative+import System.FilePath+import Data.List (isPrefixOf)+import Control.Monad.Error+import Text.XML.HXT.Core+import Emx.Track++atTag :: (ArrowXml a) => String -> a XmlTree XmlTree+atTag = deep . hasName +text :: (ArrowXml a) => a XmlTree String+text = getChildren >>> getText+opttagtext :: (ArrowXml a) => String -> a XmlTree String+opttagtext = (<<<) text . atTag++tagtext t = (opttagtext t >>> arr Right) `orElse` constA (Left $ "Bad XML: couldn't find tag "++t)++replace::(Eq a) => [a] -> [a] -> [a] -> [a]+replace [] newSub list = joins newSub list+replace oldSub newSub list = _replace list where+ _replace list@(h:ts) = if oldSub `isPrefixOf` list+ then newSub ++ _replace (drop len list)+ else h : _replace ts+ _replace [] = []+ len = length oldSub++joins::[a] -> [a] -> [a]+joins glue [h] = [h]+joins glue (h:ts) = h : glue ++ joins glue ts+joins _ [] = []++clean repu repapo = pthc . uc . apoc+ where+ pthc = replace [pathSeparator] "_"+ uc = if repu then replace "_" " " else id+ apoc = if repapo then replace "'" "'" else id++instance Applicative (Either a) where+ pure = Right+ (Right f) <*> (Right x) = Right $ f x+ (Left f) <*> _ = Left f+ _ <*> (Left x) = Left x++gettrack repu repapo = atTag "TRACK" >>>+ (proc t -> do+ ar <- c <<< tagtext "ARTIST" -< t+ al <- c <<< tagtext "ALBUM"-< t+ ti <- c <<< tagtext "TITLE"-< t+ ext <- tagtext "EXTENSION" -< t+ url <- tagtext "TRACKURL" -< t+ lbl <- c <<< tagtext "LABEL" -< t+ art <- tagtext "ALBUMART" -< t+ dc <- rtag "DISCCOUNT" -< t+ dn <- rtag "DISCNUM" -< t+ tc <- rtag "TRACKCOUNT" -< t+ gr <- tagtext "GENRE" -< t+ tn <- tr <<< rtag "TRACKNUM" -< t+ returnA -< Tr <$> ar <*> al <*> ti <*> ext <*> url <*> lbl <*> art <*> tn <*> gr <*> dc <*> dn <*> tc)+ where+ c = right $ arr $ clean repu repapo+ r t = arr $ \i -> do+ v <- i+ case reads v of+ [] -> throwError $ "Bad XML: couldn't parse int in tag "++t+ [(x::Int,_)] -> return x+ rtag t = tagtext t >>> r t+ tr = right $ arr (fill '0' 2 . show) -- bad assumption: < 100 tracks++fill fille until s = if length s < until then fill fille until (fille:s)+ else s++collect repu repapo = atTag "PACKAGE" >>> (tagtext "ACTION" &&& tagtext "EXP_DATE" &&& listA (gettrack repu repapo)) >>> arr f+ where+ f (action, (exp, tracks)) = (,,) <$> action <*> exp <*> (sequence tracks)++parseXML = readDocument [withValidate False]++readfile f repu repapo = do+ r <- liftIO $ runX (parseXML f >>> collect repu repapo)+ case r of + [] -> throwError $ "Couldn't parse emx file "++f++" at all!"+ [Right s] -> return s+ [Left e] -> throwError e
+ Emx/Options.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+module Emx.Options where+import System.IO +import System.FilePath+import System.Directory+import Control.Applicative+import Control.Monad.Error+import Emx.Track++data Subs = Txt String | IntSub (Track -> Int) | StrSub (Track -> String)++data Options = Opt {repu, repapo, get_art :: Bool, dldir :: String,+ dlfmt, dlfmt_m :: [Subs]}++lookupsub "a" = return $ StrSub artist+lookupsub "A" = return $ StrSub album+lookupsub "D" = return $ IntSub disccount+lookupsub "d" = return $ IntSub discnum+lookupsub "e" = return $ StrSub ext+lookupsub "t" = return $ StrSub title+lookupsub "l" = return $ StrSub label+lookupsub "g" = return $ StrSub genre+lookupsub "n" = return $ StrSub tracknum+lookupsub x = throwError $ "Unrecognized format option: \""++x++"\""++subfromstring s = go s []+ where+ go "" a = return $ reverse a+ go "%" a = throwError $ "Unescaped parenthesis at end of option string \""++s++"\""+ go ('%':'(':cs) a = do+ (kind, rest) <- return $ break (==')') cs+ when (null rest) $ throwError $ "Unclosed parenthesis in option string \""++s++"\""+ sub <- lookupsub kind+ go (tail rest) (sub:a)+ go ('%':'%':cs) as = + case as of+ Txt s:r -> go cs ((Txt $ s++"%"):r)+ _ -> go cs (Txt "%":as)+ go s as =+ case as of+ Txt s:r -> go rest ((Txt $ s++run):as)+ _ -> go rest (Txt run:as)+ where+ (run,rest) = break (=='%') s++(Right default_dlf) = subfromstring "%(a)/%(A)/%(a) - %(A) - %(n) - %(t)"+(Right default_dlfm) = subfromstring "%(a)/%(A): %(d)/%(a) - %(A): %(d) - %(n) - %(t)"++strip rem = reverse.snd.span (`elem` rem).reverse.snd.span (`elem` rem)+split s splite = (before, after)+ where+ (before,rest) = break (==splite) s+ (_,after) = span (==splite) rest+stripw = strip " \t\n"++optline o line = ps (stripw s) (stripw e)+ where+ (s,e) = split line '='+ ps ('#':rest) _ = return o+ ps s e = + case s of + "replace_underscores" -> bconv (\x -> o {repu = x}) s e+ "replace_apostrophe_identity" -> bconv (\x -> o {repapo = x}) s e+ "get_art" -> bconv (\x -> o {get_art = x}) s e+ "dlfmt" -> sconv (\x -> o {dlfmt = x}) s e+ "dlfmt_multidisc" -> sconv (\x -> o {dlfmt_m = x}) s e+ "dldir" -> return $ o {dldir = e}+ "" -> return o+ x -> throwError $ "Unrecognized option: " ++ x+ bconv u oname v + | v `elem` ["f", "false"] = return $ u False+ | v `elem` ["t", "true"] = return $ u True+ | otherwise = throwError $ "Boolean values must be one of 'f', 't', 'true', and 'false', not `"++v++"\', in option "++oname+ sconv u on v = catchError (u `liftM` (subfromstring v))+ (\t -> throwError $ t++" (error in option \""++on++"\")")++readopts = do+ dotfile <- fmap (</> ".emxdownloader") getHomeDirectory+ curdir <- getCurrentDirectory+ let default_options = Opt True True True curdir default_dlf default_dlfm+ exists <- doesFileExist dotfile+ if exists + then do+ h <- openFile dotfile ReadMode+ contents <- fmap lines $ hGetContents h+ return (foldM optline default_options contents)+ else return $ return default_options
+ Emx/Track.hs view
@@ -0,0 +1,5 @@+module Emx.Track where++data Track = Tr {artist, album, title, ext, dlurl, label, arturl,+ tracknum, genre :: String,+ disccount, discnum, trackcount :: Int } deriving Show
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Ben Wolfson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ben Wolfson nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.rst view
@@ -0,0 +1,89 @@+======+GETEMX+======++getemx reads the .emx files used by `Emusic+<http://www.emusic.com>`_ and downloads the files they describe. Its+behavior is controlled by the file ~/.emxdownloader, which contains+instructions for file naming, art downloading, etc (see below in+`Invocation`_). It downloads files using either wget, curl, or+Haskell's interface to libcurl (though I would be surprised if anyone+who had libcurl installed didn't also have the curl binary).++Building & Installation+=======================++It should be possible to build and install getemx using `cabal+<http://www.haskell.org/cabal>`_.++Invocation+==========++getemx accepts no options on the command line. Its arguments should+consist simply of .emx files; the simplest way to invoke it is::++ $ getemx *.emx++where the .emx files are in the current directory.++getemx will read a file in your home directory called ".emxdownloader"+which can define options to control its behavior. Options may either+be *boolean* or *string*; the values of boolean options must be one of+"f", "t", "false", or "true" while string options may be any+string. The syntax of the .emxdownloader file is very simple::++ option = value++Any amount of whitespace may occur before or after the "=". The+following are boolean options:++- **replace_underscores**: if true, underscores in the filename will be replaced by spaces. True by default.+- **replace_apostrophe_identity**: if true, the string "``'``" in filenames will be replaced by "``'``". True by default.+- **get_art**: if true, cover art will be downloaded for each album. True by default.++Currently the only string options control the filenames of the+downloaded files. There are two classes here: **dldir** specifies a+directory *relative to which* further processing will take place,+while **dlfmt** and **dlfmt_multidisc** specify how to process+*individual files*. The latter two accept a number of replacement+options:++================== ================+**Format string:** **Replaced by:**+================== ================+``%(a)`` Artist name+``%(A)`` Album name+``%(n)`` Track number+``%(t)`` Track name+``%(D)`` Total number of discs in set+``%(d)`` Number of present disc in set (e.g. 2 out of 4)+``%(l)`` Label+``%(e)`` File extension+``%(g)`` Genre+``%%`` ``%``+================== ================++The defaults for the string options are:++- **dldir**: ``.``+- **dlfmt**: ``%(a)/%(A)/%(a) - %(A) - %(n) - %(t)``+- **dlfmt_multidisc**: ``%(a)/%(A): %(d)/%(a) - %(A): %(d) - %(n) - %(t)``++**dlfmt_multidisc** is used if a track is being downloaded that+belongs to a set with more than one disc; otherwise, **dlfmt** is+used. Note that at present the default for dlfmt_multidisc will+probably do the wrong thing on OS X. Note also that neither of the+default values ends with ``%(e)``: the file extension is supplied+automatically if it is not explicitly specified.++A ~/.emxdownloader file that set every option to its default value+could look like this::++ get_art = t+ replace_underscores = t+ replace_apostrophe_identity = t+ dldir = .+ dlfmt = %(a)/%(A)/%(a) - %(A) - %(n) - %(t)+ dlfmt_multidisc = %(a)/%(A): %(d)/%(a) - %(A): %(d) - %(n) - %(t)++"Could" because one could also write "true" out in full for "t".
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ getemx.cabal view
@@ -0,0 +1,62 @@+-- getemx.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: getemx++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.1++-- A short (one-line) description of the package.+Synopsis: Fetch from emusic using .emx files++-- A longer description of the package.+-- Description: ++-- URL for the project homepage or repository.+Homepage: http://bitbucket.org/kenko/getemx++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Ben Wolfson++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: wolfson@gmail.com++-- A copyright notice.+-- Copyright: ++Category: Web++Build-type: Simple+Description: Read emusic's .emx files and download media+-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: README.rst++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.2+++Executable getemx++ Other-modules: Emx.Emx, Emx.Track, Emx.Options, Emx.Dl+ -- .hs or .lhs file containing the Main module.+ Main-is: getemx.hs+ + -- Packages needed in order to build this package.+ Build-depends: base >= 3 && < 5, curl >= 1.3, hxt >= 9, mtl >= 1, filepath >= 1, directory >= 1, process >= 1, old-locale >= 1, time >= 1, haskell98+ + -- Modules not exported by this package. + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +
+ getemx.hs view
@@ -0,0 +1,83 @@+import System (getArgs, exitFailure)+import System.IO +import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (readTime)+import Control.Monad.Error+import System.FilePath+import System.Directory+import System.Locale (defaultTimeLocale)+import Prelude hiding (catch)+++import Emx.Dl+import Emx.Options+import Emx.Track+import Emx.Emx++-- all tracks for the same album have the same artwork.+artdl :: (IO (String, String) -> IO ()) -> IO (String, String) -> IO ()+artdl dler remloc = do+ (rem, loc) <- remloc+ exists <- doesFileExist loc+ unless exists $ dler remloc+ return ()++findPathAndName p = findExecutable p >>= maybe (return Nothing) (\path -> return $ Just (path,p)) ++preptrack opts track = do+ made <- foldM joinandtest (dldir opts) $ splitPath ldir+ return (dlurl track, combine made lname)+ where+ joinandtest :: String -> FilePath -> IO String+ joinandtest sofar component = do+ let jed = combine sofar component+ exists <- doesDirectoryExist jed+ unless exists (createDirectory jed)+ return jed+ (ldir, lname) = splitFileName $ if disccount track == 1 + then getlocalname (dlfmt opts) track []+ else getlocalname (dlfmt_m opts) track []+ getlocalname [] tr [] = ext tr+ getlocalname [] tr (a:acc) + | a == ext tr = concat $ reverse (a:acc)+ | otherwise = concat $ reverse (ext tr:a:acc)+ getlocalname (Txt s:st) tr acc = getlocalname st tr (s:acc)+ getlocalname (IntSub s:st) tr acc = getlocalname st tr ((show$s tr):acc)+ getlocalname (StrSub s:st) tr acc = getlocalname st tr (s tr:acc)++prepart opts track = do+ trackdir <- (liftM $dropFileName.snd) $ preptrack opts track+ let artname = takeFileName $ arturl track+ return (arturl track, combine trackdir artname)++process' opts f = + do + (action, expiry, tracks) <- readfile f (repu opts) (repapo opts)+ unless (action == "download") $ throwError ("Unrecognized EMX action: "++action++". Skipping file "++f)+ now <- liftIO getCurrentTime+ let exp = readTime defaultTimeLocale "%m/%d/%Y %H:%M" expiry+ unless (now < exp) $ throwError ("EMX file "++f++" has expired!")+ dlp <- liftIO $ findPathAndName "wget" `mplus` findPathAndName "curl"+ let dler = case dlp of+ Nothing -> dlnative+ Just (path, "wget") -> dlwget path+ Just (path, "curl") -> dlcurl path+ mapM_ (liftIO.dler.preptrack opts) tracks+ when (get_art opts) $ mapM_ (liftIO.artdl dler.prepart opts) tracks+ return ()++process o f = do + r <- runErrorT $ process' o f+ case r of+ (Left e) -> putStrLn e+ _ -> return ()++main :: IO ()+main = do+ args <- getArgs + eopts <- readopts+ case eopts of+ (Right opts) -> mapM_ (process opts) args+ (Left e) -> do + putStrLn $ "Error reading options: " ++ e+ exitFailure