module Spotify.Types.Search where import Spotify.Types.Artists import Spotify.Types.Internal.CustomJSON import Spotify.Types.Misc import Spotify.Types.Simple import Spotify.Types.Tracks import Data.Aeson (FromJSON, Value) import Data.Text qualified as T import GHC.Generics (Generic) import Servant.API (ToHttpApiData (toUrlPiece)) data SearchType = AlbumSearch | ArtistSearch | PlaylistSearch | TrackSearch | ShowSearch | EpisodeSearch | AudiobookSearch deriving (SearchType -> SearchType -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: SearchType -> SearchType -> Bool $c/= :: SearchType -> SearchType -> Bool == :: SearchType -> SearchType -> Bool $c== :: SearchType -> SearchType -> Bool Eq, Eq SearchType SearchType -> SearchType -> Bool SearchType -> SearchType -> Ordering SearchType -> SearchType -> SearchType forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: SearchType -> SearchType -> SearchType $cmin :: SearchType -> SearchType -> SearchType max :: SearchType -> SearchType -> SearchType $cmax :: SearchType -> SearchType -> SearchType >= :: SearchType -> SearchType -> Bool $c>= :: SearchType -> SearchType -> Bool > :: SearchType -> SearchType -> Bool $c> :: SearchType -> SearchType -> Bool <= :: SearchType -> SearchType -> Bool $c<= :: SearchType -> SearchType -> Bool < :: SearchType -> SearchType -> Bool $c< :: SearchType -> SearchType -> Bool compare :: SearchType -> SearchType -> Ordering $ccompare :: SearchType -> SearchType -> Ordering Ord, Int -> SearchType -> ShowS [SearchType] -> ShowS SearchType -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [SearchType] -> ShowS $cshowList :: [SearchType] -> ShowS show :: SearchType -> String $cshow :: SearchType -> String showsPrec :: Int -> SearchType -> ShowS $cshowsPrec :: Int -> SearchType -> ShowS Show, ReadPrec [SearchType] ReadPrec SearchType Int -> ReadS SearchType ReadS [SearchType] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [SearchType] $creadListPrec :: ReadPrec [SearchType] readPrec :: ReadPrec SearchType $creadPrec :: ReadPrec SearchType readList :: ReadS [SearchType] $creadList :: ReadS [SearchType] readsPrec :: Int -> ReadS SearchType $creadsPrec :: Int -> ReadS SearchType Read, forall x. Rep SearchType x -> SearchType forall x. SearchType -> Rep SearchType x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep SearchType x -> SearchType $cfrom :: forall x. SearchType -> Rep SearchType x Generic) instance ToHttpApiData [SearchType] where toUrlPiece :: [SearchType] -> Text toUrlPiece = Text -> [Text] -> Text T.intercalate Text "," forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map \case SearchType AlbumSearch -> Text "album" SearchType ArtistSearch -> Text "artist" SearchType PlaylistSearch -> Text "playlist" SearchType TrackSearch -> Text "track" SearchType ShowSearch -> Text "show" SearchType EpisodeSearch -> Text "episode" SearchType AudiobookSearch -> Text "audiobook" data SearchResult = SearchResult { SearchResult -> Maybe (Paging Track) tracks :: Maybe (Paging Track) , SearchResult -> Maybe (Paging Artist) artists :: Maybe (Paging Artist) , SearchResult -> Maybe (Paging AlbumSimple) albums :: Maybe (Paging AlbumSimple) , SearchResult -> Maybe (Paging PlaylistSimple) playlists :: Maybe (Paging PlaylistSimple) , SearchResult -> Maybe (Paging Value) shows :: Maybe (Paging Value) , SearchResult -> Maybe (Paging Value) episodes :: Maybe (Paging Value) , SearchResult -> Maybe (Paging Value) audiobooks :: Maybe (Paging Value) } deriving (SearchResult -> SearchResult -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: SearchResult -> SearchResult -> Bool $c/= :: SearchResult -> SearchResult -> Bool == :: SearchResult -> SearchResult -> Bool $c== :: SearchResult -> SearchResult -> Bool Eq, Eq SearchResult SearchResult -> SearchResult -> Bool SearchResult -> SearchResult -> Ordering SearchResult -> SearchResult -> SearchResult forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: SearchResult -> SearchResult -> SearchResult $cmin :: SearchResult -> SearchResult -> SearchResult max :: SearchResult -> SearchResult -> SearchResult $cmax :: SearchResult -> SearchResult -> SearchResult >= :: SearchResult -> SearchResult -> Bool $c>= :: SearchResult -> SearchResult -> Bool > :: SearchResult -> SearchResult -> Bool $c> :: SearchResult -> SearchResult -> Bool <= :: SearchResult -> SearchResult -> Bool $c<= :: SearchResult -> SearchResult -> Bool < :: SearchResult -> SearchResult -> Bool $c< :: SearchResult -> SearchResult -> Bool compare :: SearchResult -> SearchResult -> Ordering $ccompare :: SearchResult -> SearchResult -> Ordering Ord, Int -> SearchResult -> ShowS [SearchResult] -> ShowS SearchResult -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [SearchResult] -> ShowS $cshowList :: [SearchResult] -> ShowS show :: SearchResult -> String $cshow :: SearchResult -> String showsPrec :: Int -> SearchResult -> ShowS $cshowsPrec :: Int -> SearchResult -> ShowS Show, forall x. Rep SearchResult x -> SearchResult forall x. SearchResult -> Rep SearchResult x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep SearchResult x -> SearchResult $cfrom :: forall x. SearchResult -> Rep SearchResult x Generic) deriving (Value -> Parser [SearchResult] Value -> Parser SearchResult forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [SearchResult] $cparseJSONList :: Value -> Parser [SearchResult] parseJSON :: Value -> Parser SearchResult $cparseJSON :: Value -> Parser SearchResult FromJSON) via CustomJSON SearchResult