{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}

module MPD.Current.JSON.Types
    ( Tags(..)
    , TagField(..)
    , Status(..)
    , Playlist(..)
    , File(..)
    , State(..)
    , MPDPath(..)
    , MPDPlaybackState(..)
    , MPDId(..)
    ) where

import Network.MPD qualified as MPD

import Data.Aeson.Types
import Deriving.Aeson
import Data.List qualified as L
import Data.Char
import Control.Applicative
import Data.Text qualified as T
import Data.String


-- | Deriving.Aeson ghost type
data MPDCurrentJSONTag

{- | Custom field label string modifier for Tags

Lowercase @musicbrainz@ fields by separating them with @_@, otherwise
default to CamelToSnake.
-}
instance StringModifier MPDCurrentJSONTag where
  getStringModifier :: String -> String
getStringModifier String
s =
    case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
"musicbrainz" String
s of
      Just String
xs -> String
"musicbrainz_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
xs
      Maybe String
Nothing -> Char -> String -> String
camelTo2 Char
'_' String
s


{- | Sum type for either a single string or list of strings.

`Network.MPD.sgGetTag' always returns a list of values for the given
`Network.MPD.Metadata', so to make the output JSON only use direct
strings vs an array, use this sum type.
-}
data TagField = SingleTagField !String
              | MultiTagField ![String]
  deriving stock (Int -> TagField -> String -> String
[TagField] -> String -> String
TagField -> String
(Int -> TagField -> String -> String)
-> (TagField -> String)
-> ([TagField] -> String -> String)
-> Show TagField
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TagField -> String -> String
showsPrec :: Int -> TagField -> String -> String
$cshow :: TagField -> String
show :: TagField -> String
$cshowList :: [TagField] -> String -> String
showList :: [TagField] -> String -> String
Show, TagField -> TagField -> Bool
(TagField -> TagField -> Bool)
-> (TagField -> TagField -> Bool) -> Eq TagField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagField -> TagField -> Bool
== :: TagField -> TagField -> Bool
$c/= :: TagField -> TagField -> Bool
/= :: TagField -> TagField -> Bool
Eq, (forall x. TagField -> Rep TagField x)
-> (forall x. Rep TagField x -> TagField) -> Generic TagField
forall x. Rep TagField x -> TagField
forall x. TagField -> Rep TagField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TagField -> Rep TagField x
from :: forall x. TagField -> Rep TagField x
$cto :: forall x. Rep TagField x -> TagField
to :: forall x. Rep TagField x -> TagField
Generic)

{- | Store the parsed output of 'getTag'.

Each field represents a supported MPD tag.

@Maybe@ is used so `Deriving.Aeson.OmitNothingFields' can skip fields
that would otherwise be null in the encoded JSON.
-}
data Tags = Tags
  { Tags -> Maybe TagField
artist                    :: !(Maybe TagField)
  , Tags -> Maybe TagField
artistSort                :: !(Maybe TagField)
  , Tags -> Maybe TagField
album                     :: !(Maybe TagField)
  , Tags -> Maybe TagField
albumSort                 :: !(Maybe TagField)
  , Tags -> Maybe TagField
albumArtist               :: !(Maybe TagField)
  , Tags -> Maybe TagField
albumArtistSort           :: !(Maybe TagField)
  , Tags -> Maybe TagField
title                     :: !(Maybe TagField)
  , Tags -> Maybe TagField
track                     :: !(Maybe TagField)
  , Tags -> Maybe TagField
name                      :: !(Maybe TagField)
  , Tags -> Maybe TagField
genre                     :: !(Maybe TagField)
  , Tags -> Maybe TagField
date                      :: !(Maybe TagField)
  , Tags -> Maybe TagField
originalDate              :: !(Maybe TagField)
  , Tags -> Maybe TagField
composer                  :: !(Maybe TagField)
  , Tags -> Maybe TagField
performer                 :: !(Maybe TagField)
  , Tags -> Maybe TagField
conductor                 :: !(Maybe TagField)
  , Tags -> Maybe TagField
work                      :: !(Maybe TagField)
  , Tags -> Maybe TagField
grouping                  :: !(Maybe TagField)
  , Tags -> Maybe TagField
comment                   :: !(Maybe TagField)
  , Tags -> Maybe TagField
disc                      :: !(Maybe TagField)
  , Tags -> Maybe TagField
label                     :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzArtistId       :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzAlbumId        :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzAlbumartistId  :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzTrackId        :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzReleasetrackId :: !(Maybe TagField)
  , Tags -> Maybe TagField
musicbrainzWorkId         :: !(Maybe TagField)
  }
  deriving stock (Int -> Tags -> String -> String
[Tags] -> String -> String
Tags -> String
(Int -> Tags -> String -> String)
-> (Tags -> String) -> ([Tags] -> String -> String) -> Show Tags
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Tags -> String -> String
showsPrec :: Int -> Tags -> String -> String
$cshow :: Tags -> String
show :: Tags -> String
$cshowList :: [Tags] -> String -> String
showList :: [Tags] -> String -> String
Show, Tags -> Tags -> Bool
(Tags -> Tags -> Bool) -> (Tags -> Tags -> Bool) -> Eq Tags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tags -> Tags -> Bool
== :: Tags -> Tags -> Bool
$c/= :: Tags -> Tags -> Bool
/= :: Tags -> Tags -> Bool
Eq, (forall x. Tags -> Rep Tags x)
-> (forall x. Rep Tags x -> Tags) -> Generic Tags
forall x. Rep Tags x -> Tags
forall x. Tags -> Rep Tags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tags -> Rep Tags x
from :: forall x. Tags -> Rep Tags x
$cto :: forall x. Rep Tags x -> Tags
to :: forall x. Rep Tags x -> Tags
Generic)
  deriving ([Tags] -> Value
[Tags] -> Encoding
Tags -> Bool
Tags -> Value
Tags -> Encoding
(Tags -> Value)
-> (Tags -> Encoding)
-> ([Tags] -> Value)
-> ([Tags] -> Encoding)
-> (Tags -> Bool)
-> ToJSON Tags
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Tags -> Value
toJSON :: Tags -> Value
$ctoEncoding :: Tags -> Encoding
toEncoding :: Tags -> Encoding
$ctoJSONList :: [Tags] -> Value
toJSONList :: [Tags] -> Value
$ctoEncodingList :: [Tags] -> Encoding
toEncodingList :: [Tags] -> Encoding
$comitField :: Tags -> Bool
omitField :: Tags -> Bool
ToJSON, Maybe Tags
Value -> Parser [Tags]
Value -> Parser Tags
(Value -> Parser Tags)
-> (Value -> Parser [Tags]) -> Maybe Tags -> FromJSON Tags
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Tags
parseJSON :: Value -> Parser Tags
$cparseJSONList :: Value -> Parser [Tags]
parseJSONList :: Value -> Parser [Tags]
$comittedField :: Maybe Tags
omittedField :: Maybe Tags
FromJSON) via CustomJSON
  '[ FieldLabelModifier '[ MPDCurrentJSONTag ]
   , OmitNothingFields
   ] Tags

instance ToJSON TagField where
  toJSON :: TagField -> Value
  toJSON :: TagField -> Value
toJSON (SingleTagField String
s) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
s
  toJSON (MultiTagField [String]
maybeList) = [String] -> Value
forall a. ToJSON a => a -> Value
toJSON [String]
maybeList

instance FromJSON TagField where
  parseJSON :: Value -> Parser TagField
parseJSON Value
v =
        (String -> TagField
SingleTagField (String -> TagField) -> Parser String -> Parser TagField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
    Parser TagField -> Parser TagField -> Parser TagField
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([String] -> TagField
MultiTagField ([String] -> TagField) -> Parser [String] -> Parser TagField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [String]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

data Status = Status
  { Status -> MPDPlaybackState
state          :: !MPDPlaybackState
  , Status -> Bool
repeat         :: !Bool
  , Status -> Bool
random         :: !Bool
  , Status -> Bool
single         :: !Bool
  , Status -> Bool
consume        :: !Bool
  , Status -> Maybe FractionalSeconds
duration       :: !(Maybe MPD.FractionalSeconds)  -- Double
  , Status -> Maybe FractionalSeconds
elapsed        :: !(Maybe MPD.FractionalSeconds)
  , Status -> Maybe FractionalSeconds
elapsedPercent :: !(Maybe Double)
  , Status -> Maybe Int
volume         :: !(Maybe Int)
  , Status -> Maybe (Int, Int, Int)
audioFormat    :: !(Maybe (Int, Int, Int))
  , Status -> Maybe Int
bitrate        :: !(Maybe Int)
  , Status -> Maybe Int
crossfade      :: !(Maybe Int)
  , Status -> Maybe FractionalSeconds
mixRampDb      :: !(Maybe Double)
  , Status -> Maybe FractionalSeconds
mixRampDelay   :: !(Maybe Double)
  , Status -> Maybe Int
updatingDb     :: !(Maybe Int)
  , Status -> Maybe String
error          :: !(Maybe String)
  }
  deriving stock (Int -> Status -> String -> String
[Status] -> String -> String
Status -> String
(Int -> Status -> String -> String)
-> (Status -> String)
-> ([Status] -> String -> String)
-> Show Status
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Status -> String -> String
showsPrec :: Int -> Status -> String -> String
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> String -> String
showList :: [Status] -> String -> String
Show, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic)
  deriving ([Status] -> Value
[Status] -> Encoding
Status -> Bool
Status -> Value
Status -> Encoding
(Status -> Value)
-> (Status -> Encoding)
-> ([Status] -> Value)
-> ([Status] -> Encoding)
-> (Status -> Bool)
-> ToJSON Status
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Status -> Value
toJSON :: Status -> Value
$ctoEncoding :: Status -> Encoding
toEncoding :: Status -> Encoding
$ctoJSONList :: [Status] -> Value
toJSONList :: [Status] -> Value
$ctoEncodingList :: [Status] -> Encoding
toEncodingList :: [Status] -> Encoding
$comitField :: Status -> Bool
omitField :: Status -> Bool
ToJSON, Maybe Status
Value -> Parser [Status]
Value -> Parser Status
(Value -> Parser Status)
-> (Value -> Parser [Status]) -> Maybe Status -> FromJSON Status
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Status
parseJSON :: Value -> Parser Status
$cparseJSONList :: Value -> Parser [Status]
parseJSONList :: Value -> Parser [Status]
$comittedField :: Maybe Status
omittedField :: Maybe Status
FromJSON) via CustomJSON
  '[ FieldLabelModifier '[ Rename "mixRampDb" "mixramp_db"
                         , Rename "mixRampDelay" "mixramp_delay"
                         , CamelToSnake
                         ]
   , OmitNothingFields
   ] Status

-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177.
newtype MPDPlaybackState = MPDPlaybackState MPD.PlaybackState
  deriving stock (Int -> MPDPlaybackState -> String -> String
[MPDPlaybackState] -> String -> String
MPDPlaybackState -> String
(Int -> MPDPlaybackState -> String -> String)
-> (MPDPlaybackState -> String)
-> ([MPDPlaybackState] -> String -> String)
-> Show MPDPlaybackState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MPDPlaybackState -> String -> String
showsPrec :: Int -> MPDPlaybackState -> String -> String
$cshow :: MPDPlaybackState -> String
show :: MPDPlaybackState -> String
$cshowList :: [MPDPlaybackState] -> String -> String
showList :: [MPDPlaybackState] -> String -> String
Show, MPDPlaybackState -> MPDPlaybackState -> Bool
(MPDPlaybackState -> MPDPlaybackState -> Bool)
-> (MPDPlaybackState -> MPDPlaybackState -> Bool)
-> Eq MPDPlaybackState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MPDPlaybackState -> MPDPlaybackState -> Bool
== :: MPDPlaybackState -> MPDPlaybackState -> Bool
$c/= :: MPDPlaybackState -> MPDPlaybackState -> Bool
/= :: MPDPlaybackState -> MPDPlaybackState -> Bool
Eq, (forall x. MPDPlaybackState -> Rep MPDPlaybackState x)
-> (forall x. Rep MPDPlaybackState x -> MPDPlaybackState)
-> Generic MPDPlaybackState
forall x. Rep MPDPlaybackState x -> MPDPlaybackState
forall x. MPDPlaybackState -> Rep MPDPlaybackState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MPDPlaybackState -> Rep MPDPlaybackState x
from :: forall x. MPDPlaybackState -> Rep MPDPlaybackState x
$cto :: forall x. Rep MPDPlaybackState x -> MPDPlaybackState
to :: forall x. Rep MPDPlaybackState x -> MPDPlaybackState
Generic)

instance ToJSON MPDPlaybackState where
  toJSON :: MPDPlaybackState -> Value
  toJSON :: MPDPlaybackState -> Value
toJSON (MPDPlaybackState PlaybackState
MPD.Playing) = Value
"playing"
  toJSON (MPDPlaybackState PlaybackState
MPD.Paused)  = Value
"paused"
  toJSON (MPDPlaybackState PlaybackState
MPD.Stopped) = Value
"stopped"

instance FromJSON MPDPlaybackState where
  parseJSON :: Value -> Parser MPDPlaybackState
parseJSON = String
-> (Text -> Parser MPDPlaybackState)
-> Value
-> Parser MPDPlaybackState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MPD.PlaybackState" ((Text -> Parser MPDPlaybackState)
 -> Value -> Parser MPDPlaybackState)
-> (Text -> Parser MPDPlaybackState)
-> Value
-> Parser MPDPlaybackState
forall a b. (a -> b) -> a -> b
$ \Text
state -> do
    case Text
state of
      Text
"playing" -> MPDPlaybackState -> Parser MPDPlaybackState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlaybackState -> MPDPlaybackState
MPDPlaybackState PlaybackState
MPD.Playing)
      Text
"paused"  -> MPDPlaybackState -> Parser MPDPlaybackState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlaybackState -> MPDPlaybackState
MPDPlaybackState PlaybackState
MPD.Paused)
      Text
"stopped" -> MPDPlaybackState -> Parser MPDPlaybackState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlaybackState -> MPDPlaybackState
MPDPlaybackState PlaybackState
MPD.Playing)
      Text
_         -> String -> Parser MPDPlaybackState
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MPDPlaybackState)
-> String -> Parser MPDPlaybackState
forall a b. (a -> b) -> a -> b
$ String
"Unknown playback state: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
state

data Playlist = Playlist
  { Playlist -> Maybe Int
position     :: !(Maybe MPD.Position)
  , Playlist -> Maybe Int
nextPosition :: !(Maybe MPD.Position)
  , Playlist -> Maybe MPDId
id           :: !(Maybe MPDId)
  , Playlist -> Maybe MPDId
nextId       :: !(Maybe MPDId)
  , Playlist -> Int
length       :: !Int
  }
  deriving stock (Int -> Playlist -> String -> String
[Playlist] -> String -> String
Playlist -> String
(Int -> Playlist -> String -> String)
-> (Playlist -> String)
-> ([Playlist] -> String -> String)
-> Show Playlist
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Playlist -> String -> String
showsPrec :: Int -> Playlist -> String -> String
$cshow :: Playlist -> String
show :: Playlist -> String
$cshowList :: [Playlist] -> String -> String
showList :: [Playlist] -> String -> String
Show, Playlist -> Playlist -> Bool
(Playlist -> Playlist -> Bool)
-> (Playlist -> Playlist -> Bool) -> Eq Playlist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Playlist -> Playlist -> Bool
== :: Playlist -> Playlist -> Bool
$c/= :: Playlist -> Playlist -> Bool
/= :: Playlist -> Playlist -> Bool
Eq, (forall x. Playlist -> Rep Playlist x)
-> (forall x. Rep Playlist x -> Playlist) -> Generic Playlist
forall x. Rep Playlist x -> Playlist
forall x. Playlist -> Rep Playlist x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Playlist -> Rep Playlist x
from :: forall x. Playlist -> Rep Playlist x
$cto :: forall x. Rep Playlist x -> Playlist
to :: forall x. Rep Playlist x -> Playlist
Generic)
  deriving ([Playlist] -> Value
[Playlist] -> Encoding
Playlist -> Bool
Playlist -> Value
Playlist -> Encoding
(Playlist -> Value)
-> (Playlist -> Encoding)
-> ([Playlist] -> Value)
-> ([Playlist] -> Encoding)
-> (Playlist -> Bool)
-> ToJSON Playlist
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Playlist -> Value
toJSON :: Playlist -> Value
$ctoEncoding :: Playlist -> Encoding
toEncoding :: Playlist -> Encoding
$ctoJSONList :: [Playlist] -> Value
toJSONList :: [Playlist] -> Value
$ctoEncodingList :: [Playlist] -> Encoding
toEncodingList :: [Playlist] -> Encoding
$comitField :: Playlist -> Bool
omitField :: Playlist -> Bool
ToJSON, Maybe Playlist
Value -> Parser [Playlist]
Value -> Parser Playlist
(Value -> Parser Playlist)
-> (Value -> Parser [Playlist])
-> Maybe Playlist
-> FromJSON Playlist
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Playlist
parseJSON :: Value -> Parser Playlist
$cparseJSONList :: Value -> Parser [Playlist]
parseJSONList :: Value -> Parser [Playlist]
$comittedField :: Maybe Playlist
omittedField :: Maybe Playlist
FromJSON) via CustomJSON
  '[ FieldLabelModifier '[ CamelToSnake ]
   , OmitNothingFields
   ] Playlist

-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177.
newtype MPDId = MPDId MPD.Id
  deriving stock (Int -> MPDId -> String -> String
[MPDId] -> String -> String
MPDId -> String
(Int -> MPDId -> String -> String)
-> (MPDId -> String) -> ([MPDId] -> String -> String) -> Show MPDId
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MPDId -> String -> String
showsPrec :: Int -> MPDId -> String -> String
$cshow :: MPDId -> String
show :: MPDId -> String
$cshowList :: [MPDId] -> String -> String
showList :: [MPDId] -> String -> String
Show, MPDId -> MPDId -> Bool
(MPDId -> MPDId -> Bool) -> (MPDId -> MPDId -> Bool) -> Eq MPDId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MPDId -> MPDId -> Bool
== :: MPDId -> MPDId -> Bool
$c/= :: MPDId -> MPDId -> Bool
/= :: MPDId -> MPDId -> Bool
Eq, (forall x. MPDId -> Rep MPDId x)
-> (forall x. Rep MPDId x -> MPDId) -> Generic MPDId
forall x. Rep MPDId x -> MPDId
forall x. MPDId -> Rep MPDId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MPDId -> Rep MPDId x
from :: forall x. MPDId -> Rep MPDId x
$cto :: forall x. Rep MPDId x -> MPDId
to :: forall x. Rep MPDId x -> MPDId
Generic)

instance ToJSON MPDId where
  toJSON :: MPDId -> Value
  toJSON :: MPDId -> Value
toJSON (MPDId (MPD.Id Int
i)) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i

instance FromJSON MPDId where
  parseJSON :: Value -> Parser MPDId
parseJSON Value
v = Id -> MPDId
MPDId (Id -> MPDId) -> (Int -> Id) -> Int -> MPDId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Id
MPD.Id (Int -> MPDId) -> Parser Int -> Parser MPDId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data File = File
  { File -> Maybe MPDPath
currentFile :: !(Maybe MPDPath)  -- ^ current song file path
  , File -> Maybe MPDPath
nextFile    :: !(Maybe MPDPath)  -- ^ next song file path
  }
  deriving stock (Int -> File -> String -> String
[File] -> String -> String
File -> String
(Int -> File -> String -> String)
-> (File -> String) -> ([File] -> String -> String) -> Show File
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> File -> String -> String
showsPrec :: Int -> File -> String -> String
$cshow :: File -> String
show :: File -> String
$cshowList :: [File] -> String -> String
showList :: [File] -> String -> String
Show, File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: File -> File -> Bool
== :: File -> File -> Bool
$c/= :: File -> File -> Bool
/= :: File -> File -> Bool
Eq, (forall x. File -> Rep File x)
-> (forall x. Rep File x -> File) -> Generic File
forall x. Rep File x -> File
forall x. File -> Rep File x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. File -> Rep File x
from :: forall x. File -> Rep File x
$cto :: forall x. Rep File x -> File
to :: forall x. Rep File x -> File
Generic)
  deriving ([File] -> Value
[File] -> Encoding
File -> Bool
File -> Value
File -> Encoding
(File -> Value)
-> (File -> Encoding)
-> ([File] -> Value)
-> ([File] -> Encoding)
-> (File -> Bool)
-> ToJSON File
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: File -> Value
toJSON :: File -> Value
$ctoEncoding :: File -> Encoding
toEncoding :: File -> Encoding
$ctoJSONList :: [File] -> Value
toJSONList :: [File] -> Value
$ctoEncodingList :: [File] -> Encoding
toEncodingList :: [File] -> Encoding
$comitField :: File -> Bool
omitField :: File -> Bool
ToJSON, Maybe File
Value -> Parser [File]
Value -> Parser File
(Value -> Parser File)
-> (Value -> Parser [File]) -> Maybe File -> FromJSON File
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser File
parseJSON :: Value -> Parser File
$cparseJSONList :: Value -> Parser [File]
parseJSONList :: Value -> Parser [File]
$comittedField :: Maybe File
omittedField :: Maybe File
FromJSON) via CustomJSON
  '[ FieldLabelModifier '[ Rename "currentFile" "filename"
                         , Rename "nextFile" "next_filename" ]
   , OmitNothingFields
   ] File


-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177.
newtype MPDPath = MPDPath MPD.Path
  deriving stock (Int -> MPDPath -> String -> String
[MPDPath] -> String -> String
MPDPath -> String
(Int -> MPDPath -> String -> String)
-> (MPDPath -> String)
-> ([MPDPath] -> String -> String)
-> Show MPDPath
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MPDPath -> String -> String
showsPrec :: Int -> MPDPath -> String -> String
$cshow :: MPDPath -> String
show :: MPDPath -> String
$cshowList :: [MPDPath] -> String -> String
showList :: [MPDPath] -> String -> String
Show, MPDPath -> MPDPath -> Bool
(MPDPath -> MPDPath -> Bool)
-> (MPDPath -> MPDPath -> Bool) -> Eq MPDPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MPDPath -> MPDPath -> Bool
== :: MPDPath -> MPDPath -> Bool
$c/= :: MPDPath -> MPDPath -> Bool
/= :: MPDPath -> MPDPath -> Bool
Eq, (forall x. MPDPath -> Rep MPDPath x)
-> (forall x. Rep MPDPath x -> MPDPath) -> Generic MPDPath
forall x. Rep MPDPath x -> MPDPath
forall x. MPDPath -> Rep MPDPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MPDPath -> Rep MPDPath x
from :: forall x. MPDPath -> Rep MPDPath x
$cto :: forall x. Rep MPDPath x -> MPDPath
to :: forall x. Rep MPDPath x -> MPDPath
Generic)

instance ToJSON MPDPath where
  toJSON :: MPDPath -> Value
  toJSON :: MPDPath -> Value
toJSON (MPDPath Path
p) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Path -> String
forall a. ToString a => a -> String
MPD.toString Path
p

instance FromJSON MPDPath where
  parseJSON :: Value -> Parser MPDPath
parseJSON = String -> (Text -> Parser MPDPath) -> Value -> Parser MPDPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MPD.Path" ((Text -> Parser MPDPath) -> Value -> Parser MPDPath)
-> (Text -> Parser MPDPath) -> Value -> Parser MPDPath
forall a b. (a -> b) -> a -> b
$ \Text
path -> do
    MPDPath -> Parser MPDPath
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MPDPath -> Parser MPDPath)
-> (Text -> MPDPath) -> Text -> Parser MPDPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> MPDPath
MPDPath (Path -> MPDPath) -> (Text -> Path) -> Text -> MPDPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path
forall a. IsString a => String -> a
fromString (String -> Path) -> (Text -> String) -> Text -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parser MPDPath) -> Text -> Parser MPDPath
forall a b. (a -> b) -> a -> b
$ Text
path

-- | Complete MPD State. Where other states will be stored into and JSON encoded.
data State = State
  { State -> File
mpdFile     :: !File
  , State -> Status
mpdStatus   :: !Status
  , State -> Playlist
mpdPlaylist :: !Playlist
  , State -> Tags
mpdTags     :: !Tags
  , State -> Maybe Tags
mpdNextTags :: !(Maybe Tags)
  }
  deriving stock (Int -> State -> String -> String
[State] -> String -> String
State -> String
(Int -> State -> String -> String)
-> (State -> String) -> ([State] -> String -> String) -> Show State
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> State -> String -> String
showsPrec :: Int -> State -> String -> String
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> String -> String
showList :: [State] -> String -> String
Show, State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
Eq, (forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. State -> Rep State x
from :: forall x. State -> Rep State x
$cto :: forall x. Rep State x -> State
to :: forall x. Rep State x -> State
Generic)

-- | Custom output for encoded 'State'.
instance ToJSON State where
  toJSON :: State -> Value
  toJSON :: State -> Value
toJSON State
state = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"filename" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe MPDPath -> Value
forall a. ToJSON a => a -> Value
toJSON State
state.mpdFile.currentFile
    , Key
"status"   Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Status -> Value
forall a. ToJSON a => a -> Value
toJSON State
state.mpdStatus
    , Key
"playlist" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Playlist -> Value
forall a. ToJSON a => a -> Value
toJSON State
state.mpdPlaylist
    , Key
"tags"     Key -> Tags -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= State
state.mpdTags
    ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case State
state.mpdNextTags of
           Maybe Tags
Nothing -> []
           Just Tags
nextTags -> [ Key
"next" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                              [ Key
"filename" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe MPDPath -> Value
forall a. ToJSON a => a -> Value
toJSON State
state.mpdFile.nextFile
                              , Key
"tags" Key -> Tags -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tags
nextTags
                              ] ]