{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Network.MPD.Applicative.Stickers
Copyright   : (c) Joachim Fasting 2012
License     : MIT

Maintainer  : joachifm@fastmail.fm
Stability   : stable
Portability : unportable

Stickers.
-}

module Network.MPD.Applicative.Stickers
    ( stickerGet
    , stickerSet
    , stickerDelete
    , stickerList
    , stickerFind
    ) where

import           Network.MPD.Applicative.Internal
import           Network.MPD.Applicative.Util
import           Network.MPD.Commands.Arg hiding (Command)
import           Network.MPD.Commands.Types
import           Network.MPD.Util

import qualified Data.ByteString.UTF8 as UTF8

-- | Read sticker value for the object specified.
stickerGet :: ObjectType -> String -> String -> Command [String]
stickerGet :: ObjectType -> String -> String -> Command [String]
stickerGet ObjectType
typ String
uri String
name = Parser [String] -> [String] -> Command [String]
forall a. Parser a -> [String] -> Command a
Command Parser [String]
p [String]
c
    where
        p :: Parser [String]
        p :: Parser [String]
p = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
UTF8.toString ([ByteString] -> [String])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
takeValues ([ByteString] -> [String])
-> Parser [ByteString] -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ByteString]
getResponse

        c :: [String]
c = [Command
"sticker get" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> ObjectType
typ ObjectType -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
uri Args -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
name]

-- | Add sticker value to the object. Will overwrite existing stickers
-- with the same name.
stickerSet :: ObjectType -> String -> String -> String -> Command ()
stickerSet :: ObjectType -> String -> String -> String -> Command ()
stickerSet ObjectType
typ String
uri String
name String
value = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String]
c
    where
        c :: [String]
c = [Command
"sticker set" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> ObjectType
typ ObjectType -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
uri Args -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
name Args -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
value]

-- | Delete a sticker value from the object. If no sticker name is
-- given, all sticker values attached to the object are deleted.
stickerDelete :: ObjectType -> String -> String -> Command ()
stickerDelete :: ObjectType -> String -> String -> Command ()
stickerDelete ObjectType
typ String
uri String
name = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String]
c
    where
        c :: [String]
c = [Command
"sticker delete" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> ObjectType
typ ObjectType -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
uri Args -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
name]

-- | List stickers for the object.
stickerList :: ObjectType -> String -> Command [(String, String)]
stickerList :: ObjectType -> String -> Command [(String, String)]
stickerList ObjectType
typ String
uri = Parser [(String, String)] -> [String] -> Command [(String, String)]
forall a. Parser a -> [String] -> Command a
Command Parser [(String, String)]
p [String]
c
    where
        p :: Parser [(String, String)]
p = ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> (String, String)
decodePair ([(ByteString, ByteString)] -> [(String, String)])
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList ([ByteString] -> [(String, String)])
-> Parser [ByteString] -> Parser [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ByteString]
getResponse

        c :: [String]
c = [Command
"sticker list" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> ObjectType
typ ObjectType -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
uri]

-- | Search the sticker database for stickers with the specified name,
-- below the specified directory.
stickerFind :: ObjectType -> String -> String -> Command [(String, String)]
stickerFind :: ObjectType -> String -> String -> Command [(String, String)]
stickerFind ObjectType
typ String
uri String
name = Parser [(String, String)] -> [String] -> Command [(String, String)]
forall a. Parser a -> [String] -> Command a
Command Parser [(String, String)]
p [String]
c
    where
        p :: Parser [(String, String)]
p = ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> (String, String)
decodePair ([(ByteString, ByteString)] -> [(String, String)])
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList ([ByteString] -> [(String, String)])
-> Parser [ByteString] -> Parser [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ByteString]
getResponse

        c :: [String]
c = [Command
"sticker find" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> ObjectType
typ ObjectType -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
uri Args -> String -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> String
name]