freesound 0.0.2 → 0.1.0
raw patch · 3 files changed
+74/−54 lines, 3 filesdep +bytestringdep ~basedep ~data-accessordep ~data-accessor-templatePVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring
Dependency ranges changed: base, data-accessor, data-accessor-template, mtl
API changes (from Hackage documentation)
- Sound.Freesound: download :: Sample -> Freesound String
+ Sound.Freesound: download :: (CurlBuffer b) => Sample -> Freesound b
Files
- Sound/Freesound.hs +7/−5
- freesound.cabal +11/−10
- freesound/Main.hs +56/−39
Sound/Freesound.hs view
@@ -19,6 +19,7 @@ download ) where +import qualified Data.ByteString.Lazy as BS import Data.List (find, intercalate, stripPrefix) import Data.Maybe (listToMaybe, mapMaybe) import Network.Curl@@ -82,6 +83,7 @@ -- | Curl handle. type Handle = Curl+type Response b = CurlResponse_ [(String, String)] b -- | The 'Freesound' monad. @@ -93,10 +95,10 @@ -- | Make a request using 'Handle' and converting propagating failure codes -- to the ErrorT monad.-request :: URLString -> [CurlOption] -> Freesound CurlResponse+request :: CurlBuffer b => URLString -> [CurlOption] -> Freesound (Response b) request url options = do curl <- ask- resp <- liftIO $ do_curl curl url (defaultCurlOptions ++ options)+ resp <- liftIO $ do_curl_ curl url (defaultCurlOptions ++ options) case respCurlCode resp of CurlOK -> return resp code -> throwError (CurlError code)@@ -104,7 +106,7 @@ -- | Make a request and parse the returned XML data. requestXML :: URLString -> [CurlOption] -> Freesound XML.Element requestXML url options = do- resp <- request url options+ resp <- request url options :: Freesound (Response BS.ByteString) case XML.parseXMLDoc (respBody resp) of Nothing -> throwError XMLError Just xml -> return xml@@ -166,7 +168,7 @@ Just p -> return p Nothing -> throwError $ Error ("Properties for sample " ++ (show $ sampleId sample) ++ " not found") --- | Download a 'Sample' as a 'String'.-download :: Sample -> Freesound String+-- | Download a 'Sample' as an instance of 'CurlBuffer'.+download :: CurlBuffer b => Sample -> Freesound b download sample = respBody `fmap` request url [] where url = URL.addParams [("id", show (sampleId sample))] audioURL
freesound.cabal view
@@ -1,5 +1,5 @@ name: freesound-version: 0.0.2+version: 0.1.0 synopsis: Access the Freesound Project database description: Access the Freesound Project database. The Freesound Project is a collaborative database of Creative Commons@@ -11,12 +11,12 @@ license: BSD3 license-file: LICENSE category: Sound, Web-copyright: Copyright (c) Stefan Kersten 2008+copyright: Copyright (c) Stefan Kersten 2008-2010 author: Stefan Kersten maintainer: Stefan Kersten stability: provisional homepage: http://code.haskell.org/~StefanKersten/code/freesound-tested-with: GHC == 6.10.1+tested-with: GHC == 6.10.1, GHC == 6.10.4, GHC == 6.12.1 build-type: Simple cabal-version: >= 1.2 @@ -27,13 +27,14 @@ Sound.Freesound.Sample other-modules: Sound.Freesound.URL Sound.Freesound.Util- build-depends: base >= 3,- curl == 1.3.*,- data-accessor == 0.1.*,- data-accessor-template == 0.1.4,- directory >= 1,- mtl == 1.1.*,- xml == 1.3.*+ build-depends: base >= 3 && < 5+ , bytestring >= 0.9 && < 1.0+ , curl >= 1.3 && < 1.4+ , data-accessor >= 0.1 && < 0.3+ , data-accessor-template >= 0.1 && < 0.3+ , directory >= 1+ , mtl >= 1.1+ , xml >= 1.3 && < 1.4 extensions: GeneralizedNewtypeDeriving
freesound/Main.hs view
@@ -3,21 +3,24 @@ -- /TODO/: -- * flesh out error handling ---import Control.Monad.Trans (liftIO)-import Sound.Freesound-import Sound.Freesound.Query-import Sound.Freesound.Util-import System.IO (hGetLine, hGetEcho, hSetEcho, stdin)-import Text.XML.Light as XML-import System.Console.GetOpt -import Data.Accessor.Template-import Data.Accessor+import qualified Data.ByteString.Lazy as BS+import Control.Monad.Trans (liftIO)+import Sound.Freesound+import qualified Sound.Freesound.Properties as Props+import Sound.Freesound.Query+import Sound.Freesound.Util+import System.IO (hGetLine, hGetEcho, hSetEcho, stdin)+import Text.XML.Light as XML+import System.Console.GetOpt -import System.Exit-import System.IO-import System.Environment (getArgs)+import Data.Accessor.Template+import Data.Accessor +import System.Exit+import System.IO+import System.Environment (getArgs)+ data Options = Options { optHelp_ :: Bool , optUser_ :: Maybe String@@ -37,11 +40,13 @@ } deriving (Eq, Show) data PropertiesOptions = PropertiesOptions- { optXML_ :: Bool+ { optXML_ :: Bool } deriving (Eq, Show) data DownloadOptions = DownloadOptions- { optOutputFile_ :: Maybe FilePath+ { optOutputFile_ :: Maybe FilePath+ , optAddExtension_ :: Bool+ , optUseOriginalFileName_ :: Bool } deriving (Eq, Show) $( deriveAccessors ''Options )@@ -69,21 +74,23 @@ optSimilarity_ = Similar } , optProperties_ = PropertiesOptions { optXML_ = False }- , optDownload_ = DownloadOptions {- optOutputFile_ = Nothing }+ , optDownload_ = DownloadOptions+ { optOutputFile_ = Nothing+ , optAddExtension_ = False+ , optUseOriginalFileName_ = False } } globalOptions :: [OptDescr (Options -> Options)] globalOptions =- [ Option ['h'] ["help"]- (NoArg (optHelp ^= True))- "Print this help message."- ,Option ['u'] ["user"]- (ReqArg (\x -> optUser ^= Just x) "STRING")- "Freesound user name."- ,Option ['p'] ["password"]- (ReqArg (\x -> optPassword ^= Just x) "STRING")- "Freesound password."+ [ Option ['h'] ["help"]+ (NoArg (optHelp ^= True))+ "Print this help message."+ , Option ['u'] ["user"]+ (ReqArg (\x -> optUser ^= Just x) "STRING")+ "Freesound user name."+ , Option ['p'] ["password"]+ (ReqArg (\x -> optPassword ^= Just x) "STRING")+ "Freesound password." ] searchOptions :: [OptDescr (Options -> Options)]@@ -91,23 +98,29 @@ searchSimilarOptions :: [OptDescr (Options -> Options)] searchSimilarOptions =- [ Option [] ["dissimilar"]- (NoArg (optSearchSimilar ^: optSimilarity ^= Dissimilar))- "Dissimilar"+ [ Option [] ["dissimilar"]+ (NoArg (optSearchSimilar ^: optSimilarity ^= Dissimilar))+ "Dissimilar" ] propertiesOptions :: [OptDescr (Options -> Options)] propertiesOptions =- [ Option [] ["xml"]- (NoArg (optProperties ^: optXML ^= True))- "List xml"+ [ Option [] ["xml"]+ (NoArg (optProperties ^: optXML ^= True))+ "List xml" ] downloadOptions :: [OptDescr (Options -> Options)] downloadOptions =- [ Option ['o'] ["output-file"]- (ReqArg (\x -> optDownload ^: optOutputFile ^= Just x) "PATH")- "Output file"+ [ Option ['o'] ["output-file"]+ (ReqArg (\x -> optDownload ^: optOutputFile ^= Just x) "PATH")+ "Output file name (overrides --use-original-filename)"+ , Option ['e'] ["add-extension"]+ (NoArg (optDownload ^: optAddExtension ^= True))+ "Add original extension to output file"+ , Option ['O'] ["use-original-filename"]+ (NoArg (optDownload ^: optUseOriginalFileName ^= True))+ "Use original file name for output" ] -- Utilities@@ -146,11 +159,15 @@ do_download options args = case readSample args of Left e -> Left e- Right s -> Right $ download s >>= fout- where- fout = case options^.optDownload^.optOutputFile of- Nothing -> liftIO . putStrLn- Just path -> liftIO . writeFile path+ Right s -> Right $ do+ path <- if options^.optDownload^.optUseOriginalFileName+ then properties s >>= return . Just . Props.originalFileName+ else case options^.optDownload^.optOutputFile of+ Nothing -> return Nothing+ Just p -> if options^.optDownload^.optAddExtension+ then properties s >>= return . Just . (\props -> p ++ "." ++ Props.extension props)+ else return (Just p)+ download s >>= maybe (liftIO . BS.putStrLn) (\p -> liftIO . BS.writeFile p) path commands :: [(String, Command)] commands = [