module Sound.Freesound.API (
APIKey
, apiKeyFromString
, Freesound
, runFreesound
, URI
, download
, downloadToFile
, Resource(..)
, resourceURI
, appendQuery
, get
) where
import qualified Blaze.ByteString.Builder as Builder
import qualified Blaze.ByteString.Builder.Char8 as Builder
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Monad.Reader as R
import Control.Lens
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
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
newtype APIKey = APIKey BS.ByteString deriving (Eq, Show)
apiKeyFromString :: String -> APIKey
apiKeyFromString = APIKey . BS.pack
data Env = Env {
apiKey :: APIKey
, session :: Session
}
newtype Freesound a = Freesound (R.ReaderT Env IO a)
deriving (Applicative, Functor, Monad, MonadIO, R.MonadReader Env)
runFreesound :: APIKey -> Freesound a -> IO a
runFreesound k (Freesound m) = Session.withAPISession (R.runReaderT m . Env k)
newtype URI = URI URI.URI deriving (Eq, Show)
instance FromJSON URI where
parseJSON (String v) =
maybe (fail "Couldn't parse URI")
return
(parseURI' (T.unpack v))
parseJSON v = typeMismatch "URI" v
parseURI' :: String -> Maybe URI
parseURI' = fmap URI . URI.parseURI . URI.escapeURIString URI.isAllowedInURI
download :: URI -> Freesound BL.ByteString
download (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
downloadToFile :: FilePath -> URI -> Freesound ()
downloadToFile path uri = liftIO . BL.writeFile path =<< download uri
newtype Resource a = Resource URI deriving (Eq, FromJSON, Show)
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
get :: (FromJSON a) => Resource a -> Freesound a
get (Resource u) = do
handle . eitherDecode <$> download u
where handle = either (\e -> error $ "JSON decoding failed: " ++ e) id
baseURI :: Builder.Builder
baseURI = Builder.fromString "http://www.freesound.org/apiv2"
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