{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}
-- | Module    : Network.MPD.Commands.Types
-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010
-- License     : MIT (see LICENSE)
-- Maintainer  : Joachim Fasting <joachifm@fastmail.fm>
-- Stability   : alpha
--
-- Various MPD data structures and types

module Network.MPD.Commands.Types
    ( ToString(..)
    , Artist
    , Album
    , Title
    , PlaylistName(..)
    , Path(..)
    , Metadata(..)
    , Value(..)
    , ObjectType(..)
    , Seconds
    , FractionalSeconds
    , Decibels
    , PlaybackState(..)
    , Subsystem(..)
    , ReplayGainMode(..)
    , Count(..)
    , LsResult(..)
    , Device(..)
    , Song(..)
    , Position
    , Range(..)
    , Id(..)
    , Priority(..)
    , sgGetTag
    , sgAddTag
    , Volume(..)
    , Stats(..)
    , Status(..)
    , def
    , defaultSong
    ) where

import           Network.MPD.Commands.Arg (MPDArg(prep), Args(Args))

import           Data.Default.Class

import qualified Data.Map as M
import           Data.Map.Strict (insertWith)
import           Data.Time.Clock (UTCTime)
import           Data.String

import           Data.Text   (Text)
import qualified Data.Text.Encoding as Text
import           Data.ByteString (ByteString)
import qualified Data.ByteString.UTF8 as UTF8

-- The purpose of this class is to allow users to choose the optimal
-- representation of response values.
-- | A type class for values that can be converted to `String`s.
class ToString a where

  -- | Convert given value to `String`.
  toString :: a -> String

  -- | Convert given value to `Text`.
  toText   :: a -> Text

  -- | Convert given value to a UTF-8 encoded `ByteString`.
  toUtf8   :: a -> ByteString

type Artist = Value
type Album  = Value
type Title  = Value

-- | Used for commands which require a playlist name.
-- If empty, the current playlist is used.
newtype PlaylistName = PlaylistName ByteString
  deriving (PlaylistName -> PlaylistName -> Bool
(PlaylistName -> PlaylistName -> Bool)
-> (PlaylistName -> PlaylistName -> Bool) -> Eq PlaylistName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaylistName -> PlaylistName -> Bool
$c/= :: PlaylistName -> PlaylistName -> Bool
== :: PlaylistName -> PlaylistName -> Bool
$c== :: PlaylistName -> PlaylistName -> Bool
Eq, Int -> PlaylistName -> ShowS
[PlaylistName] -> ShowS
PlaylistName -> String
(Int -> PlaylistName -> ShowS)
-> (PlaylistName -> String)
-> ([PlaylistName] -> ShowS)
-> Show PlaylistName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaylistName] -> ShowS
$cshowList :: [PlaylistName] -> ShowS
show :: PlaylistName -> String
$cshow :: PlaylistName -> String
showsPrec :: Int -> PlaylistName -> ShowS
$cshowsPrec :: Int -> PlaylistName -> ShowS
Show, Eq PlaylistName
Eq PlaylistName
-> (PlaylistName -> PlaylistName -> Ordering)
-> (PlaylistName -> PlaylistName -> Bool)
-> (PlaylistName -> PlaylistName -> Bool)
-> (PlaylistName -> PlaylistName -> Bool)
-> (PlaylistName -> PlaylistName -> Bool)
-> (PlaylistName -> PlaylistName -> PlaylistName)
-> (PlaylistName -> PlaylistName -> PlaylistName)
-> Ord PlaylistName
PlaylistName -> PlaylistName -> Bool
PlaylistName -> PlaylistName -> Ordering
PlaylistName -> PlaylistName -> PlaylistName
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 :: PlaylistName -> PlaylistName -> PlaylistName
$cmin :: PlaylistName -> PlaylistName -> PlaylistName
max :: PlaylistName -> PlaylistName -> PlaylistName
$cmax :: PlaylistName -> PlaylistName -> PlaylistName
>= :: PlaylistName -> PlaylistName -> Bool
$c>= :: PlaylistName -> PlaylistName -> Bool
> :: PlaylistName -> PlaylistName -> Bool
$c> :: PlaylistName -> PlaylistName -> Bool
<= :: PlaylistName -> PlaylistName -> Bool
$c<= :: PlaylistName -> PlaylistName -> Bool
< :: PlaylistName -> PlaylistName -> Bool
$c< :: PlaylistName -> PlaylistName -> Bool
compare :: PlaylistName -> PlaylistName -> Ordering
$ccompare :: PlaylistName -> PlaylistName -> Ordering
$cp1Ord :: Eq PlaylistName
Ord, Show PlaylistName
Show PlaylistName -> (PlaylistName -> Args) -> MPDArg PlaylistName
PlaylistName -> Args
forall a. Show a -> (a -> Args) -> MPDArg a
prep :: PlaylistName -> Args
$cprep :: PlaylistName -> Args
$cp1MPDArg :: Show PlaylistName
MPDArg)

instance ToString PlaylistName where
  toString :: PlaylistName -> String
toString (PlaylistName ByteString
x) = ByteString -> String
UTF8.toString ByteString
x
  toText :: PlaylistName -> Text
toText   (PlaylistName ByteString
x) = ByteString -> Text
Text.decodeUtf8 ByteString
x
  toUtf8 :: PlaylistName -> ByteString
toUtf8   (PlaylistName ByteString
x) = ByteString
x

instance IsString PlaylistName where
  fromString :: String -> PlaylistName
fromString = ByteString -> PlaylistName
PlaylistName (ByteString -> PlaylistName)
-> (String -> ByteString) -> String -> PlaylistName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

-- | Used for commands which require a path within the database.
-- If empty, the root path is used.
newtype Path = Path ByteString
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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 :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord, Show Path
Show Path -> (Path -> Args) -> MPDArg Path
Path -> Args
forall a. Show a -> (a -> Args) -> MPDArg a
prep :: Path -> Args
$cprep :: Path -> Args
$cp1MPDArg :: Show Path
MPDArg)

instance ToString Path where
  toString :: Path -> String
toString (Path ByteString
x) = ByteString -> String
UTF8.toString ByteString
x
  toText :: Path -> Text
toText   (Path ByteString
x) = ByteString -> Text
Text.decodeUtf8 ByteString
x
  toUtf8 :: Path -> ByteString
toUtf8   (Path ByteString
x) = ByteString
x

instance IsString Path where
  fromString :: String -> Path
fromString = ByteString -> Path
Path (ByteString -> Path) -> (String -> ByteString) -> String -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

-- | Available metadata types\/scope modifiers, used for searching the
-- database for entries with certain metadata values.
data Metadata = Artist
              | ArtistSort
              | Album
              | AlbumSort -- ^ @since 0.10.0.0
              | AlbumArtist
              | AlbumArtistSort
              | Title
              | Track
              | Name
              | Genre
              | Date
              | OriginalDate -- ^ @since 0.10.0.0
              | Composer
              | Performer
              | Conductor -- ^ @since 0.10.0.0
              | Work -- ^ @since 0.10.0.0
              | Grouping -- ^ @since 0.10.0.0
              | Comment
              | Disc
              | Label -- ^ @since 0.10.0.0
              | MUSICBRAINZ_ARTISTID
              | MUSICBRAINZ_ALBUMID
              | MUSICBRAINZ_ALBUMARTISTID
              | MUSICBRAINZ_TRACKID
              | MUSICBRAINZ_RELEASETRACKID
              | MUSICBRAINZ_WORKID -- ^ @since 0.10.0.0
              deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata
Metadata -> Int
Metadata -> [Metadata]
Metadata -> Metadata
Metadata -> Metadata -> [Metadata]
Metadata -> Metadata -> Metadata -> [Metadata]
(Metadata -> Metadata)
-> (Metadata -> Metadata)
-> (Int -> Metadata)
-> (Metadata -> Int)
-> (Metadata -> [Metadata])
-> (Metadata -> Metadata -> [Metadata])
-> (Metadata -> Metadata -> [Metadata])
-> (Metadata -> Metadata -> Metadata -> [Metadata])
-> Enum Metadata
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Metadata -> Metadata -> Metadata -> [Metadata]
$cenumFromThenTo :: Metadata -> Metadata -> Metadata -> [Metadata]
enumFromTo :: Metadata -> Metadata -> [Metadata]
$cenumFromTo :: Metadata -> Metadata -> [Metadata]
enumFromThen :: Metadata -> Metadata -> [Metadata]
$cenumFromThen :: Metadata -> Metadata -> [Metadata]
enumFrom :: Metadata -> [Metadata]
$cenumFrom :: Metadata -> [Metadata]
fromEnum :: Metadata -> Int
$cfromEnum :: Metadata -> Int
toEnum :: Int -> Metadata
$ctoEnum :: Int -> Metadata
pred :: Metadata -> Metadata
$cpred :: Metadata -> Metadata
succ :: Metadata -> Metadata
$csucc :: Metadata -> Metadata
Enum, Eq Metadata
Eq Metadata
-> (Metadata -> Metadata -> Ordering)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Metadata)
-> (Metadata -> Metadata -> Metadata)
-> Ord Metadata
Metadata -> Metadata -> Bool
Metadata -> Metadata -> Ordering
Metadata -> Metadata -> Metadata
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 :: Metadata -> Metadata -> Metadata
$cmin :: Metadata -> Metadata -> Metadata
max :: Metadata -> Metadata -> Metadata
$cmax :: Metadata -> Metadata -> Metadata
>= :: Metadata -> Metadata -> Bool
$c>= :: Metadata -> Metadata -> Bool
> :: Metadata -> Metadata -> Bool
$c> :: Metadata -> Metadata -> Bool
<= :: Metadata -> Metadata -> Bool
$c<= :: Metadata -> Metadata -> Bool
< :: Metadata -> Metadata -> Bool
$c< :: Metadata -> Metadata -> Bool
compare :: Metadata -> Metadata -> Ordering
$ccompare :: Metadata -> Metadata -> Ordering
$cp1Ord :: Eq Metadata
Ord, Metadata
Metadata -> Metadata -> Bounded Metadata
forall a. a -> a -> Bounded a
maxBound :: Metadata
$cmaxBound :: Metadata
minBound :: Metadata
$cminBound :: Metadata
Bounded, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show)

instance MPDArg Metadata

-- | A metadata value.
newtype Value = Value ByteString
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
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 :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
$cp1Ord :: Eq Value
Ord, Show Value
Show Value -> (Value -> Args) -> MPDArg Value
Value -> Args
forall a. Show a -> (a -> Args) -> MPDArg a
prep :: Value -> Args
$cprep :: Value -> Args
$cp1MPDArg :: Show Value
MPDArg)

instance ToString Value where
  toString :: Value -> String
toString (Value ByteString
x) = ByteString -> String
UTF8.toString ByteString
x
  toText :: Value -> Text
toText   (Value ByteString
x) = ByteString -> Text
Text.decodeUtf8 ByteString
x
  toUtf8 :: Value -> ByteString
toUtf8   (Value ByteString
x) = ByteString
x

instance IsString Value where
  fromString :: String -> Value
fromString = ByteString -> Value
Value (ByteString -> Value) -> (String -> ByteString) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

-- | Object types.
data ObjectType = SongObj
    deriving (ObjectType -> ObjectType -> Bool
(ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool) -> Eq ObjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectType -> ObjectType -> Bool
$c/= :: ObjectType -> ObjectType -> Bool
== :: ObjectType -> ObjectType -> Bool
$c== :: ObjectType -> ObjectType -> Bool
Eq, Int -> ObjectType -> ShowS
[ObjectType] -> ShowS
ObjectType -> String
(Int -> ObjectType -> ShowS)
-> (ObjectType -> String)
-> ([ObjectType] -> ShowS)
-> Show ObjectType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectType] -> ShowS
$cshowList :: [ObjectType] -> ShowS
show :: ObjectType -> String
$cshow :: ObjectType -> String
showsPrec :: Int -> ObjectType -> ShowS
$cshowsPrec :: Int -> ObjectType -> ShowS
Show)

instance MPDArg ObjectType where
    prep :: ObjectType -> Args
prep ObjectType
SongObj = [String] -> Args
Args [String
"song"]

type FractionalSeconds = Double

type Seconds = Integer

type Decibels = Integer

-- | Represents the different playback states.
data PlaybackState
  = Playing
  | Stopped
  | Paused
    deriving (PlaybackState -> PlaybackState -> Bool
(PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool) -> Eq PlaybackState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaybackState -> PlaybackState -> Bool
$c/= :: PlaybackState -> PlaybackState -> Bool
== :: PlaybackState -> PlaybackState -> Bool
$c== :: PlaybackState -> PlaybackState -> Bool
Eq, Int -> PlaybackState
PlaybackState -> Int
PlaybackState -> [PlaybackState]
PlaybackState -> PlaybackState
PlaybackState -> PlaybackState -> [PlaybackState]
PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
(PlaybackState -> PlaybackState)
-> (PlaybackState -> PlaybackState)
-> (Int -> PlaybackState)
-> (PlaybackState -> Int)
-> (PlaybackState -> [PlaybackState])
-> (PlaybackState -> PlaybackState -> [PlaybackState])
-> (PlaybackState -> PlaybackState -> [PlaybackState])
-> (PlaybackState
    -> PlaybackState -> PlaybackState -> [PlaybackState])
-> Enum PlaybackState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromThenTo :: PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
enumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFrom :: PlaybackState -> [PlaybackState]
$cenumFrom :: PlaybackState -> [PlaybackState]
fromEnum :: PlaybackState -> Int
$cfromEnum :: PlaybackState -> Int
toEnum :: Int -> PlaybackState
$ctoEnum :: Int -> PlaybackState
pred :: PlaybackState -> PlaybackState
$cpred :: PlaybackState -> PlaybackState
succ :: PlaybackState -> PlaybackState
$csucc :: PlaybackState -> PlaybackState
Enum, Eq PlaybackState
Eq PlaybackState
-> (PlaybackState -> PlaybackState -> Ordering)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> Bool)
-> (PlaybackState -> PlaybackState -> PlaybackState)
-> (PlaybackState -> PlaybackState -> PlaybackState)
-> Ord PlaybackState
PlaybackState -> PlaybackState -> Bool
PlaybackState -> PlaybackState -> Ordering
PlaybackState -> PlaybackState -> PlaybackState
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 :: PlaybackState -> PlaybackState -> PlaybackState
$cmin :: PlaybackState -> PlaybackState -> PlaybackState
max :: PlaybackState -> PlaybackState -> PlaybackState
$cmax :: PlaybackState -> PlaybackState -> PlaybackState
>= :: PlaybackState -> PlaybackState -> Bool
$c>= :: PlaybackState -> PlaybackState -> Bool
> :: PlaybackState -> PlaybackState -> Bool
$c> :: PlaybackState -> PlaybackState -> Bool
<= :: PlaybackState -> PlaybackState -> Bool
$c<= :: PlaybackState -> PlaybackState -> Bool
< :: PlaybackState -> PlaybackState -> Bool
$c< :: PlaybackState -> PlaybackState -> Bool
compare :: PlaybackState -> PlaybackState -> Ordering
$ccompare :: PlaybackState -> PlaybackState -> Ordering
$cp1Ord :: Eq PlaybackState
Ord, PlaybackState
PlaybackState -> PlaybackState -> Bounded PlaybackState
forall a. a -> a -> Bounded a
maxBound :: PlaybackState
$cmaxBound :: PlaybackState
minBound :: PlaybackState
$cminBound :: PlaybackState
Bounded, Int -> PlaybackState -> ShowS
[PlaybackState] -> ShowS
PlaybackState -> String
(Int -> PlaybackState -> ShowS)
-> (PlaybackState -> String)
-> ([PlaybackState] -> ShowS)
-> Show PlaybackState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaybackState] -> ShowS
$cshowList :: [PlaybackState] -> ShowS
show :: PlaybackState -> String
$cshow :: PlaybackState -> String
showsPrec :: Int -> PlaybackState -> ShowS
$cshowsPrec :: Int -> PlaybackState -> ShowS
Show)

-- | Represents the various MPD subsystems.
data Subsystem
    = DatabaseS          -- ^ The song database
    | UpdateS            -- ^ Database updates
    | StoredPlaylistS    -- ^ Stored playlists
    | PlaylistS          -- ^ The current playlist
    | PlayerS            -- ^ The player
    | MixerS             -- ^ The volume mixer
    | OutputS            -- ^ Audio outputs
    | OptionsS           -- ^ Playback options
    | PartitionS         -- ^ Partition changes
                         --
                         --  @since 0.10.0.0
    | StickerS           -- ^ Sticker database
    | SubscriptionS      -- ^ Subscription
    | MessageS           -- ^ Message on subscribed channel
    | NeighborS          -- ^ finding or losing a neighbor
                         --
                         --  @since 0.10.0.0
    | MountS             -- ^ Mount list changes
                         --
                         --  @since 0.10.0.0
      deriving (Subsystem -> Subsystem -> Bool
(Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Bool) -> Eq Subsystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subsystem -> Subsystem -> Bool
$c/= :: Subsystem -> Subsystem -> Bool
== :: Subsystem -> Subsystem -> Bool
$c== :: Subsystem -> Subsystem -> Bool
Eq, Int -> Subsystem
Subsystem -> Int
Subsystem -> [Subsystem]
Subsystem -> Subsystem
Subsystem -> Subsystem -> [Subsystem]
Subsystem -> Subsystem -> Subsystem -> [Subsystem]
(Subsystem -> Subsystem)
-> (Subsystem -> Subsystem)
-> (Int -> Subsystem)
-> (Subsystem -> Int)
-> (Subsystem -> [Subsystem])
-> (Subsystem -> Subsystem -> [Subsystem])
-> (Subsystem -> Subsystem -> [Subsystem])
-> (Subsystem -> Subsystem -> Subsystem -> [Subsystem])
-> Enum Subsystem
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Subsystem -> Subsystem -> Subsystem -> [Subsystem]
$cenumFromThenTo :: Subsystem -> Subsystem -> Subsystem -> [Subsystem]
enumFromTo :: Subsystem -> Subsystem -> [Subsystem]
$cenumFromTo :: Subsystem -> Subsystem -> [Subsystem]
enumFromThen :: Subsystem -> Subsystem -> [Subsystem]
$cenumFromThen :: Subsystem -> Subsystem -> [Subsystem]
enumFrom :: Subsystem -> [Subsystem]
$cenumFrom :: Subsystem -> [Subsystem]
fromEnum :: Subsystem -> Int
$cfromEnum :: Subsystem -> Int
toEnum :: Int -> Subsystem
$ctoEnum :: Int -> Subsystem
pred :: Subsystem -> Subsystem
$cpred :: Subsystem -> Subsystem
succ :: Subsystem -> Subsystem
$csucc :: Subsystem -> Subsystem
Enum, Eq Subsystem
Eq Subsystem
-> (Subsystem -> Subsystem -> Ordering)
-> (Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Subsystem)
-> (Subsystem -> Subsystem -> Subsystem)
-> Ord Subsystem
Subsystem -> Subsystem -> Bool
Subsystem -> Subsystem -> Ordering
Subsystem -> Subsystem -> Subsystem
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 :: Subsystem -> Subsystem -> Subsystem
$cmin :: Subsystem -> Subsystem -> Subsystem
max :: Subsystem -> Subsystem -> Subsystem
$cmax :: Subsystem -> Subsystem -> Subsystem
>= :: Subsystem -> Subsystem -> Bool
$c>= :: Subsystem -> Subsystem -> Bool
> :: Subsystem -> Subsystem -> Bool
$c> :: Subsystem -> Subsystem -> Bool
<= :: Subsystem -> Subsystem -> Bool
$c<= :: Subsystem -> Subsystem -> Bool
< :: Subsystem -> Subsystem -> Bool
$c< :: Subsystem -> Subsystem -> Bool
compare :: Subsystem -> Subsystem -> Ordering
$ccompare :: Subsystem -> Subsystem -> Ordering
$cp1Ord :: Eq Subsystem
Ord, Subsystem
Subsystem -> Subsystem -> Bounded Subsystem
forall a. a -> a -> Bounded a
maxBound :: Subsystem
$cmaxBound :: Subsystem
minBound :: Subsystem
$cminBound :: Subsystem
Bounded, Int -> Subsystem -> ShowS
[Subsystem] -> ShowS
Subsystem -> String
(Int -> Subsystem -> ShowS)
-> (Subsystem -> String)
-> ([Subsystem] -> ShowS)
-> Show Subsystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subsystem] -> ShowS
$cshowList :: [Subsystem] -> ShowS
show :: Subsystem -> String
$cshow :: Subsystem -> String
showsPrec :: Int -> Subsystem -> ShowS
$cshowsPrec :: Int -> Subsystem -> ShowS
Show)

instance MPDArg Subsystem where
    prep :: Subsystem -> Args
prep Subsystem
DatabaseS = [String] -> Args
Args [String
"database"]
    prep Subsystem
UpdateS = [String] -> Args
Args [String
"update"]
    prep Subsystem
StoredPlaylistS = [String] -> Args
Args [String
"stored_playlist"]
    prep Subsystem
PlaylistS = [String] -> Args
Args [String
"playlist"]
    prep Subsystem
PlayerS = [String] -> Args
Args [String
"player"]
    prep Subsystem
MixerS = [String] -> Args
Args [String
"mixer"]
    prep Subsystem
OutputS = [String] -> Args
Args [String
"output"]
    prep Subsystem
OptionsS = [String] -> Args
Args [String
"options"]
    prep Subsystem
PartitionS = [String] -> Args
Args [String
"partition"]
    prep Subsystem
StickerS = [String] -> Args
Args [String
"sticker"]
    prep Subsystem
SubscriptionS = [String] -> Args
Args [String
"subscription"]
    prep Subsystem
MessageS = [String] -> Args
Args [String
"message"]
    prep Subsystem
NeighborS = [String] -> Args
Args [String
"neighbor"]
    prep Subsystem
MountS = [String] -> Args
Args [String
"mount"]

data ReplayGainMode
    = Off       -- ^ Disable replay gain
    | TrackMode -- ^ Per track mode
    | AlbumMode -- ^ Per album mode
    | AutoMode  -- ^ Auto mode
                --
                -- @since 0.10.0.0
      deriving (ReplayGainMode -> ReplayGainMode -> Bool
(ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> Bool) -> Eq ReplayGainMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplayGainMode -> ReplayGainMode -> Bool
$c/= :: ReplayGainMode -> ReplayGainMode -> Bool
== :: ReplayGainMode -> ReplayGainMode -> Bool
$c== :: ReplayGainMode -> ReplayGainMode -> Bool
Eq, Int -> ReplayGainMode
ReplayGainMode -> Int
ReplayGainMode -> [ReplayGainMode]
ReplayGainMode -> ReplayGainMode
ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
ReplayGainMode
-> ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
(ReplayGainMode -> ReplayGainMode)
-> (ReplayGainMode -> ReplayGainMode)
-> (Int -> ReplayGainMode)
-> (ReplayGainMode -> Int)
-> (ReplayGainMode -> [ReplayGainMode])
-> (ReplayGainMode -> ReplayGainMode -> [ReplayGainMode])
-> (ReplayGainMode -> ReplayGainMode -> [ReplayGainMode])
-> (ReplayGainMode
    -> ReplayGainMode -> ReplayGainMode -> [ReplayGainMode])
-> Enum ReplayGainMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReplayGainMode
-> ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
$cenumFromThenTo :: ReplayGainMode
-> ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFromTo :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
$cenumFromTo :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFromThen :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
$cenumFromThen :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFrom :: ReplayGainMode -> [ReplayGainMode]
$cenumFrom :: ReplayGainMode -> [ReplayGainMode]
fromEnum :: ReplayGainMode -> Int
$cfromEnum :: ReplayGainMode -> Int
toEnum :: Int -> ReplayGainMode
$ctoEnum :: Int -> ReplayGainMode
pred :: ReplayGainMode -> ReplayGainMode
$cpred :: ReplayGainMode -> ReplayGainMode
succ :: ReplayGainMode -> ReplayGainMode
$csucc :: ReplayGainMode -> ReplayGainMode
Enum, Eq ReplayGainMode
Eq ReplayGainMode
-> (ReplayGainMode -> ReplayGainMode -> Ordering)
-> (ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> ReplayGainMode)
-> (ReplayGainMode -> ReplayGainMode -> ReplayGainMode)
-> Ord ReplayGainMode
ReplayGainMode -> ReplayGainMode -> Bool
ReplayGainMode -> ReplayGainMode -> Ordering
ReplayGainMode -> ReplayGainMode -> ReplayGainMode
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 :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
$cmin :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
max :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
$cmax :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
>= :: ReplayGainMode -> ReplayGainMode -> Bool
$c>= :: ReplayGainMode -> ReplayGainMode -> Bool
> :: ReplayGainMode -> ReplayGainMode -> Bool
$c> :: ReplayGainMode -> ReplayGainMode -> Bool
<= :: ReplayGainMode -> ReplayGainMode -> Bool
$c<= :: ReplayGainMode -> ReplayGainMode -> Bool
< :: ReplayGainMode -> ReplayGainMode -> Bool
$c< :: ReplayGainMode -> ReplayGainMode -> Bool
compare :: ReplayGainMode -> ReplayGainMode -> Ordering
$ccompare :: ReplayGainMode -> ReplayGainMode -> Ordering
$cp1Ord :: Eq ReplayGainMode
Ord, ReplayGainMode
ReplayGainMode -> ReplayGainMode -> Bounded ReplayGainMode
forall a. a -> a -> Bounded a
maxBound :: ReplayGainMode
$cmaxBound :: ReplayGainMode
minBound :: ReplayGainMode
$cminBound :: ReplayGainMode
Bounded, Int -> ReplayGainMode -> ShowS
[ReplayGainMode] -> ShowS
ReplayGainMode -> String
(Int -> ReplayGainMode -> ShowS)
-> (ReplayGainMode -> String)
-> ([ReplayGainMode] -> ShowS)
-> Show ReplayGainMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplayGainMode] -> ShowS
$cshowList :: [ReplayGainMode] -> ShowS
show :: ReplayGainMode -> String
$cshow :: ReplayGainMode -> String
showsPrec :: Int -> ReplayGainMode -> ShowS
$cshowsPrec :: Int -> ReplayGainMode -> ShowS
Show)

instance MPDArg ReplayGainMode where
    prep :: ReplayGainMode -> Args
prep ReplayGainMode
Off = [String] -> Args
Args [String
"off"]
    prep ReplayGainMode
TrackMode = [String] -> Args
Args [String
"track"]
    prep ReplayGainMode
AlbumMode = [String] -> Args
Args [String
"album"]
    prep ReplayGainMode
AutoMode = [String] -> Args
Args [String
"auto"]

-- | Represents the result of running 'count'.
data Count =
    Count { Count -> Integer
cSongs    :: Integer -- ^ Number of songs matching the query
          , Count -> Integer
cPlaytime :: Seconds -- ^ Total play time of matching songs
          }
    deriving (Count -> Count -> Bool
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count] -> ShowS
$cshowList :: [Count] -> ShowS
show :: Count -> String
$cshow :: Count -> String
showsPrec :: Int -> Count -> ShowS
$cshowsPrec :: Int -> Count -> ShowS
Show)

defaultCount :: Count
defaultCount :: Count
defaultCount = Count :: Integer -> Integer -> Count
Count { cSongs :: Integer
cSongs = Integer
0, cPlaytime :: Integer
cPlaytime = Integer
0 }

instance Default Count where
    def :: Count
def = Count
defaultCount

-- | Result of the lsInfo operation
data LsResult
    = LsDirectory Path        -- ^ Directory
    | LsSong Song             -- ^ Song
    | LsPlaylist PlaylistName -- ^ Playlist
      deriving (LsResult -> LsResult -> Bool
(LsResult -> LsResult -> Bool)
-> (LsResult -> LsResult -> Bool) -> Eq LsResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LsResult -> LsResult -> Bool
$c/= :: LsResult -> LsResult -> Bool
== :: LsResult -> LsResult -> Bool
$c== :: LsResult -> LsResult -> Bool
Eq, Int -> LsResult -> ShowS
[LsResult] -> ShowS
LsResult -> String
(Int -> LsResult -> ShowS)
-> (LsResult -> String) -> ([LsResult] -> ShowS) -> Show LsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LsResult] -> ShowS
$cshowList :: [LsResult] -> ShowS
show :: LsResult -> String
$cshow :: LsResult -> String
showsPrec :: Int -> LsResult -> ShowS
$cshowsPrec :: Int -> LsResult -> ShowS
Show)

-- | Represents an output device.
data Device =
    Device { Device -> Int
dOutputID      :: Int    -- ^ Output's ID number
           , Device -> String
dOutputName    :: String -- ^ Output's name as defined in the MPD
                                      --   configuration file
           , Device -> Bool
dOutputEnabled :: Bool }
    deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Device] -> ShowS
$cshowList :: [Device] -> ShowS
show :: Device -> String
$cshow :: Device -> String
showsPrec :: Int -> Device -> ShowS
$cshowsPrec :: Int -> Device -> ShowS
Show)

defaultDevice :: Device
defaultDevice :: Device
defaultDevice =
    Device :: Int -> String -> Bool -> Device
Device { dOutputID :: Int
dOutputID = Int
0, dOutputName :: String
dOutputName = String
"", dOutputEnabled :: Bool
dOutputEnabled = Bool
False }

instance Default Device where
    def :: Device
def = Device
defaultDevice

-- | Represents a single song item.
data Song = Song
         { Song -> Path
sgFilePath     :: Path
         -- | Map of available tags (multiple occurrences of one tag type allowed)
         , Song -> Map Metadata [Value]
sgTags         :: M.Map Metadata [Value]
         -- | Last modification date
         , Song -> Maybe UTCTime
sgLastModified :: Maybe UTCTime
         -- | Length of the song in seconds
         , Song -> Integer
sgLength       :: Seconds
         -- | Id in playlist
         , Song -> Maybe Id
sgId           :: Maybe Id
         -- | Position in playlist
         , Song -> Maybe Int
sgIndex        :: Maybe Position
         } deriving (Song -> Song -> Bool
(Song -> Song -> Bool) -> (Song -> Song -> Bool) -> Eq Song
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Song -> Song -> Bool
$c/= :: Song -> Song -> Bool
== :: Song -> Song -> Bool
$c== :: Song -> Song -> Bool
Eq, Int -> Song -> ShowS
[Song] -> ShowS
Song -> String
(Int -> Song -> ShowS)
-> (Song -> String) -> ([Song] -> ShowS) -> Show Song
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Song] -> ShowS
$cshowList :: [Song] -> ShowS
show :: Song -> String
$cshow :: Song -> String
showsPrec :: Int -> Song -> ShowS
$cshowsPrec :: Int -> Song -> ShowS
Show)

-- | The position of a song in a playlist.
type Position = Int

-- | A range of songs.
data Range
  = Range Position Position -- ^ Start and end of the range, not including the end position.
  | Start Position -- ^ From the given position until the end of the playlist.
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show)

instance MPDArg Range where
    prep :: Range -> Args
prep (Range Int
start Int
end) = [String] -> Args
Args [Int -> String
forall a. Show a => a -> String
show Int
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
end]
    prep (Start Int
start) = [String] -> Args
Args [Int -> String
forall a. Show a => a -> String
show Int
start String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"]

newtype Id = Id Int
    deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)

instance (MPDArg Id) where
    prep :: Id -> Args
prep (Id Int
x) = Int -> Args
forall a. MPDArg a => a -> Args
prep Int
x

newtype Priority = Priority Int
  deriving (Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show)

instance (MPDArg Priority) where
  prep :: Priority -> Args
prep (Priority Int
x) = Int -> Args
forall a. MPDArg a => a -> Args
prep Int
x

-- | Get list of specific tag type
sgGetTag :: Metadata -> Song -> Maybe [Value]
sgGetTag :: Metadata -> Song -> Maybe [Value]
sgGetTag Metadata
meta Song
s = Metadata -> Map Metadata [Value] -> Maybe [Value]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Metadata
meta (Map Metadata [Value] -> Maybe [Value])
-> Map Metadata [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ Song -> Map Metadata [Value]
sgTags Song
s

-- | Add metadata tag value.
sgAddTag :: Metadata -> Value -> Song -> Song
sgAddTag :: Metadata -> Value -> Song -> Song
sgAddTag Metadata
meta Value
value Song
s = Song
s { sgTags :: Map Metadata [Value]
sgTags = ([Value] -> [Value] -> [Value])
-> Metadata
-> [Value]
-> Map Metadata [Value]
-> Map Metadata [Value]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
(++) Metadata
meta [Value
value] (Song -> Map Metadata [Value]
sgTags Song
s) }

defaultSong :: Path -> Song
defaultSong :: Path -> Song
defaultSong Path
path =
    Song :: Path
-> Map Metadata [Value]
-> Maybe UTCTime
-> Integer
-> Maybe Id
-> Maybe Int
-> Song
Song { sgFilePath :: Path
sgFilePath = Path
path, sgTags :: Map Metadata [Value]
sgTags = Map Metadata [Value]
forall k a. Map k a
M.empty, sgLastModified :: Maybe UTCTime
sgLastModified = Maybe UTCTime
forall a. Maybe a
Nothing
         , sgLength :: Integer
sgLength = Integer
0, sgId :: Maybe Id
sgId = Maybe Id
forall a. Maybe a
Nothing, sgIndex :: Maybe Int
sgIndex = Maybe Int
forall a. Maybe a
Nothing }

-- | Container for database statistics.
data Stats =
    Stats { Stats -> Integer
stsArtists    :: Integer -- ^ Number of artists.
          , Stats -> Integer
stsAlbums     :: Integer -- ^ Number of albums.
          , Stats -> Integer
stsSongs      :: Integer -- ^ Number of songs.
          , Stats -> Integer
stsUptime     :: Seconds -- ^ Daemon uptime in seconds.
          , Stats -> Integer
stsPlaytime   :: Seconds -- ^ Total playing time.
          , Stats -> Integer
stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in
                                     --   the database.
          , Stats -> Integer
stsDbUpdate   :: Integer -- ^ Last database update in UNIX time.
          }
    deriving (Stats -> Stats -> Bool
(Stats -> Stats -> Bool) -> (Stats -> Stats -> Bool) -> Eq Stats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stats -> Stats -> Bool
$c/= :: Stats -> Stats -> Bool
== :: Stats -> Stats -> Bool
$c== :: Stats -> Stats -> Bool
Eq, Int -> Stats -> ShowS
[Stats] -> ShowS
Stats -> String
(Int -> Stats -> ShowS)
-> (Stats -> String) -> ([Stats] -> ShowS) -> Show Stats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stats] -> ShowS
$cshowList :: [Stats] -> ShowS
show :: Stats -> String
$cshow :: Stats -> String
showsPrec :: Int -> Stats -> ShowS
$cshowsPrec :: Int -> Stats -> ShowS
Show)

defaultStats :: Stats
defaultStats :: Stats
defaultStats =
     Stats :: Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Stats
Stats { stsArtists :: Integer
stsArtists = Integer
0, stsAlbums :: Integer
stsAlbums = Integer
0, stsSongs :: Integer
stsSongs = Integer
0, stsUptime :: Integer
stsUptime = Integer
0
           , stsPlaytime :: Integer
stsPlaytime = Integer
0, stsDbPlaytime :: Integer
stsDbPlaytime = Integer
0, stsDbUpdate :: Integer
stsDbUpdate = Integer
0 }

instance Default Stats where
    def :: Stats
def = Stats
defaultStats

-- | Volume values.
--
-- Values of this type are always in the range 0-100.
--
-- Arithmetic on volumes has the property that:
--
-- @current + new = 100 if current + new > 100@
--
-- @current - new = 0   if current - new < 0@
--
-- but @current / 0@ still yields a division by zero exception.
newtype Volume = Volume Int deriving (Volume -> Volume -> Bool
(Volume -> Volume -> Bool)
-> (Volume -> Volume -> Bool) -> Eq Volume
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Volume -> Volume -> Bool
$c/= :: Volume -> Volume -> Bool
== :: Volume -> Volume -> Bool
$c== :: Volume -> Volume -> Bool
Eq, Eq Volume
Eq Volume
-> (Volume -> Volume -> Ordering)
-> (Volume -> Volume -> Bool)
-> (Volume -> Volume -> Bool)
-> (Volume -> Volume -> Bool)
-> (Volume -> Volume -> Bool)
-> (Volume -> Volume -> Volume)
-> (Volume -> Volume -> Volume)
-> Ord Volume
Volume -> Volume -> Bool
Volume -> Volume -> Ordering
Volume -> Volume -> Volume
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 :: Volume -> Volume -> Volume
$cmin :: Volume -> Volume -> Volume
max :: Volume -> Volume -> Volume
$cmax :: Volume -> Volume -> Volume
>= :: Volume -> Volume -> Bool
$c>= :: Volume -> Volume -> Bool
> :: Volume -> Volume -> Bool
$c> :: Volume -> Volume -> Bool
<= :: Volume -> Volume -> Bool
$c<= :: Volume -> Volume -> Bool
< :: Volume -> Volume -> Bool
$c< :: Volume -> Volume -> Bool
compare :: Volume -> Volume -> Ordering
$ccompare :: Volume -> Volume -> Ordering
$cp1Ord :: Eq Volume
Ord)

instance Show Volume where
    showsPrec :: Int -> Volume -> ShowS
showsPrec Int
p (Volume Int
v) = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Int
v

instance Enum Volume where
    toEnum :: Int -> Volume
toEnum = Int -> Volume
Volume (Int -> Volume) -> (Int -> Int) -> Int -> Volume
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0
    fromEnum :: Volume -> Int
fromEnum (Volume Int
x) = Int
x

instance Bounded Volume where
    minBound :: Volume
minBound = Volume
0
    maxBound :: Volume
maxBound = Volume
100

instance Num Volume where
    Volume Int
x + :: Volume -> Volume -> Volume
+ Volume Int
y = Int -> Volume
forall a. Enum a => Int -> a
toEnum (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
    Volume Int
x - :: Volume -> Volume -> Volume
- Volume Int
y = Int -> Volume
forall a. Enum a => Int -> a
toEnum (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)
    Volume Int
x * :: Volume -> Volume -> Volume
* Volume Int
y = Int -> Volume
forall a. Enum a => Int -> a
toEnum (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)

    negate :: Volume -> Volume
negate = Volume -> Volume
forall a. a -> a
id
    abs :: Volume -> Volume
abs    = Volume -> Volume
forall a. a -> a
id
    signum :: Volume -> Volume
signum = Volume -> Volume -> Volume
forall a b. a -> b -> a
const Volume
0

    fromInteger :: Integer -> Volume
fromInteger = Int -> Volume
forall a. Enum a => Int -> a
toEnum (Int -> Volume) -> (Integer -> Int) -> Integer -> Volume
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Integral Volume where
    quotRem :: Volume -> Volume -> (Volume, Volume)
quotRem (Volume Int
x) (Volume Int
y) =
        let (Int
x', Int
y') = Int
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
y in (Int -> Volume
Volume Int
x', Int -> Volume
Volume Int
y')
    divMod :: Volume -> Volume -> (Volume, Volume)
divMod = Volume -> Volume -> (Volume, Volume)
forall a. Integral a => a -> a -> (a, a)
quotRem
    toInteger :: Volume -> Integer
toInteger (Volume Int
x) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x

instance Real Volume where
    toRational :: Volume -> Rational
toRational (Volume Int
x) = Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x

instance MPDArg Volume where
    prep :: Volume -> Args
prep (Volume Int
x) = Int -> Args
forall a. MPDArg a => a -> Args
prep Int
x

-- | Container for MPD status.
data Status =
    Status { Status -> PlaybackState
stState :: PlaybackState
             -- | A percentage (0-100).
             --
             -- 'Nothing' indicates that the output lacks mixer support.
           , Status -> Maybe Volume
stVolume          :: Maybe Volume
           , Status -> Bool
stRepeat          :: Bool
           , Status -> Bool
stRandom          :: Bool
             -- | A value that is incremented by the server every time the
             --   playlist changes.
           , Status -> Integer
stPlaylistVersion :: Integer
             -- | The number of items in the current playlist.
           , Status -> Integer
stPlaylistLength  :: Integer
             -- | Current song's position in the playlist.
           , Status -> Maybe Int
stSongPos         :: Maybe Position
             -- | Current song's playlist ID.
           , Status -> Maybe Id
stSongID          :: Maybe Id
             -- | Next song's position in the playlist.
           , Status -> Maybe Int
stNextSongPos     :: Maybe Position
             -- | Next song's playlist ID.
           , Status -> Maybe Id
stNextSongID      :: Maybe Id
             -- | Time elapsed\/total time of playing song (if any).
           , Status -> Maybe (FractionalSeconds, FractionalSeconds)
stTime            :: Maybe (FractionalSeconds, FractionalSeconds)
             -- | Bitrate (in kilobytes per second) of playing song (if any).
           , Status -> Maybe Int
stBitrate         :: Maybe Int
             -- | Crossfade time.
           , Status -> Integer
stXFadeWidth      :: Seconds
             -- | MixRamp threshold in dB
           , Status -> FractionalSeconds
stMixRampdB       :: Double
             -- | MixRamp extra delay in seconds
           , Status -> FractionalSeconds
stMixRampDelay    :: Double
             -- | Samplerate\/bits\/channels for the chosen output device
             --   (see mpd.conf).
           , Status -> (Int, Int, Int)
stAudio           :: (Int, Int, Int)
             -- | Job ID of currently running update (if any).
           , Status -> Maybe Integer
stUpdatingDb      :: Maybe Integer
             -- | If True, MPD will play only one song and stop after finishing it.
             -- If single is set to "oneshot" by another client, it's interperted as True.
           , Status -> Bool
stSingle          :: Bool
             -- | If True, a song will be removed after it has been played.
           , Status -> Bool
stConsume         :: Bool
             -- | Last error message (if any).
           , Status -> Maybe String
stError           :: Maybe String
             -- | The name of MPD partition.
           , Status -> String
stPartition       :: String }
    deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

defaultStatus :: Status
defaultStatus :: Status
defaultStatus =
    Status :: PlaybackState
-> Maybe Volume
-> Bool
-> Bool
-> Integer
-> Integer
-> Maybe Int
-> Maybe Id
-> Maybe Int
-> Maybe Id
-> Maybe (FractionalSeconds, FractionalSeconds)
-> Maybe Int
-> Integer
-> FractionalSeconds
-> FractionalSeconds
-> (Int, Int, Int)
-> Maybe Integer
-> Bool
-> Bool
-> Maybe String
-> String
-> Status
Status { stState :: PlaybackState
stState = PlaybackState
Stopped, stVolume :: Maybe Volume
stVolume = Volume -> Maybe Volume
forall a. a -> Maybe a
Just Volume
0, stRepeat :: Bool
stRepeat = Bool
False
           , stRandom :: Bool
stRandom = Bool
False, stPlaylistVersion :: Integer
stPlaylistVersion = Integer
0, stPlaylistLength :: Integer
stPlaylistLength = Integer
0
           , stSongPos :: Maybe Int
stSongPos = Maybe Int
forall a. Maybe a
Nothing, stSongID :: Maybe Id
stSongID = Maybe Id
forall a. Maybe a
Nothing, stTime :: Maybe (FractionalSeconds, FractionalSeconds)
stTime = Maybe (FractionalSeconds, FractionalSeconds)
forall a. Maybe a
Nothing
           , stNextSongPos :: Maybe Int
stNextSongPos = Maybe Int
forall a. Maybe a
Nothing, stNextSongID :: Maybe Id
stNextSongID = Maybe Id
forall a. Maybe a
Nothing
           , stBitrate :: Maybe Int
stBitrate = Maybe Int
forall a. Maybe a
Nothing, stXFadeWidth :: Integer
stXFadeWidth = Integer
0, stMixRampdB :: FractionalSeconds
stMixRampdB = FractionalSeconds
0
           , stMixRampDelay :: FractionalSeconds
stMixRampDelay = FractionalSeconds
0, stAudio :: (Int, Int, Int)
stAudio = (Int
0,Int
0,Int
0), stUpdatingDb :: Maybe Integer
stUpdatingDb = Maybe Integer
forall a. Maybe a
Nothing
           , stSingle :: Bool
stSingle = Bool
False, stConsume :: Bool
stConsume = Bool
False, stError :: Maybe String
stError = Maybe String
forall a. Maybe a
Nothing
           , stPartition :: String
stPartition = String
"" }

instance Default Status where
    def :: Status
def = Status
defaultStatus