spoty (empty) → 0.1.0.0
raw patch · 7 files changed
+569/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, lens, pipes, text, unordered-containers, wreq
Files
- Examples/Albums.hs +11/−0
- Examples/Search.hs +9/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- spoty.cabal +56/−0
- src/Utils/Spoty.hs +170/−0
- src/Utils/Spoty/Types.hs +291/−0
+ Examples/Albums.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Lens+import Pipes+import qualified Pipes.Prelude as P+import Utils.Spoty++-- | Stream all albums in constant space and print the names.+main = runEffect $ getArtistAlbums artist >-> P.map (view name) >-> P.print+ where+ artist = "0LcJLqbBmaGUft1e9Mm8HV"
+ Examples/Search.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Lens (view)+import Utils.Spoty++main = do+ Just artist <- fetchOne (searchArtist "avicii") -- assume at least one match+ popular <- getArtistTop (view spotifyID artist) "SE" -- retrieve the most popular tracks in Sweden+ mapM_ (print . view name) popular -- print the corresponding names
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, David Nilsson++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 David Nilsson 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ spoty.cabal view
@@ -0,0 +1,56 @@+name: spoty+version: 0.1.0.0+synopsis: Spotify web API wrapper+description: + Web API <https://developer.spotify.com/web-api/> wrapper powered by lens and pipes, allowing easy access to public endpoints.+ Does not have any external dependencies nor requirements regarding app registration.+ .+ * Paging is handled transparently using pipes+ .+ * All data types are navigated using lenses+ .+ All public endpoints, with multi-get versions excluded, are implemented.+ .++ > > :set -XOverloadedStrings+ > > :m +Control.Lens Utils.Spoty+ > > Just artist <- fetchOne (searchArtist "avicii") -- assume at least one match+ > > popular <- getArtistTop (view spotifyID artist) "SE" -- retrieve the most popular tracks in Sweden+ > > mapM_ (print . view name) popular -- print the corresponding names+ > "Hey Brother"+ > "Addicted To You"+ > "Wake Me Up"+ > ...+ .+ Please read the README for details.++license: BSD3+license-file: LICENSE+author: David Nilsson+maintainer: nilsson.dd+code@gmail.com+category: Web+build-type: Simple+cabal-version: >=1.10+homepage: https://github.com/davnils/spoty+bug-reports: https://github.com/davnils/spoty/issues+extra-source-files: Examples/Search.hs Examples/Albums.hs++library+ exposed-modules: Utils.Spoty, Utils.Spoty.Types+ build-depends:+ aeson >= 0.7.0.6 && < 0.8,+ base >= 4.6 && < 4.7,+ bytestring >= 0.10 && < 0.11,+ lens >= 4 && < 4.4,+ pipes >= 4.1 && < 4.2,+ text >= 0.11 && < 1.2,+ unordered-containers >= 0.2.3 && < 0.3,+ wreq >= 0.1 && < 0.2++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -O2 -Wall++source-repository head+ type: git+ location: https://github.com/davnils/spoty.git
+ src/Utils/Spoty.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, ScopedTypeVariables #-}++module Utils.Spoty+(+module Utils.Spoty.Types,+getAlbum, getAlbumTracks,+getArtist, getArtistAlbums, CountryID, getArtistTop, getArtistRelated,+SearchCategory(..),+search, searchArtist, searchAlbum, searchTrack,+getTrack,+getUser,+fetchOne, fetchAll+)+where++import Control.Applicative ((<$>))+import Control.Exception (throw)+import Control.Lens+import Control.Monad (when)+import Data.Aeson+import Data.Aeson.Lens (key)+import Data.Aeson.Types (parseMaybe)+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Network.Wreq as W+import qualified Pipes as P+import qualified Pipes.Prelude as P+import Utils.Spoty.Types++baseURL, versionURL :: String+baseURL = "https://api.spotify.com/"+versionURL = "v1/"++-- | Country identifier e.g. \"SE\".+type CountryID = T.Text++-- | Categories being used in a search.+data SearchCategory+ = SearchAlbum -- ^ Search for albums.+ | SearchArtist -- ^ Search for artists.+ | SearchTrack -- ^ Search for tracks.+ deriving (Eq, Ord)++instance Show SearchCategory where+ show SearchAlbum = "album"+ show SearchArtist = "artist"+ show SearchTrack = "track"++-- | Construct a URL from an endpoint and an identifier.+build :: T.Text -> SpotID -> T.Text+build e = build2 e ""++-- | Construct a URL from endpoint / spotify id / subdir.+build2 :: T.Text -> T.Text -> SpotID -> T.Text+build2 endpoint dir arg = T.intercalate "/" [endpoint, arg, dir]++-- | Retrieve an album.+getAlbum :: SpotID -> IO Album+getAlbum = fetch . build "albums"++-- | Retrieve the tracks of an album.+getAlbumTracks :: SpotID -> P.Producer Track IO ()+getAlbumTracks = makeProducer Nothing W.defaults . build2 "albums" "tracks"++-- | Retrieve an artist.+getArtist :: SpotID -> IO Artist+getArtist = fetch . build "artists"++-- | Retrieve the albums of an artist.+getArtistAlbums :: SpotID -> P.Producer Album IO ()+getArtistAlbums = makeProducer Nothing W.defaults . build2 "artists" "albums"++type Predicate a = W.Response BL.ByteString -> IO a++-- | Construct producer (source) from URL generating a paging object.+-- Optionally accepts a predicate applied on the retrieved JSON object.+makeProducer :: FromJSON a => Maybe (Predicate (Paging a)) -> W.Options -> T.Text -> P.Producer a IO ()+makeProducer predicate opts url = go 0+ where+ go off = do+ let opts' = opts & W.param "offset" .~ [T.pack $ show off]+ reply <- P.liftIO $ grab opts' url++ let f = fromMaybe (fmap (^. W.responseBody) . W.asJSON) predicate+ (chunk :: Paging b) <- P.liftIO $ f reply++ mapM_ P.yield $ chunk ^. items++ let delta = length $ chunk ^. items+ off' = off + delta++ when (off' < chunk ^. total) (go off')++-- | Extract the value associated with the given key from a response.+extractInner :: (FromJSON a) => W.Response BL.ByteString -> T.Text -> Maybe a+extractInner raw tag = locate >>= parseMaybe parseJSON+ where+ locate = raw ^? W.responseBody . key tag++-- | Retrieve the most popular tracks of an artist.+getArtistTop :: SpotID -> CountryID -> IO [Track]+getArtistTop artist country = do+ let opts = W.defaults & W.param "country" .~ [country]+ reply <- grab opts $ build2 "artists" "top-tracks" artist+ return . fromMaybe [] $ extractInner reply "tracks"++-- | Retrieve a few related artists.+getArtistRelated :: SpotID -> IO [Artist]+getArtistRelated artist = do+ reply <- grab W.defaults $ build2 "artists" "related-artists" artist+ return . fromMaybe [] $ extractInner reply "artists"++-- | Retrieve a track.+getTrack :: SpotID -> IO Track+getTrack = fetch . build "tracks"++-- | Retrieve an user.+getUser :: T.Text -> IO User+getUser = fetch . build "users"++-- | Search for some string in the given categories.+search :: [SearchCategory] -> T.Text -> (P.Producer Artist IO (), P.Producer Album IO (), P.Producer Track IO ())+search cats term = (extract SearchArtist, extract SearchAlbum, extract SearchTrack)+ where+ opts = W.defaults+ & W.param "q" .~ [term]+ & W.param "type" .~ [T.intercalate "," $ map (T.pack . show) cats]++ pluralize = T.pack . (<> "s") . show+ extract tag = when (tag `elem` cats) (makeProducer (Just $ predicate tag) opts url)+ url = build "search" ""+ predicate tag reply = case extractInner reply (pluralize tag) of+ Just val -> return val+ Nothing -> throw . W.JSONError $ "Unexpected search result, got: " <> show reply++-- | Search for artists.+searchArtist :: T.Text -> P.Producer Artist IO ()+searchArtist = (^. _1) . search [SearchArtist]++-- | Search for albums.+searchAlbum :: T.Text -> P.Producer Album IO ()+searchAlbum = (^. _2) . search [SearchAlbum]++-- | Search for tracks.+searchTrack :: T.Text -> P.Producer Track IO ()+searchTrack = (^. _3) . search [SearchTrack]++-- | Fetch one element from the producer and discard the rest.+fetchOne :: Monad m => P.Producer a m () -> m (Maybe a)+fetchOne = P.head++-- | Fetch all elements from the producer (NOTE: not constant space).+fetchAll :: Monad m => P.Producer a m () -> m [a]+fetchAll = P.toListM++-- | Fetch a path and decode the corresponding object.+fetch :: FromJSON a => T.Text -> IO a+fetch = fetchWith W.defaults++-- | Fetch a path with the given HTTP options and decode the corresponding object.+fetchWith :: FromJSON a => W.Options -> T.Text -> IO a+fetchWith opts path' =+ (^. W.responseBody) <$> (grab opts path' >>= W.asJSON)++-- | Fetch a path with the given HTTP options and return the raw response.+grab :: W.Options -> T.Text -> IO (W.Response BL.ByteString)+grab opts path' =+ W.getWith opts $ baseURL <> versionURL <> T.unpack path'
+ src/Utils/Spoty/Types.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-}++{-|+ Object declarations and lenses. Should not be imported by user code.+ Please view the official documentation.++ Note that the distinction between full and simple objects is implemented as an optional Maybe field with details.+-}++module Utils.Spoty.Types where++import Control.Applicative ((<$>), (<*>))+import Control.Lens (makeFields)+import Control.Monad (MonadPlus(..), mzero)+import Data.Aeson+import Data.Aeson.Types (Parser)+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T++type URL = T.Text++type SpotID = T.Text++type SpotURI = T.Text++-- | Require that a field is present before parsing the corresponding value.+require :: FromJSON a => T.Text -> HM.HashMap T.Text Value -> Parser (Maybe a)+require str obj =+ if HM.member str obj+ then fmap Just (parseJSON $ Object obj)+ else return Nothing++-- | Parse a map of key-value entries, wrapped in the given constructor.+parseStrMap :: MonadPlus m => HM.HashMap k Value -> (k -> T.Text -> a) -> m [a]+parseStrMap vals constr = sequence . flip map (HM.toList vals) $ \e ->+ case e of + (key, String val) -> return $ constr key val+ _ -> mzero++data ExternalID+ = ExternalID+ {+ _idType :: T.Text,+ _idIdentifier :: T.Text+ }+ deriving (Eq, Ord, Show)++makeFields ''ExternalID++instance FromJSON [ExternalID] where+ parseJSON (Object v) = parseStrMap v ExternalID+ parseJSON _ = mzero++data ExternalURL+ = ExternalURL+ {+ _urlType :: T.Text,+ _url :: URL+ }+ deriving (Eq, Ord, Show)++makeFields ''ExternalURL++instance FromJSON [ExternalURL] where+ parseJSON (Object v) = parseStrMap v ExternalURL+ parseJSON _ = mzero++data Image+ = Image+ {+ _imageHeight :: Maybe Int,+ _imagePath :: URL,+ _imageWidth :: Maybe Int+ }+ deriving (Eq, Ord, Show)++makeFields ''Image++instance FromJSON Image where+ parseJSON (Object v) = Image <$>+ v .:? "height" <*>+ v .: "url" <*>+ v .:? "width"++ parseJSON _ = mzero++data Paging a+ = Paging+ {+ _pagingHref :: T.Text,+ _pagingItems :: [a],+ _pagingLimit :: Int,+ _pagingNext :: Maybe URL,+ _pagingOffset :: Int,+ _pagingPrevious :: Maybe URL,+ _pagingTotal :: Int+ }+ deriving (Eq, Ord, Show)++makeFields ''Paging++instance FromJSON a => FromJSON (Paging a) where+ parseJSON (Object v) = Paging <$>+ v .: "href" <*>+ v .: "items" <*>+ v .: "limit" <*>+ v .:? "next" <*>+ v .: "offset" <*>+ v .:? "previous" <*>+ v .: "total"++ parseJSON _ = mzero++data User+ = User+ {+ _userExternalUrls :: [ExternalURL],+ _userHref :: URL,+ _userSpotifyID :: SpotID,+ _userSpotifyURI :: SpotURI+ }+ deriving (Eq, Ord, Show)++makeFields ''User++instance FromJSON User where+ parseJSON (Object v) = User <$>+ v .: "external_urls" <*>+ v .: "href" <*>+ v .: "id" <*>+ v .: "uri"++ parseJSON _ = mzero++data ArtistDetails+ = ArtistDetails+ {+ _artistGenres :: [T.Text],+ _artistImages :: [Image],+ _artistPopularity :: Int+ }+ deriving (Eq, Ord, Show)++makeFields ''ArtistDetails++instance FromJSON ArtistDetails where+ parseJSON (Object v) = ArtistDetails <$>+ v .: "genres" <*>+ v .: "images" <*>+ v .: "popularity"++ parseJSON _ = mzero++data Artist+ = Artist+ {+ _artistExternalUrls :: [ExternalURL],+ _artistHref :: URL,+ _artistSpotifyID :: SpotID,+ _artistName :: T.Text,+ _artistSpotifyURI :: SpotURI,+ _artistDetails :: Maybe ArtistDetails+ }+ deriving (Eq, Ord, Show)++makeFields ''Artist++instance FromJSON Artist where+ parseJSON (Object v) = Artist <$>+ v .: "external_urls" <*>+ v .: "href" <*>+ v .: "id" <*>+ v .: "name" <*>+ v .: "uri" <*> + require "genres" v++ parseJSON _ = mzero++data TrackDetails+ = TrackDetails+ {+ _trackAvailableMarkets :: [T.Text],+ _trackExternalIDs :: [ExternalID],+ _trackPopularity :: Int+ }+ deriving (Eq, Ord, Show)++makeFields ''TrackDetails++instance FromJSON TrackDetails where+ parseJSON (Object v) = TrackDetails <$>+ v .: "available_markets" <*>+ v .: "external_ids" <*>+ v .: "popularity"++ parseJSON _ = mzero++data Track+ = Track+ {+ _trackArtists :: [Artist],+ _trackDiscNumber :: Int,+ _trackDurationMs :: Int,+ _trackExplicit :: Bool,+ _trackExternalUrls :: [ExternalURL],+ _trackHref :: URL,+ _trackSpotifyID :: SpotID,+ _trackName :: T.Text,+ _trackPreviewURL :: URL,+ _trackNumber :: Int,+ _trackSpotifyURI :: SpotURI,+ _trackDetails :: Maybe TrackDetails+ }+ deriving (Eq, Ord, Show)++makeFields ''Track++instance FromJSON Track where+ parseJSON (Object v) = Track <$>+ v .: "artists" <*>+ v .: "disc_number" <*>+ v .: "duration_ms" <*>+ v .: "explicit" <*>+ v .: "external_urls" <*>+ v .: "href" <*>+ v .: "id" <*>+ v .: "name" <*>+ v .: "preview_url" <*>+ v .: "track_number" <*>+ v .: "uri" <*> + require "available_markets" v++ parseJSON _ = mzero++data AlbumDetails+ = AlbumDetails+ {+ _albumArtists :: [Artist],+ _albumExternalIDs :: [ExternalID],+ _albumGenres :: [T.Text],+ _albumPopularity :: Int,+ _albumReleaseDate :: T.Text,+ _albumReleaseDatePrecision :: T.Text,+ _albumTracks :: Paging Track+ }+ deriving (Eq, Ord, Show)++makeFields ''AlbumDetails++instance FromJSON AlbumDetails where+ parseJSON (Object v) = AlbumDetails <$>+ v .: "artists" <*>+ v .: "external_ids" <*>+ v .: "genres" <*>+ v .: "popularity" <*>+ v .: "release_date" <*>+ v .: "release_date_precision" <*>+ v .: "tracks"++ parseJSON _ = mzero++data Album+ = Album+ {+ _albumType :: T.Text,+ _albumAvailableMarkets :: [T.Text],+ _albumExternalURLs :: [ExternalURL],+ _albumHref :: T.Text,+ _albumSpotifyID :: SpotID,+ _albumImages :: [Image],+ _albumName :: T.Text,+ _albumSpotifyURI :: SpotURI,+ _albumDetails :: Maybe AlbumDetails+ }+ deriving (Eq, Ord, Show)++makeFields ''Album++instance FromJSON Album where+ parseJSON (Object v) = Album <$>+ v .: "album_type" <*>+ v .: "available_markets" <*>+ v .: "external_urls" <*>+ v .: "href" <*>+ v .: "id" <*>+ v .: "images" <*>+ v .: "name" <*>+ v .: "uri" <*>+ require "artists" v++ parseJSON _ = mzero