{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}
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
class ToString a where
toString :: a -> String
toText :: a -> Text
toUtf8 :: a -> ByteString
type Artist = Value
type Album = Value
type Title = Value
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
$c== :: PlaylistName -> PlaylistName -> Bool
== :: PlaylistName -> PlaylistName -> Bool
$c/= :: PlaylistName -> PlaylistName -> Bool
/= :: 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
$cshowsPrec :: Int -> PlaylistName -> ShowS
showsPrec :: Int -> PlaylistName -> ShowS
$cshow :: PlaylistName -> String
show :: PlaylistName -> String
$cshowList :: [PlaylistName] -> ShowS
showList :: [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
$ccompare :: PlaylistName -> PlaylistName -> Ordering
compare :: PlaylistName -> PlaylistName -> Ordering
$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
>= :: PlaylistName -> PlaylistName -> Bool
$cmax :: PlaylistName -> PlaylistName -> PlaylistName
max :: PlaylistName -> PlaylistName -> PlaylistName
$cmin :: PlaylistName -> PlaylistName -> PlaylistName
min :: PlaylistName -> PlaylistName -> PlaylistName
Ord, Show PlaylistName
Show PlaylistName => (PlaylistName -> Args) -> MPDArg PlaylistName
PlaylistName -> Args
forall a. Show a => (a -> Args) -> MPDArg a
$cprep :: PlaylistName -> Args
prep :: PlaylistName -> Args
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
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
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: 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
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [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
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$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
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord, Show Path
Show Path => (Path -> Args) -> MPDArg Path
Path -> Args
forall a. Show a => (a -> Args) -> MPDArg a
$cprep :: Path -> Args
prep :: Path -> Args
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
data Metadata = Artist
| ArtistSort
| Album
| AlbumSort
| AlbumArtist
| AlbumArtistSort
| Title
| Track
| Name
| Genre
| Date
| OriginalDate
| Composer
| Performer
| Conductor
| Work
| Grouping
|
| Disc
| Label
| MUSICBRAINZ_ARTISTID
| MUSICBRAINZ_ALBUMID
| MUSICBRAINZ_ALBUMARTISTID
| MUSICBRAINZ_TRACKID
| MUSICBRAINZ_RELEASETRACKID
| MUSICBRAINZ_WORKID
deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: 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
$csucc :: Metadata -> Metadata
succ :: Metadata -> Metadata
$cpred :: Metadata -> Metadata
pred :: Metadata -> Metadata
$ctoEnum :: Int -> Metadata
toEnum :: Int -> Metadata
$cfromEnum :: Metadata -> Int
fromEnum :: Metadata -> Int
$cenumFrom :: Metadata -> [Metadata]
enumFrom :: Metadata -> [Metadata]
$cenumFromThen :: Metadata -> Metadata -> [Metadata]
enumFromThen :: Metadata -> Metadata -> [Metadata]
$cenumFromTo :: Metadata -> Metadata -> [Metadata]
enumFromTo :: Metadata -> Metadata -> [Metadata]
$cenumFromThenTo :: Metadata -> Metadata -> Metadata -> [Metadata]
enumFromThenTo :: Metadata -> Metadata -> 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
$ccompare :: Metadata -> Metadata -> Ordering
compare :: Metadata -> Metadata -> Ordering
$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
>= :: Metadata -> Metadata -> Bool
$cmax :: Metadata -> Metadata -> Metadata
max :: Metadata -> Metadata -> Metadata
$cmin :: Metadata -> Metadata -> Metadata
min :: Metadata -> Metadata -> Metadata
Ord, Metadata
Metadata -> Metadata -> Bounded Metadata
forall a. a -> a -> Bounded a
$cminBound :: Metadata
minBound :: Metadata
$cmaxBound :: Metadata
maxBound :: 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
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show)
instance MPDArg Metadata
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
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: 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
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [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
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$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
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord, Show Value
Show Value => (Value -> Args) -> MPDArg Value
Value -> Args
forall a. Show a => (a -> Args) -> MPDArg a
$cprep :: Value -> Args
prep :: Value -> Args
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
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
$c== :: ObjectType -> ObjectType -> Bool
== :: ObjectType -> ObjectType -> Bool
$c/= :: ObjectType -> ObjectType -> Bool
/= :: 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
$cshowsPrec :: Int -> ObjectType -> ShowS
showsPrec :: Int -> ObjectType -> ShowS
$cshow :: ObjectType -> String
show :: ObjectType -> String
$cshowList :: [ObjectType] -> ShowS
showList :: [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
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
$c== :: PlaybackState -> PlaybackState -> Bool
== :: PlaybackState -> PlaybackState -> Bool
$c/= :: PlaybackState -> PlaybackState -> Bool
/= :: 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
$csucc :: PlaybackState -> PlaybackState
succ :: PlaybackState -> PlaybackState
$cpred :: PlaybackState -> PlaybackState
pred :: PlaybackState -> PlaybackState
$ctoEnum :: Int -> PlaybackState
toEnum :: Int -> PlaybackState
$cfromEnum :: PlaybackState -> Int
fromEnum :: PlaybackState -> Int
$cenumFrom :: PlaybackState -> [PlaybackState]
enumFrom :: PlaybackState -> [PlaybackState]
$cenumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFromThen :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
enumFromTo :: PlaybackState -> PlaybackState -> [PlaybackState]
$cenumFromThenTo :: PlaybackState -> PlaybackState -> PlaybackState -> [PlaybackState]
enumFromThenTo :: PlaybackState -> PlaybackState -> 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
$ccompare :: PlaybackState -> PlaybackState -> Ordering
compare :: PlaybackState -> PlaybackState -> Ordering
$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
>= :: PlaybackState -> PlaybackState -> Bool
$cmax :: PlaybackState -> PlaybackState -> PlaybackState
max :: PlaybackState -> PlaybackState -> PlaybackState
$cmin :: PlaybackState -> PlaybackState -> PlaybackState
min :: PlaybackState -> PlaybackState -> PlaybackState
Ord, PlaybackState
PlaybackState -> PlaybackState -> Bounded PlaybackState
forall a. a -> a -> Bounded a
$cminBound :: PlaybackState
minBound :: PlaybackState
$cmaxBound :: PlaybackState
maxBound :: 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
$cshowsPrec :: Int -> PlaybackState -> ShowS
showsPrec :: Int -> PlaybackState -> ShowS
$cshow :: PlaybackState -> String
show :: PlaybackState -> String
$cshowList :: [PlaybackState] -> ShowS
showList :: [PlaybackState] -> ShowS
Show)
data Subsystem
= DatabaseS
| UpdateS
| StoredPlaylistS
| PlaylistS
| PlayerS
| MixerS
| OutputS
| OptionsS
| PartitionS
| StickerS
| SubscriptionS
| MessageS
| NeighborS
| MountS
deriving (Subsystem -> Subsystem -> Bool
(Subsystem -> Subsystem -> Bool)
-> (Subsystem -> Subsystem -> Bool) -> Eq Subsystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Subsystem -> Subsystem -> Bool
== :: Subsystem -> Subsystem -> Bool
$c/= :: Subsystem -> Subsystem -> Bool
/= :: 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
$csucc :: Subsystem -> Subsystem
succ :: Subsystem -> Subsystem
$cpred :: Subsystem -> Subsystem
pred :: Subsystem -> Subsystem
$ctoEnum :: Int -> Subsystem
toEnum :: Int -> Subsystem
$cfromEnum :: Subsystem -> Int
fromEnum :: Subsystem -> Int
$cenumFrom :: Subsystem -> [Subsystem]
enumFrom :: Subsystem -> [Subsystem]
$cenumFromThen :: Subsystem -> Subsystem -> [Subsystem]
enumFromThen :: Subsystem -> Subsystem -> [Subsystem]
$cenumFromTo :: Subsystem -> Subsystem -> [Subsystem]
enumFromTo :: Subsystem -> Subsystem -> [Subsystem]
$cenumFromThenTo :: Subsystem -> Subsystem -> Subsystem -> [Subsystem]
enumFromThenTo :: Subsystem -> Subsystem -> 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
$ccompare :: Subsystem -> Subsystem -> Ordering
compare :: Subsystem -> Subsystem -> Ordering
$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
>= :: Subsystem -> Subsystem -> Bool
$cmax :: Subsystem -> Subsystem -> Subsystem
max :: Subsystem -> Subsystem -> Subsystem
$cmin :: Subsystem -> Subsystem -> Subsystem
min :: Subsystem -> Subsystem -> Subsystem
Ord, Subsystem
Subsystem -> Subsystem -> Bounded Subsystem
forall a. a -> a -> Bounded a
$cminBound :: Subsystem
minBound :: Subsystem
$cmaxBound :: Subsystem
maxBound :: 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
$cshowsPrec :: Int -> Subsystem -> ShowS
showsPrec :: Int -> Subsystem -> ShowS
$cshow :: Subsystem -> String
show :: Subsystem -> String
$cshowList :: [Subsystem] -> ShowS
showList :: [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
| TrackMode
| AlbumMode
| AutoMode
deriving (ReplayGainMode -> ReplayGainMode -> Bool
(ReplayGainMode -> ReplayGainMode -> Bool)
-> (ReplayGainMode -> ReplayGainMode -> Bool) -> Eq ReplayGainMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplayGainMode -> ReplayGainMode -> Bool
== :: ReplayGainMode -> ReplayGainMode -> Bool
$c/= :: ReplayGainMode -> ReplayGainMode -> Bool
/= :: 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
$csucc :: ReplayGainMode -> ReplayGainMode
succ :: ReplayGainMode -> ReplayGainMode
$cpred :: ReplayGainMode -> ReplayGainMode
pred :: ReplayGainMode -> ReplayGainMode
$ctoEnum :: Int -> ReplayGainMode
toEnum :: Int -> ReplayGainMode
$cfromEnum :: ReplayGainMode -> Int
fromEnum :: ReplayGainMode -> Int
$cenumFrom :: ReplayGainMode -> [ReplayGainMode]
enumFrom :: ReplayGainMode -> [ReplayGainMode]
$cenumFromThen :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFromThen :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
$cenumFromTo :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFromTo :: ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
$cenumFromThenTo :: ReplayGainMode
-> ReplayGainMode -> ReplayGainMode -> [ReplayGainMode]
enumFromThenTo :: ReplayGainMode
-> ReplayGainMode -> 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
$ccompare :: ReplayGainMode -> ReplayGainMode -> Ordering
compare :: ReplayGainMode -> ReplayGainMode -> Ordering
$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
>= :: ReplayGainMode -> ReplayGainMode -> Bool
$cmax :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
max :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
$cmin :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
min :: ReplayGainMode -> ReplayGainMode -> ReplayGainMode
Ord, ReplayGainMode
ReplayGainMode -> ReplayGainMode -> Bounded ReplayGainMode
forall a. a -> a -> Bounded a
$cminBound :: ReplayGainMode
minBound :: ReplayGainMode
$cmaxBound :: ReplayGainMode
maxBound :: 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
$cshowsPrec :: Int -> ReplayGainMode -> ShowS
showsPrec :: Int -> ReplayGainMode -> ShowS
$cshow :: ReplayGainMode -> String
show :: ReplayGainMode -> String
$cshowList :: [ReplayGainMode] -> ShowS
showList :: [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"]
data Count =
Count { Count -> Integer
cSongs :: Integer
, Count -> Integer
cPlaytime :: Seconds
}
deriving (Count -> Count -> Bool
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
/= :: 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
$cshowsPrec :: Int -> Count -> ShowS
showsPrec :: Int -> Count -> ShowS
$cshow :: Count -> String
show :: Count -> String
$cshowList :: [Count] -> ShowS
showList :: [Count] -> ShowS
Show)
defaultCount :: Count
defaultCount :: Count
defaultCount = Count { cSongs :: Integer
cSongs = Integer
0, cPlaytime :: Integer
cPlaytime = Integer
0 }
instance Default Count where
def :: Count
def = Count
defaultCount
data LsResult
= LsDirectory Path
| LsSong Song
| LsPlaylist PlaylistName
deriving (LsResult -> LsResult -> Bool
(LsResult -> LsResult -> Bool)
-> (LsResult -> LsResult -> Bool) -> Eq LsResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LsResult -> LsResult -> Bool
== :: LsResult -> LsResult -> Bool
$c/= :: LsResult -> LsResult -> Bool
/= :: 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
$cshowsPrec :: Int -> LsResult -> ShowS
showsPrec :: Int -> LsResult -> ShowS
$cshow :: LsResult -> String
show :: LsResult -> String
$cshowList :: [LsResult] -> ShowS
showList :: [LsResult] -> ShowS
Show)
data Device =
Device { Device -> Int
dOutputID :: Int
, Device -> String
dOutputName :: String
, 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
$c== :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
/= :: 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
$cshowsPrec :: Int -> Device -> ShowS
showsPrec :: Int -> Device -> ShowS
$cshow :: Device -> String
show :: Device -> String
$cshowList :: [Device] -> ShowS
showList :: [Device] -> ShowS
Show)
defaultDevice :: Device
defaultDevice :: Device
defaultDevice =
Device { dOutputID :: Int
dOutputID = Int
0, dOutputName :: String
dOutputName = String
"", dOutputEnabled :: Bool
dOutputEnabled = Bool
False }
instance Default Device where
def :: Device
def = Device
defaultDevice
data Song = Song
{ Song -> Path
sgFilePath :: Path
, Song -> Map Metadata [Value]
sgTags :: M.Map Metadata [Value]
, Song -> Maybe UTCTime
sgLastModified :: Maybe UTCTime
, Song -> Integer
sgLength :: Seconds
, Song -> Maybe Id
sgId :: Maybe Id
, 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
$c== :: Song -> Song -> Bool
== :: Song -> Song -> Bool
$c/= :: Song -> Song -> Bool
/= :: 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
$cshowsPrec :: Int -> Song -> ShowS
showsPrec :: Int -> Song -> ShowS
$cshow :: Song -> String
show :: Song -> String
$cshowList :: [Song] -> ShowS
showList :: [Song] -> ShowS
Show)
type Position = Int
data Range
= Range Position Position
| Start Position
deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: 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
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [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
$c== :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
/= :: 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
$cshowsPrec :: Int -> Id -> ShowS
showsPrec :: Int -> Id -> ShowS
$cshow :: Id -> String
show :: Id -> String
$cshowList :: [Id] -> ShowS
showList :: [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
$c== :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
/= :: 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
$cshowsPrec :: Int -> Priority -> ShowS
showsPrec :: Int -> Priority -> ShowS
$cshow :: Priority -> String
show :: Priority -> String
$cshowList :: [Priority] -> ShowS
showList :: [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
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
sgAddTag :: Metadata -> Value -> Song -> Song
sgAddTag :: Metadata -> Value -> Song -> Song
sgAddTag Metadata
meta Value
value Song
s = Song
s { sgTags = insertWith (++) meta [value] (sgTags s) }
defaultSong :: Path -> Song
defaultSong :: Path -> Song
defaultSong Path
path =
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 }
data Stats =
Stats { Stats -> Integer
stsArtists :: Integer
, Stats -> Integer
stsAlbums :: Integer
, Stats -> Integer
stsSongs :: Integer
, Stats -> Integer
stsUptime :: Seconds
, Stats -> Integer
stsPlaytime :: Seconds
, Stats -> Integer
stsDbPlaytime :: Seconds
, Stats -> Integer
stsDbUpdate :: Integer
}
deriving (Stats -> Stats -> Bool
(Stats -> Stats -> Bool) -> (Stats -> Stats -> Bool) -> Eq Stats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stats -> Stats -> Bool
== :: Stats -> Stats -> Bool
$c/= :: Stats -> Stats -> Bool
/= :: 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
$cshowsPrec :: Int -> Stats -> ShowS
showsPrec :: Int -> Stats -> ShowS
$cshow :: Stats -> String
show :: Stats -> String
$cshowList :: [Stats] -> ShowS
showList :: [Stats] -> ShowS
Show)
defaultStats :: Stats
defaultStats :: Stats
defaultStats =
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
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
$c== :: Volume -> Volume -> Bool
== :: Volume -> Volume -> Bool
$c/= :: Volume -> Volume -> Bool
/= :: 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
$ccompare :: Volume -> Volume -> Ordering
compare :: Volume -> Volume -> Ordering
$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
>= :: Volume -> Volume -> Bool
$cmax :: Volume -> Volume -> Volume
max :: Volume -> Volume -> Volume
$cmin :: Volume -> Volume -> Volume
min :: Volume -> Volume -> 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
data Status =
Status { Status -> PlaybackState
stState :: PlaybackState
, Status -> Maybe Volume
stVolume :: Maybe Volume
, Status -> Bool
stRepeat :: Bool
, Status -> Bool
stRandom :: Bool
, Status -> Integer
stPlaylistVersion :: Integer
, Status -> Integer
stPlaylistLength :: Integer
, Status -> Maybe Int
stSongPos :: Maybe Position
, Status -> Maybe Id
stSongID :: Maybe Id
, Status -> Maybe Int
stNextSongPos :: Maybe Position
, Status -> Maybe Id
stNextSongID :: Maybe Id
, Status -> Maybe (FractionalSeconds, FractionalSeconds)
stTime :: Maybe (FractionalSeconds, FractionalSeconds)
, Status -> Maybe Int
stBitrate :: Maybe Int
, Status -> Integer
stXFadeWidth :: Seconds
, Status -> FractionalSeconds
stMixRampdB :: Double
, Status -> FractionalSeconds
stMixRampDelay :: Double
, Status -> (Int, Int, Int)
stAudio :: (Int, Int, Int)
, Status -> Maybe Integer
stUpdatingDb :: Maybe Integer
, Status -> Bool
stSingle :: Bool
, Status -> Bool
stConsume :: Bool
, Status -> Maybe String
stError :: Maybe String
, 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
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: 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
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)
defaultStatus :: Status
defaultStatus :: Status
defaultStatus =
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