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