freesound 0.1.0 → 0.2.0

raw patch · 26 files changed

+1290/−711 lines, 26 filesdep +aesondep +blaze-builderdep +data-defaultdep −curldep −data-accessordep −data-accessor-templatedep ~basedep ~bytestringdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, blaze-builder, data-default, filepath, freesound, hspec, http-types, lens, network, network-uri, old-locale, text, time, transformers, wreq

Dependencies removed: curl, data-accessor, data-accessor-template, directory, xml

Dependency ranges changed: base, bytestring, mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• Sound/Freesound.hs +0/−174
• Sound/Freesound/Properties.hs +0/−147
• Sound/Freesound/Query.hs +0/−31
• Sound/Freesound/Sample.hs +0/−20
• Sound/Freesound/URL.hs +0/−21
• Sound/Freesound/Util.hs +0/−42
• freesound.cabal +60/−26
• freesound/Main.hs +0/−250
• src/Sound/Freesound.hs +38/−0
• src/Sound/Freesound/API.hs +128/−0
• src/Sound/Freesound/Bookmark.hs +50/−0
• src/Sound/Freesound/Bookmark/Internal.hs +24/−0
• src/Sound/Freesound/List.hs +45/−0
• src/Sound/Freesound/Pack.hs +24/−0
• src/Sound/Freesound/Pack/Type.hs +78/−0
• src/Sound/Freesound/Search.hs +59/−0
• src/Sound/Freesound/Search/Filter.hs +215/−0
• src/Sound/Freesound/Search/Numerical.hs +65/−0
• src/Sound/Freesound/Search/Query.hs +36/−0
• src/Sound/Freesound/Sound.hs +85/−0
• src/Sound/Freesound/Sound/Type.hs +227/−0
• src/Sound/Freesound/User.hs +58/−0
• src/Sound/Freesound/User/Type.hs +85/−0
• test/Sound/Freesound/Test.hs +9/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,3 @@+## 0.2.0++Beginning of transition to Freesound API v2: Working resources are textual search and `Sound` resources.

@@ -1,174 +0,0 @@--- | This module provides access to the Freesound Project, a database of--- Creative Commons licensed sounds.------ * <http://www.freesound.org/>------ * <http://www.creativecommons.org/>-module Sound.Freesound (-    -- * The Freesound monad-    Freesound,-    withFreesound,-    -- * Error handling-    Error(..), errorString,-    -- * Sample handles-    Sample(..),-    -- * API methods-    search,-    Similarity(..), searchSimilar,-    propertiesXML, properties,-    download-) where--import qualified Data.ByteString.Lazy as BS-import Data.List                                    (find, intercalate, stripPrefix)-import Data.Maybe                                   (listToMaybe, mapMaybe)-import Network.Curl-import qualified Network.Curl.Easy                  as Curl-import Control.Monad.Error                          (ErrorT(..), MonadError, MonadIO, liftIO, noMsg, strMsg, throwError)-import Control.Monad.Reader                         (MonadReader, ReaderT(..), ask)-import qualified Control.Monad.Error                as Error-import Numeric                                      (readDec)-import qualified Text.XML.Light                     as XML--import Sound.Freesound.Properties                   (Properties)-import qualified Sound.Freesound.Properties         as Properties-import Sound.Freesound.Query                        (Query)-import qualified Sound.Freesound.Query              as Query-import Sound.Freesound.Sample                       (Sample(..))-import qualified Sound.Freesound.Sample             as Sample-import qualified Sound.Freesound.URL                as URL-import Sound.Freesound.Util                         (findString, readMaybe)--mkURL :: String -> URLString-mkURL page = baseURL ++ "/" ++ page---- The various API URLs.-baseURL          = "http://www.freesound.org"-loginURL         = mkURL "forum/login.php"-loginRedirect    = "../index.php"-searchURL        = mkURL "searchTextXML.php"-searchSimilarURL = mkURL "searchSimilarXML.php"-xmlURL           = mkURL "samplesViewSingleXML.php"-audioURL         = mkURL "samplesDownload.php"---- | Curl options used by default in all the interaction with the database.-defaultCurlOptions :: [CurlOption]-defaultCurlOptions = [-        -- Some servers require this to be set-        CurlUserAgent "libcurl-agent/1.0",-        -- Enable cookie handling; cookies are passed around in the session-        -- handle and not saved to disk-        CurlCookieFile ""-    ]---- | Error type.-data Error =-      Error String-    | CurlError CurlCode-    | LoginError-    | XMLError-    | UnknownError-    deriving (Show)--instance Error.Error Error where-  noMsg    = UnknownError-  strMsg s = Error s---- | Convert an 'Error' into a 'String'.-errorString :: Error -> String-errorString (Error s)     = s-errorString (CurlError c) = maybe s id (stripPrefix "Curl" (show c))-    where s = show c-errorString e             = show e---- | Curl handle.-type Handle = Curl-type Response b = CurlResponse_ [(String, String)] b---- | The 'Freesound' monad.---- Adds an environment (the 'Curl' handle) and error handling to the 'IO'--- monad. Actions in the 'Freesound' monad can only be executed by--- 'withFreesound', which handles all the initialization and cleanup details.-newtype Freesound a = Freesound { runFreesound :: ReaderT Handle (ErrorT Error IO) a }-                        deriving (Functor, Monad, MonadError Error, MonadIO, MonadReader Handle)---- | Make a request using 'Handle' and converting propagating failure codes--- to the ErrorT monad.-request :: CurlBuffer b => URLString -> [CurlOption] -> Freesound (Response b)-request url options = do-    curl <- ask-    resp <- liftIO $ do_curl_ curl url (defaultCurlOptions ++ options)-    case respCurlCode resp of-        CurlOK -> return resp-        code   -> throwError (CurlError code)---- | Make a request and parse the returned XML data.-requestXML :: URLString -> [CurlOption] -> Freesound XML.Element-requestXML url options = do-    resp <- request url options :: Freesound (Response BS.ByteString)-    case XML.parseXMLDoc (respBody resp) of-        Nothing  -> throwError XMLError-        Just xml -> return xml---- | Log into freesound.-login :: String -> String -> Freesound ()-login user password = do-    resp <- request loginURL opts-    -- Check for login success (duh!)-    -- TODO: Figure out a better way-    case findString "logged" (respBody resp) of-        Nothing -> throwError LoginError-        _       -> return ()-    where-        post = URL.postFields [-                ("username", user),-                ("password", password),-                ("login", "login"),-                ("redirect", loginRedirect) ]-        opts = [ CurlPostFields post,-                 -- CurlCookieJar cookieFile,-                 CurlFollowLocation True ]---- | Log into Freesound with and perform an action in the 'Freesound' monad.-withFreesound :: String -> String -> Freesound a -> IO (Either Error a)-withFreesound user password f =-    withCurlDo $ liftIO Curl.initialize >>= runErrorT . runReaderT action-    where action = runFreesound (login user password >> f)---- | Search the Freesound database.-search :: Query -> Freesound [Sample]-search query = Sample.listFromXML `fmap` requestXML searchURL opts-    where opts = [ CurlPostFields (Query.toPostFields query) ]---- | Similarity type used by 'searchSimilar'.-data Similarity = Similar | Dissimilar deriving (Eq, Show)---- | Search samples similar (or dissimilar) to a 'Sample'.-searchSimilar :: Similarity -> Sample -> Freesound [Sample]-searchSimilar similarity sample = Sample.listFromXML `fmap` requestXML url []-    where-        url = URL.addParams params searchSimilarURL-        params = [ ("id", show (sampleId sample)),-                   ("inverse", case similarity of-                                Similar    -> "false"-                                Dissimilar -> "true") ]---- | Get the properties of a 'Sample' as an XML document.-propertiesXML :: Sample -> Freesound XML.Element-propertiesXML sample = requestXML url []-    where url = URL.addParams [("id", show (sampleId sample))] xmlURL---- | Get the properties of a 'Sample'.-properties :: Sample -> Freesound Properties-properties sample = do-    xml <- propertiesXML sample-    let props = Properties.listFromXML xml-    case find ((== sampleId sample) . Properties.sampleId) props of-        Just p  -> return p-        Nothing -> throwError $ Error ("Properties for sample " ++ (show $ sampleId sample) ++ " not found")---- | 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

@@ -1,147 +0,0 @@-module Sound.Freesound.Properties (-    User(..),-    Description(..),-    Statistics(..),-    Tag,-    Properties(..),-    fromXML, listFromXML-) where--import Data.Maybe               (mapMaybe)-import Network.Curl             (URLString)-import Sound.Freesound.Util-import Text.XML.Light           (unqual)-import qualified Text.XML.Light as XML---- | User of the Freesound database.-data User = User {-    userId   :: Int,-    userName :: String-} deriving (Eq, Show)---- | Description of a 'Sample', containing user and text.-data Description = Description User String deriving (Eq, Show)---- | Tag (a single word) for describing a 'Sound'-type Tag = String---- | Statistics of a 'Sample' in the database.-data Statistics = Statistics {-    downloads :: Int,-    rating    :: (Int, Int)-} deriving (Eq, Show)---- | Properties of a 'Sample' in the database.-data Properties = Properties {-    sampleId            :: Int,-    -    user                :: User,-    date                :: String,-    originalFileName    :: String,-    statistics          :: Statistics,-    -    image               :: URLString,-    preview             :: URLString,-    colors              :: URLString,--    -- descriptors ??-    -- parent ??-    -- geotag ??-    -    extension           :: String,-    sampleRate          :: Int,-    bitRate             :: Int,-    bitDepth            :: Int,-    channels            :: Int,-    duration            :: Double,-    fileSize            :: Int,-    -    descriptions        :: [Description],-    tags                :: [Tag]-    -    -- comments ??-} deriving (Eq, Show)---- | Read a 'User' value from an 'XML.Element' in the 'Maybe' monad.-userFromXML :: XML.Element -> Maybe User-userFromXML e = do-    _userId   <- XML.findAttr (unqual "id") e >>= readMaybe-    _userName <- XML.findChild (unqual "name") e >>= return . XML.strContent-    return (User _userId _userName)---- | Read a rating from an 'XML.Element' in the 'Maybe' monad.-ratingFromXML :: XML.Element -> Maybe (Int, Int)-ratingFromXML e = do-    count <- findAttr "count" e >>= readMaybe-    value <- strContent e >>= readMaybe-    return (count, value)-    --- | Read a 'Statistics' value from an 'XML.Element' in the 'Maybe' monad.-statisticsFromXML :: XML.Element -> Maybe Statistics-statisticsFromXML e = do-    _downloads <- findChild "downloads" e >>= strContent >>= readMaybe-    _rating    <- findChild "rating" e >>= ratingFromXML-    return (Statistics _downloads _rating)---- | Read a 'Description' value from an 'XML.Element' in the 'Maybe' monad.-descriptionFromXML :: XML.Element -> Maybe Description-descriptionFromXML e = do-    _user <- userFromXML e-    _text <- findChild "text" e >>= strContent-    return (Description _user _text)---- | Read a list of 'Description's from an 'XML.Element' in the 'Maybe' monad.-descriptionsFromXML :: XML.Element -> Maybe [Description]-descriptionsFromXML = return . mapMaybe descriptionFromXML . findChildren "description"---- | Read a list of 'Tag's from an 'XML.Element' in the 'Maybe' monad.-tagsFromXML :: XML.Element -> Maybe [Tag]-tagsFromXML = return . map XML.strContent . findChildren "tag"---- | Read a 'Properties' value from an 'XML.Element' in the 'Maybe' monad.-fromXML :: XML.Element -> Maybe Properties-fromXML e = do-    _sampleId           <- findAttr "id" e >>= readMaybe-    _user               <- findChild "user" e >>= userFromXML-    _date               <- findChild "date" e >>= strContent-    _originalFileName   <- findChild "originalFilename" e >>= strContent-    _statistics         <- findChild "statistics" e >>= statisticsFromXML-    _image              <- findChild "image" e >>= strContent-    _preview            <- findChild "preview" e >>= strContent-    _colors             <- findChild "colors" e >>= strContent-    _extension          <- findChild "extension" e >>= strContent-    _sampleRate         <- findChild "samplerate" e >>= strContent >>= readMaybe-    _bitRate            <- findChild "bitrate" e  >>= strContent >>= readMaybe-    _bitDepth           <- findChild "bitdepth" e >>= strContent >>= readMaybe-    _channels           <- findChild "channels" e >>= strContent >>= readMaybe-    _duration           <- findChild "duration" e >>= strContent >>= readMaybe-    _fileSize           <- findChild "filesize" e >>= strContent >>= readMaybe-    _descriptions       <- findChild "descriptions" e >>= descriptionsFromXML-    _tags               <- findChild "tags" e >>= tagsFromXML-    return $ Properties {-        sampleId            = _sampleId,--        user                = _user,-        date                = _date,-        originalFileName    = _originalFileName,-        statistics          = _statistics,--        image               = _image,-        preview             = _preview,-        colors              = _colors,--        extension           = _extension,-        sampleRate          = _sampleRate,-        bitRate             = _bitRate,-        bitDepth            = _bitDepth,-        channels            = _channels,-        duration            = _duration,-        fileSize            = _fileSize,--        descriptions        = _descriptions,-        tags                = _tags-    }---- | Read a list of 'Properties' from an 'XML.Element'.-listFromXML :: XML.Element -> [Properties]-listFromXML = mapMaybe fromXML . XML.findChildren (unqual "sample")

@@ -1,31 +0,0 @@-module Sound.Freesound.Query (-    Query(..),-    stringQuery,-    toPostFields-) where--import qualified Sound.Freesound.URL as URL---- | A 'Query' type for searching the database.-data Query = Query {-    string      :: String,          -- ^ The query string-    minDur      :: Maybe Double,    -- ^ Minimum duration in seconds-    maxDur      :: Maybe Double,    -- ^ Maximum duration in seconds-    bitRate     :: Maybe Int,       -- ^ Bit rate of the soundfile-    bitDepth    :: Maybe Int,       -- ^ Bit depth of the soundfile-    sampleRate  :: Maybe Int        -- ^ Sample rate of the soundfile-}---- | Construct a 'Query' to search the database for a 'String'.-stringQuery :: String -> Query-stringQuery s = Query s Nothing Nothing Nothing Nothing Nothing---- | Convert a query to POST request fields.-toPostFields :: Query -> [String]-toPostFields query = URL.postFields [ x | Just x <- [-                        Just ("search", string query),-                        fmap ((,) "durationMin" . show) (minDur query),-                        fmap ((,) "durationMax" . show) (maxDur query),-                        fmap ((,) "bitrate"     . show) (bitRate query),-                        fmap ((,) "bitdepth"    . show) (bitDepth query),-                        fmap ((,) "samplerate"  . show) (sampleRate query) ] ]

@@ -1,20 +0,0 @@-module Sound.Freesound.Sample (-    Sample(..),-    fromXML, listFromXML-) where--import Data.Maybe               (mapMaybe)-import Sound.Freesound.Util-import qualified Text.XML.Light as XML---- | A handle to a sample in the database.-newtype Sample = Sample { sampleId :: Int }-    deriving (Eq, Ord, Read, Show)---- | Read a 'Sample' from an 'XML.Element'.-fromXML :: XML.Element -> Maybe Sample-fromXML e = Sample `fmap` (findAttr "id" e >>= readMaybe)---- | Read a list of 'Sample's from an 'XML.Element'.-listFromXML :: XML.Element -> [Sample]-listFromXML = mapMaybe fromXML . findChildren "sample"

@@ -1,21 +0,0 @@-module Sound.Freesound.URL (-    postFields, addParams-) where--import Data.List    (intercalate)-import Network.Curl (URLString)---- | Construct a POST field from a key/value pair.-postField :: String -> String -> String-postField k v = k ++ "=" ++ v--postFields :: [(String, String)] -> [String]-postFields = map (uncurry postField)--addParams :: [(String, String)] -> URLString -> URLString-addParams [] u = u-addParams (p:ps) u = addpn ps (addp1 p u)-    where-        addp1 (k, v) u        = u ++ "?" ++ (postField k v)-        addpn []            u = u-        addpn ((k, v):rest) u = u ++ "&" ++ postField k v ++ addpn rest u

@@ -1,42 +0,0 @@-module Sound.Freesound.Util (-    readMaybe,-    findAttr,-    findChild,-    findChildren,-    strContent,-    findString-) where--import Data.List                (isPrefixOf)-import qualified Text.XML.Light as XML---- | Find substring.-findString :: String -> String -> Maybe String-findString "" xs        = Just xs-findString a  ""        = Nothing-findString a xs-    | isPrefixOf a xs   = Just xs-findString a (_:xs)     = findString a xs---- | Read a value from a 'String', returning 'Nothing' when the parse fails.-readMaybe :: (Read a) => String -> Maybe a-readMaybe s = case reads s of-                [(a, "")] -> Just a-                _         -> Nothing---- | Find an attribute of an 'XML.Element'.-findAttr :: String -> XML.Element -> Maybe String-findAttr name = XML.findAttr (XML.unqual name)---- | Find a child element of an 'XML.Element'.-findChild :: String -> XML.Element -> Maybe XML.Element-findChild name = XML.findChild (XML.unqual name)---- | Find all child elements of an 'XML.Element'.-findChildren :: String -> XML.Element -> [XML.Element]-findChildren name = XML.findChildren (XML.unqual name)---- | Return the string content of an 'XML.Element' in the 'Maybe' monad.-strContent :: XML.Element -> Maybe String-strContent = return . XML.strContent-

@@ -1,5 +1,5 @@ name:               freesound-version:            0.1.0+version:            0.2.0 synopsis:           Access the Freesound Project database description:        Access the Freesound Project database. The Freesound                     Project is a collaborative database of Creative Commons@@ -11,35 +11,69 @@ license:            BSD3 license-file:       LICENSE category:           Sound, Web-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, GHC == 6.10.4, GHC == 6.12.1+copyright:          Copyright (c) Stefan Kersten 2008-2016+author:             Stefan Kersten <kaoskorobase@gmail.com>+maintainer:         Stefan Kersten <kaoskorobase@gmail.com>+stability:          experimental+homepage:           https://github.com/kaoskorobase/freesound+bug-reports:        https://github.com/kaoskorobase/freesound/issues+tested-with:        GHC == 6.10.1, GHC == 6.10.4, GHC == 6.12.1, GHC == 7.10.3 build-type:         Simple-cabal-version:      >= 1.2+cabal-version:      >= 1.8 +extra-source-files:+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/kaoskorobase/freesound+ library   exposed-modules:  Sound.Freesound-                    Sound.Freesound.Properties-                    Sound.Freesound.Query-                    Sound.Freesound.Sample-  other-modules:    Sound.Freesound.URL-                    Sound.Freesound.Util+                    Sound.Freesound.Bookmark+                    Sound.Freesound.List+                    Sound.Freesound.Pack+                    Sound.Freesound.Search+                    Sound.Freesound.Search.Filter+                    Sound.Freesound.Search.Numerical+                    Sound.Freesound.Search.Query+                    Sound.Freesound.Sound+                    Sound.Freesound.User+  other-modules:    Sound.Freesound.API+                    Sound.Freesound.Bookmark.Internal+                    Sound.Freesound.Pack.Type+                    Sound.Freesound.Sound.Type+                    Sound.Freesound.User.Type   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+                  , aeson >= 0.6+                  , blaze-builder >= 0.3+                  , bytestring >= 0.9+                  , data-default >= 0.5+                  , filepath >= 1.2+                  , http-types >= 0.7+                  , lens+                  , mtl+                  , network >= 2.4+                  , network-uri+                  , old-locale >= 1.0+                  , text >= 0.11+                  , time >= 1.2+                  , transformers >= 0.3+                  , wreq+  hs-source-dirs:   src+  Ghc-Options:      -Wall -  extensions:       GeneralizedNewtypeDeriving+-- executable freesound+--   hs-source-dirs:   ., freesound+--   main-is:          Main.hs -executable freesound-  hs-source-dirs:   ., freesound-  main-is:          Main.hs-  extensions:       GeneralizedNewtypeDeriving,-                    TemplateHaskell+test-suite spec+  type:             exitcode-stdio-1.0+  ghc-options:      -Wall+  hs-source-dirs:   test+  main-is:          Spec.hs+  other-modules:    Sound.Freesound.Test+  build-depends:    base == 4.*+                  , data-default+                  , freesound+                  , hspec

@@ -1,250 +0,0 @@--- | Access the freesound database from the command line.------ /TODO/:---   * flesh out error handling-----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           Data.Accessor.Template-import           Data.Accessor--import           System.Exit-import           System.IO-import           System.Environment (getArgs)--data Options = Options-  { optHelp_            :: Bool-  , optUser_            :: Maybe String-  , optPassword_        :: Maybe String-  , optSearch_          :: SearchOptions-  , optSearchSimilar_   :: SearchSimilarOptions-  , optProperties_      :: PropertiesOptions-  , optDownload_        :: DownloadOptions-  } deriving (Eq, Show)--data SearchOptions = SearchOptions-  {-  } deriving (Eq, Show)--data SearchSimilarOptions = SearchSimilarOptions-  { optSimilarity_ :: Similarity-  } deriving (Eq, Show)--data PropertiesOptions = PropertiesOptions-  { optXML_ :: Bool-  } deriving (Eq, Show)--data DownloadOptions = DownloadOptions-  { optOutputFile_          :: Maybe FilePath-  , optAddExtension_        :: Bool-  , optUseOriginalFileName_ :: Bool-  } deriving (Eq, Show)--$( deriveAccessors ''Options )--- $( deriveAccessors ''SearchOptions )-$( deriveAccessors ''SearchSimilarOptions )-$( deriveAccessors ''PropertiesOptions )-$( deriveAccessors ''DownloadOptions )--type Action = Freesound ()-type Result = Either String Action--data Command = Command {-    cmdOptions :: [OptDescr (Options -> Options)],-    cmdHelp :: String,-    cmdAction :: Options -> [String] -> Result-}--defaultOptions :: Options-defaultOptions = Options-  { optHelp_     = False-  , optUser_     = Nothing-  , optPassword_ = Nothing-  , optSearch_ = SearchOptions { }-  , optSearchSimilar_ = SearchSimilarOptions {-    optSimilarity_   = Similar }-  , optProperties_ = PropertiesOptions {-    optXML_      = False }-  , 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."-    ]--searchOptions :: [OptDescr (Options -> Options)]-searchOptions = [ ]--searchSimilarOptions :: [OptDescr (Options -> Options)]-searchSimilarOptions =-    [ Option [] ["dissimilar"]-        (NoArg (optSearchSimilar ^: optSimilarity ^= Dissimilar))-        "Dissimilar"-    ]--propertiesOptions :: [OptDescr (Options -> Options)]-propertiesOptions =-    [ 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 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--readSample :: [String] -> Either String Sample-readSample []    = Left "Missing sample ID"-readSample (x:_) = case readMaybe x of-                    Nothing -> Left "Invalid sample ID"-                    Just i  -> Right (Sample i)--printSamples :: [Sample] -> Action-printSamples = liftIO . mapM_ (print . sampleId)---- Commands--do_search :: Options -> [String] -> Result-do_search options args = Right $ do-     samples <- search (stringQuery $ unwords args)-     printSamples samples--do_searchSimilar :: Options -> [String] -> Result-do_searchSimilar options args =-    case readSample args of-        Left e  -> Left e-        Right s -> Right $ searchSimilar (options^.optSearchSimilar^.optSimilarity) s >>= printSamples--do_properties :: Options -> [String] -> Result-do_properties options args =-    case readSample args of-        Left e  -> Left e-        Right s -> if options^.optProperties^.optXML-                    then Right $ propertiesXML s >>= liftIO . putStrLn . XML.ppElement-                    else Right $ properties    s >>= liftIO . print--do_download :: Options -> [String] -> Result-do_download options args =-    case readSample args of-        Left e  -> Left e-        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 = [-    ("search",     Command searchOptions        "freesound search [OPTION...] PREDICATES.." do_search),-    ("similar",    Command searchSimilarOptions "freesound similar [OPTION...] SAMPLE"      do_searchSimilar),-    ("properties", Command propertiesOptions    "freesound properties [OPTION...] SAMPLE"   do_properties),-    ("download",   Command downloadOptions      "freesound download [OPTION...] SAMPLE"     do_download)-    ]--printHelp :: ExitCode -> String -> [OptDescr (Options -> Options)] -> IO a-printHelp code header options = do-    hPutStr stderr (usageInfo header options)-    exitWith code--parseOptions :: String -> [OptDescr (Options -> Options)] -> [String] -> IO (Options, [String])-parseOptions header options argv = -    case getOpt Permute options argv of-        (o, n, []) -> let o' = foldl (flip ($)) defaultOptions o in-                        if o'^.optHelp-                            then printHelp ExitSuccess header options-                            else return (o', n)-        (_, _, es) -> ioError (userError (concat es ++ usageInfo header options))--globalHelp :: String-globalHelp = "Usage: freesound COMMAND [OPTION...] [ARG...]\-              \\n\n\-              \Try freesound COMMAND --help for individual command options.\-              \\n\n\-              \Commands:\n\n\-              \  search\n\-              \  similar\n\-              \  properties\n\-              \  downloads\n\n\-              \Global options:\n"---- | Read username from stdin.-getUser :: IO String-getUser = putStrLn "User:" >> hGetLine stdin---- | Read password from stdin.-getPassword :: IO String-getPassword = do-    putStrLn "Password:"-    echo <- hGetEcho stdin-    hSetEcho stdin False-    password <- hGetLine stdin-    hSetEcho stdin echo-    return password---- | Read credentials that are still unknown from stdin.-getCredentials :: Maybe String -> Maybe String -> IO (String, String)-getCredentials user password = do-    user'     <- maybe getUser return user-    password' <- maybe getPassword return password-    return (user', password')---- | Perform a command with the given user name and password.-doCommand :: String -> String -> Action -> IO ()-doCommand user password action = do-    res <- withFreesound user password action-    case res of-        Left e  -> putStrLn ("ERROR: " ++ errorString e)-        Right r -> return ()--main :: IO ()-main = do-    argv <- getArgs-    case argv of-        [] -> printHelp (ExitFailure 1) globalHelp globalOptions-        (cmdName:rest) ->-            case lookup cmdName commands of-                Nothing ->-                    printHelp (ExitFailure 1) globalHelp globalOptions-                Just cmd -> do-                    (options, args) <- parseOptions (cmdHelp cmd) (globalOptions ++ cmdOptions cmd) rest-                    case cmdAction cmd options args of-                        Left e  -> putStrLn ("ERROR: " ++ e)-                        Right a -> do-                            (user, password) <- getCredentials (options^.optUser) (options^.optPassword)-                            doCommand user password a

@@ -0,0 +1,38 @@+-- | This module provides access to the Freesound Project, a database of+-- Creative Commons licensed sounds.+--+-- * <http://www.freesound.org/>+--+-- * <http://www.creativecommons.org/>+--+-- > import qualified Network.HTTP.Conduit as HTTP++module Sound.Freesound+(+  -- * Searching+  module Sound.Freesound.Search+, module Sound.Freesound.Search.Query+, module Sound.Freesound.List+  -- * Users+, getUser+, getUserByName+, getBookmarkCategories+, getSounds+, getSounds_+, getPacks+  -- * Sounds+, search+, search_+, getSimilar+, getSimilar_+  -- * Freesound API monad+, module Sound.Freesound.API+)+where++import Sound.Freesound.API (Freesound, runFreesound, APIKey, apiKeyFromString)+import Sound.Freesound.List+import Sound.Freesound.Search+import Sound.Freesound.Search.Query+import Sound.Freesound.User+import Sound.Freesound.Sound

@@ -0,0 +1,128 @@+{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings #-}+module Sound.Freesound.API (+  APIKey+, apiKeyFromString+-- , HTTPRequest+, Freesound+, runFreesound+-- , request+, URI+, getURI+, Resource+, resourceURI+, appendQuery+, getResource+) where++import qualified Blaze.ByteString.Builder as Builder+import qualified Blaze.ByteString.Builder.Char8 as Builder+import           Control.Monad (liftM, mzero)+import           Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Control.Monad.Reader as R+import           Control.Lens+import           Data.Aeson as J+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Network.HTTP.Types as HTTP+import qualified Network.URI as URI+import qualified Network.Wreq as HTTP+import           Network.Wreq.Session (Session)+import qualified Network.Wreq.Session as Session++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+import           Data.Monoid+#endif++-- | API key required for each call to the Freesound server.+newtype APIKey = APIKey BS.ByteString deriving (Eq, Show)++-- | Construct an API key from a String.+apiKeyFromString :: String -> APIKey+apiKeyFromString = APIKey . BS.pack++-- | Reader monad environment.+data Env = Env {+    apiKey :: APIKey+  , session :: Session+  }++-- | Freesound API monad for communication with the Freesound server.+newtype Freesound a = Freesound (R.ReaderT Env IO a)+                        deriving (Applicative, Functor, Monad, MonadIO, R.MonadReader Env)++-- instance MonadTrans Freesound where+--   lift = Freesound . lift++-- | Perform an API action and return the result.+runFreesound :: APIKey -> Freesound a -> IO a+runFreesound k (Freesound m) = Session.withAPISession (R.runReaderT m . Env k)++-- | Newtype wrapper of Network.URI.URI to avoid orphan instance.+newtype URI = URI URI.URI deriving (Eq, Show)++instance FromJSON URI where+  parseJSON (String v) = maybe mzero return (parseURI' (T.unpack v))+  parseJSON _ = mzero++-- | Cover up for Freesound sloppiness.+parseURI' :: String -> Maybe URI+parseURI' = fmap URI . URI.parseURI . URI.escapeURIString URI.isAllowedInURI++-- | Download the data referred to by a URI.+getURI :: URI -> Freesound BL.ByteString+getURI (URI u) = do+  s <- R.asks session+  APIKey k <- R.asks apiKey+  let opts = HTTP.defaults & HTTP.header "Authorization" .~ ["Token " `BS.append` k]+      u' = URI.uriToString id u ""+  r <- liftIO $ Session.getWith opts s u'+  return $ r ^. HTTP.responseBody++-- | Resource URI.+newtype Resource a = Resource URI deriving (Eq, FromJSON, Show)++-- | Append a query string to a resource URI.+appendQuery :: HTTP.QueryLike a => a -> Resource r -> Resource r+appendQuery q (Resource (URI u)) = Resource $ URI $ u { URI.uriQuery = q' }+  where q' = BS.unpack+           $ Builder.toByteString+           $ HTTP.renderQueryBuilder True+           $ HTTP.parseQuery (BS.pack (URI.uriQuery u))+              ++ HTTP.toQuery q++-- | Create a query item for the API key.+-- apiKeyQuery :: Freesound HTTP.Query+-- apiKeyQuery = do+--   k <- Freesound $ R.asks apiKey+--   return $ [("api_key", Just k)]++-- | Download the resource referred to by a URI.+getResource :: (FromJSON a) => Resource a -> Freesound a+getResource (Resource u) = do+  -- q <- apiKeyQuery+  -- let Resource u = appendQuery q r+  liftM (handle . J.eitherDecode) $ getURI u+  where handle = either (\e -> error $ "Internal error (getResource): JSON decoding failed: " ++ e) id++-- | The base URI of the Freesound API.+baseURI :: Builder.Builder+baseURI = Builder.fromString "http://www.freesound.org/apiv2"++-- | Construct an API uri from path components and a query.+resourceURI :: [Text] -> HTTP.Query -> Resource a+resourceURI path query = Resource u+  where Just u = parseURI'+               . BL.unpack+               . Builder.toLazyByteString+               . mappend baseURI+               . HTTP.encodePath path+               $ query++-- | Perform an HTTP request given the method, a URI and an optional body and return the response body as a Conduit source.+-- request :: Monad m => HTTP.Method -> URI -> Maybe (C.Source m BS.ByteString) -> FreesoundT m (C.ResumableSource m BS.ByteString)+-- request method (URI uri) body = do+--   f <- FreesoundT $ R.asks httpRequest+--   lift $ f method uri body

@@ -0,0 +1,50 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Bookmark (+  Bookmark+, sound+, name+, Category+, category+, url+, sounds+, getSounds+) where++import           Control.Monad (mzero)+import           Data.Aeson+import           Data.Text (Text)+import           Sound.Freesound.API (Freesound, Resource, URI, getResource)+import qualified Sound.Freesound.Sound.Type as Sound++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++data Bookmark = Bookmark {+  sound :: Sound.Summary+, name :: Text+} deriving (Eq, Show)++instance FromJSON Bookmark where+  parseJSON j@(Object v) =+    Bookmark+    <$> parseJSON j+    <*> v .: "bookmark_name"+  parseJSON _ = mzero++data Category = Category {+  category :: Text+, url :: URI+, sounds :: Resource [Bookmark]+} deriving (Eq, Show)++instance FromJSON Category where+  parseJSON (Object v) =+    Category+    <$> v .: "name"+    <*> v .: "url"+    <*> v .: "sounds"+  parseJSON _ = mzero++getSounds :: Category -> Freesound [Bookmark]+getSounds = getResource . sounds

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Bookmark.Internal (+  Categories(..)+) where++import           Control.Monad (mzero)+import           Data.Aeson+import           Sound.Freesound.Bookmark++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++data Categories = Categories {+  numCategories :: Int+, categories :: [Category]+} deriving (Eq, Show)++instance FromJSON Categories where+  parseJSON (Object v) =+    Categories+    <$> v .: "num_results"+    <*> v .: "categories"+  parseJSON _ = mzero

@@ -0,0 +1,45 @@+{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-}+module Sound.Freesound.List (+  List+, Elem(..)+, elems+, numElems+, previous+, next+, getPrevious+, getNext+) where++import Control.Monad (liftM, mzero)+import Data.Aeson+import Data.Text (Text)+import Sound.Freesound.API (Freesound, Resource, getResource)++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++data List a = List {+  elems    :: [a]+, numElems :: Int+, previous :: Maybe (Resource (List a))+, next     :: Maybe (Resource (List a))+} deriving (Eq, Show)++class Elem a where+  elemsFieldName :: a -> Text++instance (Elem a, FromJSON a) => FromJSON (List a) where+  parseJSON (Object v) =+    List+      <$> v .: "results"+      <*> v .: "count"+      <*> v .:? "previous"+      <*> v .:? "next"+  parseJSON _ = mzero++getPrevious :: (Elem a, FromJSON a) => List a -> Freesound (Maybe (List a))+getPrevious = maybe (return Nothing) (liftM Just . getResource) . previous++getNext :: (Elem a, FromJSON a) => List a -> Freesound (Maybe (List a))+getNext = maybe (return Nothing) (liftM Just . getResource) . next

@@ -0,0 +1,24 @@+module Sound.Freesound.Pack (+  Pack(..)+, Packs+, Summary+, Detail+, username+, getSounds+, getSounds_+) where++import Data.Default (def)+import Sound.Freesound.API (Freesound, appendQuery, getResource)+import Sound.Freesound.List (List)+import Sound.Freesound.Pack.Type+import Sound.Freesound.Search (Pagination)+import Sound.Freesound.Sound (Sounds)++type Packs = List Summary++getSounds :: (Pack a) => Pagination -> a -> Freesound Sounds+getSounds p = getResource . appendQuery p . sounds++getSounds_ :: (Pack a) => a -> Freesound Sounds+getSounds_ = getSounds def

@@ -0,0 +1,78 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Pack.Type where++import           Control.Monad (mzero)+import           Data.Aeson (FromJSON(..), Value(..), (.:))+import           Data.Text (Text)+import           Sound.Freesound.API (Resource, URI)+import           Sound.Freesound.List (List, Elem(..))+import qualified Sound.Freesound.Sound as Sound++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++class Pack a where+  -- | The URI for this resource.+  ref :: a -> Resource ()+  -- | The URL for this pack’s page on the Freesound website.+  url :: a -> URI+  -- | The API URI for the pack’s sound collection.+  sounds :: a -> Resource (List Sound.Summary)+  -- | The pack’s name.+  name :: a -> Text+  -- | The date when the pack was created.+  created :: a -> Text+  -- | The number of times the pack was downloaded.+  numDownloads :: a -> Integer++data Summary = Summary {+  pack_ref :: Resource ()             -- ^ The URI for this resource.+, pack_url :: URI                   -- ^ The URL for this pack’s page on the Freesound website.+, pack_sounds :: Resource (List Sound.Summary)           -- ^ The API URI for the pack’s sound collection.+, pack_name :: Text                 -- ^ The pack’s name.+, pack_created :: Text              -- ^ The date when the pack was created.+, pack_num_downloads :: Integer     -- ^ The number of times the pack was downloaded.+} deriving (Eq, Show)++instance Pack Summary where+  ref = pack_ref+  url = pack_url+  sounds = pack_sounds+  name = pack_name+  created = pack_created+  numDownloads = pack_num_downloads++instance FromJSON Summary where+  parseJSON (Object o) =+    Summary+    <$> o .: "ref"+    <*> o .: "url"+    <*> o .: "sounds"+    <*> o .: "name"+    <*> o .: "created"+    <*> o .: "num_downloads"+  parseJSON _ = mzero++instance Elem Summary where+  elemsFieldName _ = "packs"++data Detail = Detail {+  summary :: Summary+, username :: Text         -- ^ A JSON object with the user’s username, url, and ref.+} deriving (Eq, Show)++instance Pack Detail where+  ref = ref . summary+  url = url . summary+  sounds = sounds . summary+  name = name . summary+  created = created . summary+  numDownloads = numDownloads . summary++instance FromJSON Detail where+  parseJSON v@(Object o) =+    Detail+    <$> parseJSON v+    <*> o .: "username"+  parseJSON _ = mzero

@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+module Sound.Freesound.Search (+    SortMethod(..)+  , SortDirection(..)+  , Sorting+  , unsorted+  , sortedBy+  , Pagination(..)+  , module Sound.Freesound.Search.Filter+  , module Sound.Freesound.Search.Numerical+  , module Sound.Freesound.Search.Query+) where++import qualified Data.ByteString.Char8 as BS+import           Data.Default (Default(..))+import           Network.HTTP.Types.QueryLike (QueryLike(..), QueryValueLike(..))+import           Sound.Freesound.Search.Filter+import           Sound.Freesound.Search.Numerical+import           Sound.Freesound.Search.Query++data SortMethod    = Duration | Created | Downloads | Rating deriving (Eq, Show)+data SortDirection = Ascending | Descending deriving (Eq, Show)+data Sorting       = Unsorted | SortedBy SortMethod SortDirection deriving (Eq, Show)++unsorted :: Sorting+unsorted = Unsorted++sortedBy :: SortMethod -> SortDirection -> Sorting+sortedBy = SortedBy++instance Default Sorting where+  def = unsorted++instance QueryValueLike Sorting where+  toQueryValue Unsorted                        = Nothing+  toQueryValue (SortedBy Duration Ascending)   = Just $ BS.pack "duration_asc"+  toQueryValue (SortedBy Duration Descending)  = Just $ BS.pack "duration_desc"+  toQueryValue (SortedBy Created Ascending)    = Just $ BS.pack "created_asc"+  toQueryValue (SortedBy Created Descending)   = Just $ BS.pack "created_desc"+  toQueryValue (SortedBy Downloads Ascending)  = Just $ BS.pack "downloads_asc"+  toQueryValue (SortedBy Downloads Descending) = Just $ BS.pack "downloads_desc"+  toQueryValue (SortedBy Rating Ascending)     = Just $ BS.pack "rating_asc"+  toQueryValue (SortedBy Rating Descending)    = Just $ BS.pack "rating_desc"++data Pagination = Pagination {+  page :: Int+, resultsPerPage :: Int+} deriving (Eq, Show)++instance Default Pagination where+  def = Pagination 0 15++instance QueryLike Pagination where+  toQuery a = toQuery [ if page def == page a+                        then Nothing+                        else Just (BS.pack "p", show (page a + 1))+                      , if resultsPerPage def == resultsPerPage a+                        then Nothing+                        else Just (BS.pack "sounds_per_page", show (resultsPerPage a)) ]

@@ -0,0 +1,215 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Search.Filter (+  Filters+, id+, username+, created+, originalFilename+, description+, tag+, license+, isRemix+, wasRemixed+, pack+, isGeotagged+, fileType+, duration+, bitdepth+, bitrate+, samplerate+, filesize+, channels+, md5+, numDownloads+, avgRating+, numRatings+, comment+, comments+) where++import           Data.Default (Default(..))+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import           Data.Maybe (mapMaybe)+import           Data.Text (Text)+import           Network.HTTP.Types.QueryLike (QueryValueLike(..))+import           Prelude hiding (id)+import           Sound.Freesound.Search.Numerical (Numerical)+import           Sound.Freesound.Sound.Type (FileType, SoundId)++#if __GLASGOW_HASKELL__ < 710+import           Data.Monoid (Monoid(..))+#endif++data License = Attribution | AttributionNoncommercial | CreativeCommons0 deriving (Eq, Show)++instance QueryValueLike License where+  toQueryValue Attribution              = toQueryValue $ BS.pack "Attribution"+  toQueryValue AttributionNoncommercial = toQueryValue $ BS.pack "Attribution Noncommercial"+  toQueryValue CreativeCommons0         = toQueryValue $ BS.pack "Creative Commons 0"++-- | Newtype wrapper for avoiding orphan instance.+newtype F_Bool = F_Bool Bool deriving (Eq, Show)++instance QueryValueLike F_Bool where+  toQueryValue (F_Bool True)  = toQueryValue $ BS.pack "true"+  toQueryValue (F_Bool False) = toQueryValue $ BS.pack "false"++data Filter =+    F_id (Numerical SoundId)  -- integer, sound id on freesound+  | F_username Text  -- string, not tokenized+  | F_created Text  -- date+  | F_original_filename Text --  string, tokenized+  | F_description Text -- string, tokenized+  | F_tag Text+  | F_license License+  | F_is_remix F_Bool+  | F_was_remixed F_Bool+  | F_pack Text+  --pack_tokenized:  string, tokenized+  | F_is_geotagged F_Bool+  | F_type FileType+  | F_duration (Numerical Double) -- duration of sound in seconds+  | F_bitdepth (Numerical Integer) -- WARNING is not to be trusted right now+  | F_bitrate (Numerical Integer) -- WARNING is not to be trusted right now+  | F_samplerate (Numerical Integer)+  | F_filesize (Numerical Integer) -- file size in bytes+  | F_channels (Numerical Integer) -- number of channels in sound, mostly 1 or 2, sometimes more+  | F_md5 Text -- 32-byte md5 hash of file+  | F_num_downloads (Numerical Integer) -- all zero right now (not imported data)+  | F_avg_rating (Numerical Double) -- average rating, from 0 to 5+  | F_num_ratings (Numerical Integer) -- number of ratings+  | F_comment Text -- tokenized+  | F_comments (Numerical Integer) -- number of comments+  deriving (Eq, Show)++mkF :: QueryValueLike a => ByteString -> a -> Maybe ByteString+mkF t = fmap (BS.append (BS.append t ":")) . toQueryValue++instance QueryValueLike Filter where+  toQueryValue filterSpec =+    case filterSpec of+      F_id x -> mkF "id" x+      F_username x -> mkF "username" x+      F_created x -> mkF "created" x+      F_original_filename x -> mkF "original_filename" x+      F_description x -> mkF "description" x+      F_tag x -> mkF "tag" x+      F_license x -> mkF "license" x+      F_is_remix x -> mkF "is_remix" x+      F_was_remixed x -> mkF "was_remixed" x+      F_pack x -> mkF "pack" x+      --F_pack_tokenized: string, tokenized+      F_is_geotagged x -> mkF "is_geotagged" x+      F_type x -> mkF "type" x+      F_duration x -> mkF "duration" x+      F_bitdepth x -> mkF "bitdepth" x+      F_bitrate x -> mkF "bitrate" x+      F_samplerate x -> mkF "samplerate" x+      F_filesize x -> mkF "filesize" x+      F_channels x -> mkF "channels" x+      F_md5 x -> mkF "md5" x+      F_num_downloads x -> mkF "num_downloads" x+      F_avg_rating x -> mkF "avg_rating" x+      F_num_ratings x -> mkF "num_ratings" x+      F_comment x -> mkF "comment" x+      F_comments x -> mkF "comments" x++newtype Filters = Filters [Filter] deriving (Show)++instance Monoid Filters where+  mempty = Filters []+  mappend (Filters a) (Filters b) = Filters (a++b)++instance Default Filters where+  def = mempty++instance QueryValueLike Filters where+  toQueryValue (Filters []) = Nothing+  toQueryValue (Filters fs) = Just $ BS.unwords $ mapMaybe toQueryValue fs++fromFilter :: Filter -> Filters+fromFilter = Filters . (:[])++-- | Sound id on Freesound.+id :: Numerical SoundId -> Filters+id = fromFilter . F_id++username :: Text -> Filters+username = fromFilter . F_username++created :: Text -> Filters+created = fromFilter . F_created++originalFilename :: Text -> Filters+originalFilename = fromFilter . F_original_filename++description :: Text -> Filters+description = fromFilter . F_description++tag :: Text -> Filters+tag = fromFilter . F_tag++license :: License -> Filters+license = fromFilter . F_license++isRemix :: Bool -> Filters+isRemix = fromFilter . F_is_remix . F_Bool++wasRemixed :: Bool -> Filters+wasRemixed = fromFilter . F_was_remixed . F_Bool++pack :: Text -> Filters+pack = fromFilter . F_pack++isGeotagged :: Bool -> Filters+isGeotagged = fromFilter . F_is_geotagged . F_Bool++fileType :: FileType -> Filters+fileType = fromFilter . F_type++-- | Duration of sound in seconds.+duration :: Numerical Double -> Filters+duration = fromFilter . F_duration++-- | WARNING is not to be trusted right now.+bitdepth :: Numerical Integer -> Filters+bitdepth = fromFilter . F_bitdepth++-- | WARNING is not to be trusted right now.+bitrate :: Numerical Integer -> Filters+bitrate = fromFilter . F_bitrate++samplerate :: Numerical Integer -> Filters+samplerate = fromFilter . F_samplerate++-- | File size in bytes.+filesize :: Numerical Integer -> Filters+filesize = fromFilter . F_filesize++-- | Number of channels in sound, mostly 1 or 2, sometimes more.+channels :: Numerical Integer -> Filters+channels = fromFilter . F_channels++-- | 32-byte md5 hash of file.+md5 :: Text -> Filters+md5 = fromFilter . F_md5++-- | All zero right now (not imported data).+numDownloads :: Numerical Integer -> Filters+numDownloads = fromFilter . F_num_downloads++-- | Average rating, from 0 to 5.+avgRating :: Numerical Double -> Filters+avgRating = fromFilter . F_avg_rating++-- | Number of ratings.+numRatings :: Numerical Integer -> Filters+numRatings = fromFilter . F_num_ratings++comment :: Text -> Filters+comment = fromFilter . F_comment++-- | Number of comments.+comments :: Numerical Integer -> Filters+comments = fromFilter . F_comments

@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+module Sound.Freesound.Search.Numerical (+  Numerical+, equals+, between+, lessThan+, greaterThan+) where++import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.Time.Clock as Time+import qualified Data.Time.Format as Time+import           Network.HTTP.Types.QueryLike (QueryValueLike(..))+import           Sound.Freesound.Sound.Type (SoundId, soundIdToInteger)++#if __GLASGOW_HASKELL__ < 710+import           System.Locale (defaultTimeLocale)+#else+import           Data.Time (defaultTimeLocale)+#endif++-- | Numerical constraint.+data Numerical a = Equals a | Between a a | GreaterThan a | LessThan a deriving (Eq, Show)++class NumericalQueryValue a where+  toNumericalQueryValue :: a -> ByteString++instance NumericalQueryValue Double where+  toNumericalQueryValue = BS.pack . show++instance NumericalQueryValue Integer where+  toNumericalQueryValue = BS.pack . show++instance NumericalQueryValue SoundId where+  toNumericalQueryValue = BS.pack . show . soundIdToInteger++instance NumericalQueryValue Time.UTCTime where+  toNumericalQueryValue = BS.pack . Time.formatTime defaultTimeLocale "%FT%H:%M:%S%QZ"++equals :: a -> Numerical a+equals = Equals++between :: Ord a => a -> a -> Numerical a+between a b+  | a <= b = Between a b+  | otherwise = Between b a++greaterThan :: a -> Numerical a+greaterThan = GreaterThan++lessThan :: a -> Numerical a+lessThan = LessThan++wrap :: ByteString -> ByteString -> ByteString+wrap a b = BS.unwords [ BS.pack "[", a, BS.pack "TO", b, BS.pack "]" ]++wildcard :: ByteString+wildcard = BS.pack "*"++instance (NumericalQueryValue a) => QueryValueLike (Numerical a) where+  toQueryValue (Equals a)      = toQueryValue $ toNumericalQueryValue a+  toQueryValue (Between a b)   = toQueryValue $ wrap (toNumericalQueryValue a) (toNumericalQueryValue b)+  toQueryValue (GreaterThan a) = toQueryValue $ wrap (toNumericalQueryValue a) wildcard+  toQueryValue (LessThan a)    = toQueryValue $ wrap wildcard (toNumericalQueryValue a)

@@ -0,0 +1,36 @@+module Sound.Freesound.Search.Query (+    Query+  , include+  , exclude+  , (&)+) where++import       Data.Char (isSpace)+import        Data.Text (Text)+import qualified Data.Text as Text+import        Network.HTTP.Types.QueryLike (QueryValueLike(..))++newtype Query = Query [Term] deriving (Eq, Show)++instance QueryValueLike Query where+  toQueryValue (Query ts) = toQueryValue $ Text.unwords (map f ts)+    where+      quote t+        | Text.any isSpace t = Text.cons '"' (Text.snoc t '"')+        | otherwise = t+      f (Include t) = Text.cons '+' (quote t)+      f (Exclude t) = Text.cons '-' (quote t)++data Term = Include Text | Exclude Text deriving (Eq, Show)++include :: Text -> Query+include string = Query [Include string]++exclude :: Text -> Query+exclude string = Query [Exclude string]++append :: Query -> Query -> Query+append (Query xs) (Query ys) = Query (xs ++ ys)++(&) :: Query -> Query -> Query+(&) = append

@@ -0,0 +1,85 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Sound (+    SoundId+  , FileType(..)+  , Sound(..)+  , Summary+  , Detail+  , Sounds+  , url+  , description+  , geotag+  , created+  , sound_license+  , fileType+  , channels+  , filesize+  , bitrate+  , bitdepth+  , duration+  , samplerate+  , sound_username+  , pack+  , download+  , bookmark+  , previews+  , images+  , numDownloads+  , avgRating+  , numRatings+  , rate+  , comments+  , numComments+  , comment+  , similarSounds+  -- , analysis+  , analysisStats+  , analysisFrames++  , search+  , search_+  , getSimilar+  , getSimilar_+) where++import           Data.Default (def)+import qualified Data.Text as T+import           Network.HTTP.Types.QueryLike (toQuery, toQueryValue)+import           Sound.Freesound.List (List)+import           Sound.Freesound.Search (Filters, Pagination, Query, Sorting)+import           Sound.Freesound.Sound.Type+import           Sound.Freesound.API (Freesound, appendQuery, getResource, resourceURI)++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++type Sounds = List Summary++search :: Pagination -> Sorting -> Filters -> Query -> Freesound Sounds+search p s fs q =+    getResource+  $ resourceURI+    [ "search", "text" ]+    (toQuery p ++ toQuery [ ("q"::T.Text, toQueryValue q)+                          , ("f", toQueryValue fs)+                          , ("s", toQueryValue s) ])++search_ :: Query -> Freesound Sounds+search_ = search def def def++-- | Search for sounds in a certain coordinate region.+-- geotagged :: ...++-- | Content based search.+-- contentSearch :: ...++-- Missing: distance field in the response+getSimilar :: Pagination -> Detail -> Freesound Sounds+getSimilar p = getResource . appendQuery p . similarSounds++getSimilar_ :: Detail -> Freesound Sounds+getSimilar_ = getSimilar def++-- getAnalysisStats+-- getAnalysisFrames

@@ -0,0 +1,227 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.Sound.Type where++import           Control.Monad (mzero)+import           Data.Aeson (FromJSON(..), Value(..), (.:), (.:?))+import qualified Data.ByteString.Char8 as BS+import           Data.Text (Text)+import           Network.HTTP.Types.QueryLike (QueryValueLike(..))+import           Prelude hiding (id)+import           Sound.Freesound.API (Resource, URI)+import           Sound.Freesound.List (List, Elem(..))+-- import qualified Sound.Freesound.User.Type as User++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++newtype SoundId = SoundId Integer+                  deriving (Eq, Ord, Show)++soundIdToInteger :: SoundId -> Integer+soundIdToInteger (SoundId i) = i++instance FromJSON SoundId where+  parseJSON (Number i) = return $ SoundId (truncate i)+  parseJSON _ = mzero++--fromInt :: Int64 -> SoundId+--fromInt = SoundId++data FileType = WAV | AIFF | OGG | MP3 | FLAC+                deriving (Eq, Show)++instance QueryValueLike FileType where+  toQueryValue WAV  = toQueryValue $ BS.pack "wav"+  toQueryValue AIFF = toQueryValue $ BS.pack "aif"+  toQueryValue OGG  = toQueryValue $ BS.pack "ogg"+  toQueryValue MP3  = toQueryValue $ BS.pack "mp3"+  toQueryValue FLAC = toQueryValue $ BS.pack "flac"++instance FromJSON FileType where+  parseJSON (String v) =+    case v of+      "wav"  -> return WAV+      "aiff" -> return AIFF+      "aif"  -> return AIFF+      "ogg"  -> return OGG+      "mp3"  -> return MP3+      "flac" -> return FLAC+      _      -> mzero+  parseJSON _  = mzero++class Sound a where+  -- | The sound’s unique identifier.+  id :: a -> SoundId+  -- | The name user gave to the sound.+  name :: a -> Text+  -- | An array of tags the user gave to the sound.+  tags :: a -> [Text]+  -- | The username of the uploader of the sound.+  username :: a -> Text+  -- | The license under which the sound is available to you.+  license :: a -> License++data License =+    Attribution+  | AttributionNoncommercial+  | CreativeCommons0+  | License Text+  deriving (Eq, Show)++instance FromJSON License where+  parseJSON (String x) =+    case x of+      "Attribution" -> pure Attribution+      "Attribution Noncommercial" -> pure AttributionNoncommercial+      "Creative Commons 0" -> pure CreativeCommons0+      u -> pure $ License u+  parseJSON _ = fail "Invalid license"++data Previews = Previews {+    preview_hq_mp3 :: URI -- ^ The URI for retrieving a high quality (~128kbps) mp3 preview of the sound.+  , preview_lq_mp3 :: URI -- ^ The URI for retrieving a low quality (~64kbps) mp3 preview of the sound.+  , preview_hq_ogg :: URI -- ^ The URI for retrieving a high quality (~192kbps) ogg preview of the sound.+  , preview_lq_ogg :: URI -- ^ The URI for retrieving a low quality (~80kbps) ogg of the sound.+  } deriving (Eq, Show)++instance FromJSON Previews where+  parseJSON (Object v) =+    Previews+      <$> v .: "preview-hq-mp3"+      <*> v .: "preview-lq-mp3"+      <*> v .: "preview-hq-ogg"+      <*> v .: "preview-lq-ogg"+  parseJSON _ = fail "Couldn't parse Previews"++data Images = Images {+    waveform_m :: URI -- ^ A visualization of the sounds waveform, png file (medium).+  , waveform_l :: URI -- ^ A visualization of the sounds waveform, png file (large).+  , spectral_m :: URI -- ^ A visualization of the sounds spectrum over time, jpeg file (medium).+  , spectral_l :: URI -- ^ A visualization of the sounds spectrum over time, jpeg file (large).+  } deriving (Eq, Show)++instance FromJSON Images where+  parseJSON (Object v) =+    Images+      <$> v .: "waveform_m"+      <*> v .: "waveform_l"+      <*> v .: "spectral_m"+      <*> v .: "spectral_l"+  parseJSON _ = fail "Couldn't parse Images"++data Detail = Detail {+    sound_id            :: SoundId      -- ^ The sound’s unique identifier.+  , url                 :: URI          -- ^ The URI for this sound on the Freesound website.+  , sound_name          :: Text         -- ^ The name user gave to the sound.+  , sound_tags          :: [Text]       -- ^ An array of tags the user gave to the sound.+  , description         :: Text         -- ^ The description the user gave to the sound.+  , geotag              :: Maybe GeoTag -- ^ Latitude and longitude of the geotag (only for sounds that have been geotagged).+  , created             :: Text         -- ^ The date of when the sound was uploaded.+  , sound_license       :: License      -- ^ The license under which the sound is available to you.+  , fileType            :: FileType     -- ^ The type of sound (wav, aif, mp3, etc.).+  , channels            :: Int          -- ^ The number of channels.+  , filesize            :: Integer      -- ^ The size of the file in bytes.+  , bitrate             :: Int          -- ^ The bit rate of the sound.+  , bitdepth            :: Int          -- ^ The bit depth of the sound.+  , duration            :: Double       -- ^ The duration of the sound in seconds.+  , samplerate          :: Int          -- ^ The samplerate of the sound.+  , sound_username      :: Text         -- ^ The username of the uploader of the sound.+  , pack                :: Maybe (Resource ()) -- ^ If the sound is part of a pack, this URI points to that pack’s API resource.+  , download            :: URI          -- ^ The URI for retrieving the original sound.+  , bookmark            :: URI          -- ^ The URI for bookmarking the sound.+  , previews            :: Previews     -- ^ Dictionary containing the URIs for mp3 and ogg versions of the sound. The dictionary includes the fields preview-hq-mp3 and preview-lq-mp3 (for ~128kbps quality and ~64kbps quality mp3 respectively), and preview-hq-ogg and preview-lq-ogg (for ~192kbps quality and ~80kbps quality ogg respectively).+  , images              :: Images       -- ^ Dictionary including the URIs for spectrogram and waveform visualizations of the sound. The dinctionary includes the fields waveform_l and waveform_m (for large and medium waveform images respectively), and spectral_l and spectral_m (for large and medium spectrogram images respectively).+  , numDownloads        :: Integer      -- ^ The number of times the sound was downloaded.+  , avgRating           :: Double       -- ^ The average rating of the sound.+  , numRatings          :: Integer      -- ^ The number of times the sound was rated.+  , rate                :: URI          -- ^ The URI for rating the sound.+  , comments            :: Resource ()     -- ^ The URI of a paginated list of the comments of the sound.+  , numComments         :: Integer      -- ^ The number of comments.+  , comment             :: URI          -- ^ The URI to comment the sound.+  , similarSounds       :: Resource (List Summary)     -- ^ URI pointing to the similarity resource (to get a list of similar sounds).+  -- , analysis            :: Maybe+  , analysisStats       :: Resource ()     -- ^ URI pointing to the complete analysis results of the sound.+  , analysisFrames      :: Resource ()    -- ^ The URI for retrieving a JSON file with analysis information for each frame of the sound.+  } deriving (Eq, Show)++instance FromJSON Detail where+  parseJSON (Object v) =+    Detail+      <$> v .: "id"+      <*> v .: "url"+      <*> v .: "name"+      <*> v .: "tags"+      <*> v .: "description"+      <*> v .:? "geotag"+      <*> v .: "created"+      <*> v .: "license"+      <*> v .: "type"+      <*> v .: "channels"+      <*> v .: "filesize"+      <*> v .: "bitrate"+      <*> v .: "bitdepth"+      <*> v .: "duration"+      <*> v .: "samplerate"+      <*> v .: "username"+      <*> v .:? "pack"+      <*> v .: "download"+      <*> v .: "bookmark"+      <*> v .: "previews"+      <*> v .: "images"+      <*> v .: "num_downloads"+      <*> v .: "avg_rating"+      <*> v .: "num_ratings"+      <*> v .: "rate"+      <*> v .: "comments"+      <*> v .: "num_comments"+      <*> v .: "comment"+      <*> v .: "similar_sounds"+      <*> v .: "analysis_stats"+      <*> v .: "analysis_frames"+  parseJSON _ = fail "Couldn't parse Sound"++instance Sound Detail where+  id = sound_id+  name = sound_name+  tags = sound_tags+  username = sound_username+  license = sound_license++data Summary = Summary {+    summary_id :: SoundId+  , summary_name :: Text+  , summary_tags :: [Text]+  , summary_username :: Text+  , summary_license :: License+  } deriving (Eq, Show)++instance FromJSON Summary where+  parseJSON (Object v) =+    Summary+      <$> v .: "id"+      <*> v .: "name"+      <*> v .: "tags"+      <*> v .: "username"+      <*> v .: "license"+  parseJSON _ = fail "Couldn't parse Sound"++instance Sound Summary where+  id = summary_id+  name = summary_name+  tags = summary_tags+  username = summary_username+  license = summary_license++instance Elem Summary where+  elemsFieldName _ = "sounds"++-- | Coordinate+data GeoTag = GeoTag {+  latitude :: Double+, longitude :: Double+} deriving (Eq, Show)++instance FromJSON GeoTag where+  parseJSON (String _) = pure (GeoTag 0 0)+  parseJSON _ = fail "Couldn't parse GeoTag"

@@ -0,0 +1,58 @@+module Sound.Freesound.User (+  User(..)+, Summary+, Detail+, sounds+, packs+, firstName+, lastName+, about+, homePage+, signature+, dateJoined+, bookmarkCategories+, getUser+, getUserByName+, getBookmarkCategories+, getSounds+, getSounds_+, getPacks+) where++import           Control.Monad (liftM)+import           Data.Default (def)+import           Data.Text (Text)+import qualified Data.Text as T+import           Sound.Freesound.API (Freesound, appendQuery, getResource, resourceURI)+import qualified Sound.Freesound.Bookmark as Bookmark+import qualified Sound.Freesound.Bookmark.Internal as Bookmark+import           Sound.Freesound.Pack (Packs)+import           Sound.Freesound.Search (Pagination)+import           Sound.Freesound.Sound (Sounds)+import           Sound.Freesound.User.Type++-- | Get detailed information about a user.+getUser :: (User a) => a -> Freesound Detail+getUser = getResource . ref++-- | Get information about a user by name.+getUserByName :: Text -> Freesound Detail+getUserByName t = getResource $ resourceURI [ T.pack "people", t ] []++-- | Retrieve a list of a user's bookmark categories.+getBookmarkCategories :: Detail -> Freesound [Bookmark.Category]+getBookmarkCategories = liftM Bookmark.categories . getResource . bookmarkCategories++-- | Retrieve a user's sounds.+-- This is broken: the response doesn't contain the User.+getSounds :: Pagination -> Detail -> Freesound Sounds+getSounds p = getResource . appendQuery p . sounds++-- | Retrieve a user's sounds.++getSounds_ :: Detail -> Freesound Sounds+getSounds_ = getSounds def++-- | Retrieve a user's packs.+getPacks :: Detail -> Freesound Packs+getPacks = getResource . packs

@@ -0,0 +1,85 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Sound.Freesound.User.Type where++import           Control.Monad (mzero)+import           Data.Aeson (FromJSON(..), Value(..), (.:))+import           Data.Text (Text)+import qualified Data.Text as T+import           Sound.Freesound.API (Resource, URI)+import qualified Sound.Freesound.Bookmark.Internal as Bookmark+import           Sound.Freesound.List (List)+import qualified Sound.Freesound.Pack.Type as Pack+import qualified Sound.Freesound.Sound.Type as Sound++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative+#endif++-- | User of the Freesound database.+class User a where+  -- | The user’s username.+  name :: a -> Text+  -- | The URI for this resource.+  ref :: a -> Resource Detail+  -- | The profile page for the user on the Freesound website.+  url :: a -> URI++-- | User of the Freesound database.+data Summary = Summary {+  user_name :: Text     -- ^ The user’s username.+, user_ref  :: Resource Detail -- ^ The URI for this resource.+, user_url :: URI       -- ^ The profile page for the user on the Freesound website.+} deriving (Eq, Show)++instance User Summary where+  name = user_name+  ref  = user_ref+  url  = user_url++instance FromJSON Summary where+  parseJSON (Object v) =+    Summary+    <$> v .: "username"+    <*> v .: "ref"+    <*> v .: "url"+  parseJSON _ = mzero++data Detail = Detail {+  summary :: Summary                -- ^ Summary.+, sounds :: Resource (List Sound.Summary)                -- ^ The API URI for this user’s sound collection.+, packs :: Resource (List Pack.Summary)                -- ^ The API URI for this user’s pack collection.+, firstName :: Maybe Text           -- ^ The user’s first name, possibly empty.+, lastName :: Maybe Text            -- ^ The user’s last name, possibly empty.+, about :: Maybe Text               -- ^ A small text the user wrote about himself.+-- FIXME: homePage :: Maybe Data+, homePage :: Maybe Text            -- ^ The user’s homepage, possibly empty.+, signature :: Maybe Text           -- ^ The user’s signature, possibly empty.+, dateJoined :: Text                -- ^ The date the user joined Freesound.+, bookmarkCategories :: Resource Bookmark.Categories+} deriving (Eq, Show)++instance User Detail where+  name = name . summary+  ref  = ref . summary+  url  = url . summary++textToMaybe :: Maybe Text -> Maybe Text+textToMaybe Nothing = Nothing+textToMaybe (Just s)+  | T.null s  = Nothing+  | otherwise = Just s++instance FromJSON Detail where+  parseJSON j@(Object v) =+    Detail+    <$> parseJSON j+    <*> v .: "sounds"+    <*> v .: "packs"+    <*> (textToMaybe <$> (v .: "first_name"))+    <*> (textToMaybe <$> (v .: "last_name"))+    <*> (textToMaybe <$> (v .: "about"))+    <*> (textToMaybe <$> (v .: "home_page"))+    <*> (textToMaybe <$> (v .: "signature"))+    <*> v .: "date_joined"+    <*> v .: "bookmark_categories"+  parseJSON _ = mzero

@@ -0,0 +1,9 @@+module Sound.Freesound.Test (+  fs+) where++import Sound.Freesound+import System.Environment (getEnv)++fs :: Freesound a -> IO a+fs a = flip runFreesound a =<< apiKeyFromString `fmap` getEnv "FREESOUND_API_KEY"

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}