{-# LANGUAGE OverloadedStrings #-} module Network.Protocol.MusicBrainz.Types ( MBID(..) , Release(..) , TextRepresentation(..) , Medium(..) , Track(..) , Recording(..) , ArtistCredit(..) , Artist(..) , ReleaseGroup(..) , LabelInfo(..) , Label(..) , ReleaseEvent(..) , Area(..) , ISO3166Code(..) , CoverArtArchive(..) ) where import Data.Text (Text) import Data.Time.Calendar (Day) import Data.Vector (Vector) import Control.Applicative ((<$>), (<*>)) import Control.Monad (mzero) import Data.Aeson (FromJSON(..), (.:), (.:?), Value(..)) import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Time.Format (parseTimeM) import Data.Time.Locale.Compat (defaultTimeLocale) newtype MBID = MBID { MBID -> Text unMBID :: Text } deriving (MBID -> MBID -> Bool (MBID -> MBID -> Bool) -> (MBID -> MBID -> Bool) -> Eq MBID forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: MBID -> MBID -> Bool $c/= :: MBID -> MBID -> Bool == :: MBID -> MBID -> Bool $c== :: MBID -> MBID -> Bool Eq, Int -> MBID -> ShowS [MBID] -> ShowS MBID -> String (Int -> MBID -> ShowS) -> (MBID -> String) -> ([MBID] -> ShowS) -> Show MBID forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [MBID] -> ShowS $cshowList :: [MBID] -> ShowS show :: MBID -> String $cshow :: MBID -> String showsPrec :: Int -> MBID -> ShowS $cshowsPrec :: Int -> MBID -> ShowS Show) data Release = Release { Release -> MBID _releaseId :: MBID , Release -> Text _releaseTitle :: Text , Release -> Maybe Text _releaseStatus :: Maybe Text , Release -> Maybe Text _releaseQuality :: Maybe Text , Release -> Maybe Text _releasePackaging :: Maybe Text , Release -> Maybe TextRepresentation _releaseTextRepresentation :: Maybe TextRepresentation , Release -> [ArtistCredit] _releaseArtistCredit :: [ArtistCredit] , Release -> Maybe Day _releaseDate :: Maybe Day , Release -> Maybe Text _releaseCountry :: Maybe Text , Release -> [ReleaseEvent] _releaseEvents :: [ReleaseEvent] , Release -> Maybe Text _releaseBarcode :: Maybe Text , Release -> Maybe Text _releaseASIN :: Maybe Text , Release -> Maybe CoverArtArchive _releaseCoverArtArchive :: Maybe CoverArtArchive , Release -> Vector Medium _releaseMedia :: Vector Medium } deriving (Release -> Release -> Bool (Release -> Release -> Bool) -> (Release -> Release -> Bool) -> Eq Release forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Release -> Release -> Bool $c/= :: Release -> Release -> Bool == :: Release -> Release -> Bool $c== :: Release -> Release -> Bool Eq, Int -> Release -> ShowS [Release] -> ShowS Release -> String (Int -> Release -> ShowS) -> (Release -> String) -> ([Release] -> ShowS) -> Show Release forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Release] -> ShowS $cshowList :: [Release] -> ShowS show :: Release -> String $cshow :: Release -> String showsPrec :: Int -> Release -> ShowS $cshowsPrec :: Int -> Release -> ShowS Show) instance FromJSON Release where parseJSON :: Value -> Parser Release parseJSON (Object v :: Object v) = MBID -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release Release (MBID -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser MBID -> Parser (Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text -> MBID MBID (Text -> MBID) -> Parser Text -> Parser MBID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "id") Parser (Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser Text -> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "title" Parser (Maybe Text -> Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "status" Parser (Maybe Text -> Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "quality" Parser (Maybe Text -> Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser (Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "packaging" Parser (Maybe TextRepresentation -> [ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe TextRepresentation) -> Parser ([ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe TextRepresentation) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "text-representation" Parser ([ArtistCredit] -> Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser [ArtistCredit] -> Parser (Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser [ArtistCredit] forall a. FromJSON a => Object -> Text -> Parser a .: "artist-credit" Parser (Maybe Day -> Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Day) -> Parser (Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ((Bool -> TimeLocale -> String -> String -> Maybe Day forall (m :: * -> *) t. (MonadFail m, ParseTime t) => Bool -> TimeLocale -> String -> String -> m t parseTimeM Bool True TimeLocale defaultTimeLocale "%Y-%m-%d" (String -> Maybe Day) -> (Text -> String) -> Text -> Maybe Day forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack (Text -> Maybe Day) -> Maybe Text -> Maybe Day forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<) (Maybe Text -> Maybe Day) -> Parser (Maybe Text) -> Parser (Maybe Day) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "date") Parser (Maybe Text -> [ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser ([ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "country" Parser ([ReleaseEvent] -> Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser [ReleaseEvent] -> Parser (Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser [ReleaseEvent] forall a. FromJSON a => Object -> Text -> Parser a .: "release-events" Parser (Maybe Text -> Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "barcode" Parser (Maybe Text -> Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe Text) -> Parser (Maybe CoverArtArchive -> Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "asin" Parser (Maybe CoverArtArchive -> Vector Medium -> Release) -> Parser (Maybe CoverArtArchive) -> Parser (Vector Medium -> Release) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe CoverArtArchive) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "cover-art-archive" Parser (Vector Medium -> Release) -> Parser (Vector Medium) -> Parser Release forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Vector Medium) forall a. FromJSON a => Object -> Text -> Parser a .: "media" parseJSON _ = Parser Release forall (m :: * -> *) a. MonadPlus m => m a mzero data TextRepresentation = TextRepresentation { TextRepresentation -> Maybe Text _textRepLanguage :: Maybe Text , TextRepresentation -> Maybe Text _textRepScript :: Maybe Text } deriving (TextRepresentation -> TextRepresentation -> Bool (TextRepresentation -> TextRepresentation -> Bool) -> (TextRepresentation -> TextRepresentation -> Bool) -> Eq TextRepresentation forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TextRepresentation -> TextRepresentation -> Bool $c/= :: TextRepresentation -> TextRepresentation -> Bool == :: TextRepresentation -> TextRepresentation -> Bool $c== :: TextRepresentation -> TextRepresentation -> Bool Eq, Int -> TextRepresentation -> ShowS [TextRepresentation] -> ShowS TextRepresentation -> String (Int -> TextRepresentation -> ShowS) -> (TextRepresentation -> String) -> ([TextRepresentation] -> ShowS) -> Show TextRepresentation forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [TextRepresentation] -> ShowS $cshowList :: [TextRepresentation] -> ShowS show :: TextRepresentation -> String $cshow :: TextRepresentation -> String showsPrec :: Int -> TextRepresentation -> ShowS $cshowsPrec :: Int -> TextRepresentation -> ShowS Show) instance FromJSON TextRepresentation where parseJSON :: Value -> Parser TextRepresentation parseJSON (Object v :: Object v) = Maybe Text -> Maybe Text -> TextRepresentation TextRepresentation (Maybe Text -> Maybe Text -> TextRepresentation) -> Parser (Maybe Text) -> Parser (Maybe Text -> TextRepresentation) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "language" Parser (Maybe Text -> TextRepresentation) -> Parser (Maybe Text) -> Parser TextRepresentation forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "script" parseJSON _ = Parser TextRepresentation forall (m :: * -> *) a. MonadPlus m => m a mzero data Medium = Medium { Medium -> Maybe Text _mediumTitle :: Maybe Text , Medium -> Maybe Integer _mediumPosition :: Maybe Integer , Medium -> Maybe Text _mediumFormat :: Maybe Text , Medium -> Integer _mediumTrackCount :: Integer , Medium -> Maybe Integer _mediumTrackOffset :: Maybe Integer , Medium -> Maybe [Track] _mediumTrackList :: Maybe [Track] } deriving (Medium -> Medium -> Bool (Medium -> Medium -> Bool) -> (Medium -> Medium -> Bool) -> Eq Medium forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Medium -> Medium -> Bool $c/= :: Medium -> Medium -> Bool == :: Medium -> Medium -> Bool $c== :: Medium -> Medium -> Bool Eq, Int -> Medium -> ShowS [Medium] -> ShowS Medium -> String (Int -> Medium -> ShowS) -> (Medium -> String) -> ([Medium] -> ShowS) -> Show Medium forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Medium] -> ShowS $cshowList :: [Medium] -> ShowS show :: Medium -> String $cshow :: Medium -> String showsPrec :: Int -> Medium -> ShowS $cshowsPrec :: Int -> Medium -> ShowS Show) instance FromJSON Medium where parseJSON :: Value -> Parser Medium parseJSON (Object v :: Object v) = Maybe Text -> Maybe Integer -> Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium Medium (Maybe Text -> Maybe Integer -> Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium) -> Parser (Maybe Text) -> Parser (Maybe Integer -> Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "title" Parser (Maybe Integer -> Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium) -> Parser (Maybe Integer) -> Parser (Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "position" Parser (Maybe Text -> Integer -> Maybe Integer -> Maybe [Track] -> Medium) -> Parser (Maybe Text) -> Parser (Integer -> Maybe Integer -> Maybe [Track] -> Medium) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "format" Parser (Integer -> Maybe Integer -> Maybe [Track] -> Medium) -> Parser Integer -> Parser (Maybe Integer -> Maybe [Track] -> Medium) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser Integer forall a. FromJSON a => Object -> Text -> Parser a .: "track-count" Parser (Maybe Integer -> Maybe [Track] -> Medium) -> Parser (Maybe Integer) -> Parser (Maybe [Track] -> Medium) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "track-offset" Parser (Maybe [Track] -> Medium) -> Parser (Maybe [Track]) -> Parser Medium forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe [Track]) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "tracks" parseJSON _ = Parser Medium forall (m :: * -> *) a. MonadPlus m => m a mzero data Track = Track { Track -> MBID _trackId :: MBID , Track -> [ArtistCredit] _trackArtistCredit :: [ArtistCredit] , Track -> Maybe Integer _trackPosition :: Maybe Integer , Track -> Maybe Text _trackNumber :: Maybe Text , Track -> Maybe Integer _trackLength :: Maybe Integer , Track -> Recording _trackRecording :: Recording } deriving (Track -> Track -> Bool (Track -> Track -> Bool) -> (Track -> Track -> Bool) -> Eq Track forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Track -> Track -> Bool $c/= :: Track -> Track -> Bool == :: Track -> Track -> Bool $c== :: Track -> Track -> Bool Eq, Int -> Track -> ShowS [Track] -> ShowS Track -> String (Int -> Track -> ShowS) -> (Track -> String) -> ([Track] -> ShowS) -> Show Track forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Track] -> ShowS $cshowList :: [Track] -> ShowS show :: Track -> String $cshow :: Track -> String showsPrec :: Int -> Track -> ShowS $cshowsPrec :: Int -> Track -> ShowS Show) instance FromJSON Track where parseJSON :: Value -> Parser Track parseJSON (Object v :: Object v) = MBID -> [ArtistCredit] -> Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track Track (MBID -> [ArtistCredit] -> Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track) -> Parser MBID -> Parser ([ArtistCredit] -> Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text -> MBID MBID (Text -> MBID) -> Parser Text -> Parser MBID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "id") Parser ([ArtistCredit] -> Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track) -> Parser [ArtistCredit] -> Parser (Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser [ArtistCredit] forall a. FromJSON a => Object -> Text -> Parser a .: "artist-credit" Parser (Maybe Integer -> Maybe Text -> Maybe Integer -> Recording -> Track) -> Parser (Maybe Integer) -> Parser (Maybe Text -> Maybe Integer -> Recording -> Track) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "position" Parser (Maybe Text -> Maybe Integer -> Recording -> Track) -> Parser (Maybe Text) -> Parser (Maybe Integer -> Recording -> Track) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "number" Parser (Maybe Integer -> Recording -> Track) -> Parser (Maybe Integer) -> Parser (Recording -> Track) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "length" Parser (Recording -> Track) -> Parser Recording -> Parser Track forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser Recording forall a. FromJSON a => Object -> Text -> Parser a .: "recording" parseJSON _ = Parser Track forall (m :: * -> *) a. MonadPlus m => m a mzero data Recording = Recording { Recording -> MBID _recordingId :: MBID , Recording -> Maybe Text _recordingTitle :: Maybe Text , Recording -> Maybe Integer _recordingLength :: Maybe Integer , Recording -> [ArtistCredit] _recordingArtistCredit :: [ArtistCredit] } deriving (Recording -> Recording -> Bool (Recording -> Recording -> Bool) -> (Recording -> Recording -> Bool) -> Eq Recording forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Recording -> Recording -> Bool $c/= :: Recording -> Recording -> Bool == :: Recording -> Recording -> Bool $c== :: Recording -> Recording -> Bool Eq, Int -> Recording -> ShowS [Recording] -> ShowS Recording -> String (Int -> Recording -> ShowS) -> (Recording -> String) -> ([Recording] -> ShowS) -> Show Recording forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Recording] -> ShowS $cshowList :: [Recording] -> ShowS show :: Recording -> String $cshow :: Recording -> String showsPrec :: Int -> Recording -> ShowS $cshowsPrec :: Int -> Recording -> ShowS Show) instance FromJSON Recording where parseJSON :: Value -> Parser Recording parseJSON (Object v :: Object v) = MBID -> Maybe Text -> Maybe Integer -> [ArtistCredit] -> Recording Recording (MBID -> Maybe Text -> Maybe Integer -> [ArtistCredit] -> Recording) -> Parser MBID -> Parser (Maybe Text -> Maybe Integer -> [ArtistCredit] -> Recording) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text -> MBID MBID (Text -> MBID) -> Parser Text -> Parser MBID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "id") Parser (Maybe Text -> Maybe Integer -> [ArtistCredit] -> Recording) -> Parser (Maybe Text) -> Parser (Maybe Integer -> [ArtistCredit] -> Recording) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "title" Parser (Maybe Integer -> [ArtistCredit] -> Recording) -> Parser (Maybe Integer) -> Parser ([ArtistCredit] -> Recording) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "length" Parser ([ArtistCredit] -> Recording) -> Parser [ArtistCredit] -> Parser Recording forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser [ArtistCredit] forall a. FromJSON a => Object -> Text -> Parser a .: "artist-credit" parseJSON _ = Parser Recording forall (m :: * -> *) a. MonadPlus m => m a mzero data ArtistCredit = ArtistCredit { ArtistCredit -> Artist _artistCreditArtist :: Artist , ArtistCredit -> Maybe Text _artistCreditJoinPhrase :: Maybe Text , ArtistCredit -> Maybe Text _artistCreditName :: Maybe Text } deriving (ArtistCredit -> ArtistCredit -> Bool (ArtistCredit -> ArtistCredit -> Bool) -> (ArtistCredit -> ArtistCredit -> Bool) -> Eq ArtistCredit forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ArtistCredit -> ArtistCredit -> Bool $c/= :: ArtistCredit -> ArtistCredit -> Bool == :: ArtistCredit -> ArtistCredit -> Bool $c== :: ArtistCredit -> ArtistCredit -> Bool Eq, Int -> ArtistCredit -> ShowS [ArtistCredit] -> ShowS ArtistCredit -> String (Int -> ArtistCredit -> ShowS) -> (ArtistCredit -> String) -> ([ArtistCredit] -> ShowS) -> Show ArtistCredit forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ArtistCredit] -> ShowS $cshowList :: [ArtistCredit] -> ShowS show :: ArtistCredit -> String $cshow :: ArtistCredit -> String showsPrec :: Int -> ArtistCredit -> ShowS $cshowsPrec :: Int -> ArtistCredit -> ShowS Show) instance FromJSON ArtistCredit where parseJSON :: Value -> Parser ArtistCredit parseJSON (Object v :: Object v) = Artist -> Maybe Text -> Maybe Text -> ArtistCredit ArtistCredit (Artist -> Maybe Text -> Maybe Text -> ArtistCredit) -> Parser Artist -> Parser (Maybe Text -> Maybe Text -> ArtistCredit) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Artist forall a. FromJSON a => Object -> Text -> Parser a .: "artist" Parser (Maybe Text -> Maybe Text -> ArtistCredit) -> Parser (Maybe Text) -> Parser (Maybe Text -> ArtistCredit) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "joinphrase" Parser (Maybe Text -> ArtistCredit) -> Parser (Maybe Text) -> Parser ArtistCredit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "name" parseJSON _ = Parser ArtistCredit forall (m :: * -> *) a. MonadPlus m => m a mzero data Artist = Artist { Artist -> MBID _artistId :: MBID , Artist -> Maybe Text _artistName :: Maybe Text , Artist -> Maybe Text _artistSortName :: Maybe Text , Artist -> Maybe Text _artistDisambiguation :: Maybe Text } deriving (Artist -> Artist -> Bool (Artist -> Artist -> Bool) -> (Artist -> Artist -> Bool) -> Eq Artist forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Artist -> Artist -> Bool $c/= :: Artist -> Artist -> Bool == :: Artist -> Artist -> Bool $c== :: Artist -> Artist -> Bool Eq, Int -> Artist -> ShowS [Artist] -> ShowS Artist -> String (Int -> Artist -> ShowS) -> (Artist -> String) -> ([Artist] -> ShowS) -> Show Artist forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Artist] -> ShowS $cshowList :: [Artist] -> ShowS show :: Artist -> String $cshow :: Artist -> String showsPrec :: Int -> Artist -> ShowS $cshowsPrec :: Int -> Artist -> ShowS Show) instance FromJSON Artist where parseJSON :: Value -> Parser Artist parseJSON (Object v :: Object v) = MBID -> Maybe Text -> Maybe Text -> Maybe Text -> Artist Artist (MBID -> Maybe Text -> Maybe Text -> Maybe Text -> Artist) -> Parser MBID -> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Artist) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text -> MBID MBID (Text -> MBID) -> Parser Text -> Parser MBID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "id") Parser (Maybe Text -> Maybe Text -> Maybe Text -> Artist) -> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe Text -> Artist) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "name" Parser (Maybe Text -> Maybe Text -> Artist) -> Parser (Maybe Text) -> Parser (Maybe Text -> Artist) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "sort-name" Parser (Maybe Text -> Artist) -> Parser (Maybe Text) -> Parser Artist forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "disambiguation" parseJSON _ = Parser Artist forall (m :: * -> *) a. MonadPlus m => m a mzero data ReleaseGroup = ReleaseGroup { ReleaseGroup -> MBID _releaseGroupId :: MBID , ReleaseGroup -> Text _releaseGroupType :: Text , ReleaseGroup -> Maybe Text _releaseGroupTitle :: Maybe Text , ReleaseGroup -> Maybe Text _releaseGroupFirstReleaseDate :: Maybe Text , ReleaseGroup -> Maybe Text _releaseGroupPrimaryType :: Maybe Text , ReleaseGroup -> [ArtistCredit] _releaseGroupArtistCredit :: [ArtistCredit] } deriving (ReleaseGroup -> ReleaseGroup -> Bool (ReleaseGroup -> ReleaseGroup -> Bool) -> (ReleaseGroup -> ReleaseGroup -> Bool) -> Eq ReleaseGroup forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ReleaseGroup -> ReleaseGroup -> Bool $c/= :: ReleaseGroup -> ReleaseGroup -> Bool == :: ReleaseGroup -> ReleaseGroup -> Bool $c== :: ReleaseGroup -> ReleaseGroup -> Bool Eq, Int -> ReleaseGroup -> ShowS [ReleaseGroup] -> ShowS ReleaseGroup -> String (Int -> ReleaseGroup -> ShowS) -> (ReleaseGroup -> String) -> ([ReleaseGroup] -> ShowS) -> Show ReleaseGroup forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ReleaseGroup] -> ShowS $cshowList :: [ReleaseGroup] -> ShowS show :: ReleaseGroup -> String $cshow :: ReleaseGroup -> String showsPrec :: Int -> ReleaseGroup -> ShowS $cshowsPrec :: Int -> ReleaseGroup -> ShowS Show) data LabelInfo = LabelInfo { LabelInfo -> Maybe Text _labelInfoCatalogNumber :: Maybe Text , LabelInfo -> Label _labelInfoLabel :: Label } deriving (LabelInfo -> LabelInfo -> Bool (LabelInfo -> LabelInfo -> Bool) -> (LabelInfo -> LabelInfo -> Bool) -> Eq LabelInfo forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: LabelInfo -> LabelInfo -> Bool $c/= :: LabelInfo -> LabelInfo -> Bool == :: LabelInfo -> LabelInfo -> Bool $c== :: LabelInfo -> LabelInfo -> Bool Eq, Int -> LabelInfo -> ShowS [LabelInfo] -> ShowS LabelInfo -> String (Int -> LabelInfo -> ShowS) -> (LabelInfo -> String) -> ([LabelInfo] -> ShowS) -> Show LabelInfo forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [LabelInfo] -> ShowS $cshowList :: [LabelInfo] -> ShowS show :: LabelInfo -> String $cshow :: LabelInfo -> String showsPrec :: Int -> LabelInfo -> ShowS $cshowsPrec :: Int -> LabelInfo -> ShowS Show) data Label = Label { Label -> MBID _labelId :: MBID , Label -> Maybe Text _labelName :: Maybe Text , Label -> Maybe Text _labelSortName :: Maybe Text , Label -> Maybe Text _labelLabelCode :: Maybe Text } deriving (Label -> Label -> Bool (Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Label -> Label -> Bool $c/= :: Label -> Label -> Bool == :: Label -> Label -> Bool $c== :: Label -> Label -> Bool Eq, Int -> Label -> ShowS [Label] -> ShowS Label -> String (Int -> Label -> ShowS) -> (Label -> String) -> ([Label] -> ShowS) -> Show Label forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Label] -> ShowS $cshowList :: [Label] -> ShowS show :: Label -> String $cshow :: Label -> String showsPrec :: Int -> Label -> ShowS $cshowsPrec :: Int -> Label -> ShowS Show) data ReleaseEvent = ReleaseEvent { ReleaseEvent -> Maybe Day _releaseEventDate :: Maybe Day , ReleaseEvent -> Maybe Area _releaseEventArea :: Maybe Area } deriving (ReleaseEvent -> ReleaseEvent -> Bool (ReleaseEvent -> ReleaseEvent -> Bool) -> (ReleaseEvent -> ReleaseEvent -> Bool) -> Eq ReleaseEvent forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ReleaseEvent -> ReleaseEvent -> Bool $c/= :: ReleaseEvent -> ReleaseEvent -> Bool == :: ReleaseEvent -> ReleaseEvent -> Bool $c== :: ReleaseEvent -> ReleaseEvent -> Bool Eq, Int -> ReleaseEvent -> ShowS [ReleaseEvent] -> ShowS ReleaseEvent -> String (Int -> ReleaseEvent -> ShowS) -> (ReleaseEvent -> String) -> ([ReleaseEvent] -> ShowS) -> Show ReleaseEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ReleaseEvent] -> ShowS $cshowList :: [ReleaseEvent] -> ShowS show :: ReleaseEvent -> String $cshow :: ReleaseEvent -> String showsPrec :: Int -> ReleaseEvent -> ShowS $cshowsPrec :: Int -> ReleaseEvent -> ShowS Show) instance FromJSON ReleaseEvent where parseJSON :: Value -> Parser ReleaseEvent parseJSON (Object v :: Object v) = Maybe Day -> Maybe Area -> ReleaseEvent ReleaseEvent (Maybe Day -> Maybe Area -> ReleaseEvent) -> Parser (Maybe Day) -> Parser (Maybe Area -> ReleaseEvent) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ((Bool -> TimeLocale -> String -> String -> Maybe Day forall (m :: * -> *) t. (MonadFail m, ParseTime t) => Bool -> TimeLocale -> String -> String -> m t parseTimeM Bool True TimeLocale defaultTimeLocale "%Y-%m-%d" (String -> Maybe Day) -> (Text -> String) -> Text -> Maybe Day forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack (Text -> Maybe Day) -> Maybe Text -> Maybe Day forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<) (Maybe Text -> Maybe Day) -> Parser (Maybe Text) -> Parser (Maybe Day) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "date") Parser (Maybe Area -> ReleaseEvent) -> Parser (Maybe Area) -> Parser ReleaseEvent forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Area) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "area" parseJSON _ = Parser ReleaseEvent forall (m :: * -> *) a. MonadPlus m => m a mzero data Area = Area { Area -> MBID _areaId :: MBID , Area -> Maybe Text _areaName :: Maybe Text , Area -> Maybe Text _areaSortName :: Maybe Text , Area -> [ISO3166Code] _areaISO3166_1Codes :: [ISO3166Code] , Area -> [ISO3166Code] _areaISO3166_2Codes :: [ISO3166Code] , Area -> [ISO3166Code] _areaISO3166_3Codes :: [ISO3166Code] } deriving (Area -> Area -> Bool (Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Area -> Area -> Bool $c/= :: Area -> Area -> Bool == :: Area -> Area -> Bool $c== :: Area -> Area -> Bool Eq, Int -> Area -> ShowS [Area] -> ShowS Area -> String (Int -> Area -> ShowS) -> (Area -> String) -> ([Area] -> ShowS) -> Show Area forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Area] -> ShowS $cshowList :: [Area] -> ShowS show :: Area -> String $cshow :: Area -> String showsPrec :: Int -> Area -> ShowS $cshowsPrec :: Int -> Area -> ShowS Show) instance FromJSON Area where parseJSON :: Value -> Parser Area parseJSON (Object v :: Object v) = MBID -> Maybe Text -> Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area Area (MBID -> Maybe Text -> Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) -> Parser MBID -> Parser (Maybe Text -> Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text -> MBID MBID (Text -> MBID) -> Parser Text -> Parser MBID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: "id") Parser (Maybe Text -> Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) -> Parser (Maybe Text) -> Parser (Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "name" Parser (Maybe Text -> [ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) -> Parser (Maybe Text) -> Parser ([ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "sort-name" Parser ([ISO3166Code] -> [ISO3166Code] -> [ISO3166Code] -> Area) -> Parser [ISO3166Code] -> Parser ([ISO3166Code] -> [ISO3166Code] -> Area) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ([ISO3166Code] -> Maybe [ISO3166Code] -> [ISO3166Code] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [ISO3166Code] -> [ISO3166Code]) -> Parser (Maybe [ISO3166Code]) -> Parser [ISO3166Code] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe [ISO3166Code]) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "iso_3166_1_codes") Parser ([ISO3166Code] -> [ISO3166Code] -> Area) -> Parser [ISO3166Code] -> Parser ([ISO3166Code] -> Area) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ([ISO3166Code] -> Maybe [ISO3166Code] -> [ISO3166Code] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [ISO3166Code] -> [ISO3166Code]) -> Parser (Maybe [ISO3166Code]) -> Parser [ISO3166Code] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe [ISO3166Code]) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "iso_3166_2_codes") Parser ([ISO3166Code] -> Area) -> Parser [ISO3166Code] -> Parser Area forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ([ISO3166Code] -> Maybe [ISO3166Code] -> [ISO3166Code] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [ISO3166Code] -> [ISO3166Code]) -> Parser (Maybe [ISO3166Code]) -> Parser [ISO3166Code] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe [ISO3166Code]) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "iso_3166_3_codes") parseJSON _ = Parser Area forall (m :: * -> *) a. MonadPlus m => m a mzero data CoverArtArchive = CoverArtArchive { CoverArtArchive -> Maybe Bool _coverArtArchiveArtwork :: Maybe Bool , CoverArtArchive -> Maybe Integer _coverArtArchiveCount :: Maybe Integer , CoverArtArchive -> Maybe Bool _coverArtArchiveFront :: Maybe Bool , CoverArtArchive -> Maybe Bool _coverArtArchiveBack :: Maybe Bool } deriving (CoverArtArchive -> CoverArtArchive -> Bool (CoverArtArchive -> CoverArtArchive -> Bool) -> (CoverArtArchive -> CoverArtArchive -> Bool) -> Eq CoverArtArchive forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CoverArtArchive -> CoverArtArchive -> Bool $c/= :: CoverArtArchive -> CoverArtArchive -> Bool == :: CoverArtArchive -> CoverArtArchive -> Bool $c== :: CoverArtArchive -> CoverArtArchive -> Bool Eq, Int -> CoverArtArchive -> ShowS [CoverArtArchive] -> ShowS CoverArtArchive -> String (Int -> CoverArtArchive -> ShowS) -> (CoverArtArchive -> String) -> ([CoverArtArchive] -> ShowS) -> Show CoverArtArchive forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CoverArtArchive] -> ShowS $cshowList :: [CoverArtArchive] -> ShowS show :: CoverArtArchive -> String $cshow :: CoverArtArchive -> String showsPrec :: Int -> CoverArtArchive -> ShowS $cshowsPrec :: Int -> CoverArtArchive -> ShowS Show) instance FromJSON CoverArtArchive where parseJSON :: Value -> Parser CoverArtArchive parseJSON (Object v :: Object v) = Maybe Bool -> Maybe Integer -> Maybe Bool -> Maybe Bool -> CoverArtArchive CoverArtArchive (Maybe Bool -> Maybe Integer -> Maybe Bool -> Maybe Bool -> CoverArtArchive) -> Parser (Maybe Bool) -> Parser (Maybe Integer -> Maybe Bool -> Maybe Bool -> CoverArtArchive) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object v Object -> Text -> Parser (Maybe Bool) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "artwork" Parser (Maybe Integer -> Maybe Bool -> Maybe Bool -> CoverArtArchive) -> Parser (Maybe Integer) -> Parser (Maybe Bool -> Maybe Bool -> CoverArtArchive) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Integer) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "count" Parser (Maybe Bool -> Maybe Bool -> CoverArtArchive) -> Parser (Maybe Bool) -> Parser (Maybe Bool -> CoverArtArchive) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Bool) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "front" Parser (Maybe Bool -> CoverArtArchive) -> Parser (Maybe Bool) -> Parser CoverArtArchive forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object v Object -> Text -> Parser (Maybe Bool) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? "back" parseJSON _ = Parser CoverArtArchive forall (m :: * -> *) a. MonadPlus m => m a mzero newtype ISO3166Code = ISO3166Code { ISO3166Code -> Text unISO3166Code :: Text } deriving (ISO3166Code -> ISO3166Code -> Bool (ISO3166Code -> ISO3166Code -> Bool) -> (ISO3166Code -> ISO3166Code -> Bool) -> Eq ISO3166Code forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ISO3166Code -> ISO3166Code -> Bool $c/= :: ISO3166Code -> ISO3166Code -> Bool == :: ISO3166Code -> ISO3166Code -> Bool $c== :: ISO3166Code -> ISO3166Code -> Bool Eq, Int -> ISO3166Code -> ShowS [ISO3166Code] -> ShowS ISO3166Code -> String (Int -> ISO3166Code -> ShowS) -> (ISO3166Code -> String) -> ([ISO3166Code] -> ShowS) -> Show ISO3166Code forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ISO3166Code] -> ShowS $cshowList :: [ISO3166Code] -> ShowS show :: ISO3166Code -> String $cshow :: ISO3166Code -> String showsPrec :: Int -> ISO3166Code -> ShowS $cshowsPrec :: Int -> ISO3166Code -> ShowS Show) instance FromJSON ISO3166Code where parseJSON :: Value -> Parser ISO3166Code parseJSON t :: Value t = Text -> ISO3166Code ISO3166Code (Text -> ISO3166Code) -> Parser Text -> Parser ISO3166Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser Text forall a. FromJSON a => Value -> Parser a parseJSON Value t