{-# LANGUAGE OverloadedStrings #-}

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

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

Reflection.
-}

module Network.MPD.Applicative.Reflection
    ( commands
    , notCommands
    , tagTypes
    , urlHandlers
    , decoders
    , config
    ) where

import           Network.MPD.Util
import           Network.MPD.Applicative.Internal
import           Network.MPD.Applicative.Util

import           Control.Applicative
import           Prelude hiding (repeat, read)

import qualified Data.ByteString.UTF8 as UTF8

-- | Get a list of available commands.
commands :: Command [String]
commands :: Command [String]
commands = Parser [String] -> [String] -> Command [String]
forall a. Parser a -> [String] -> Command a
Command Parser [String]
p [String
"commands"]
    where
        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

-- | Get a list of unavailable commands (i.e., commands that require
-- an authenticated session).
notCommands :: Command [String]
notCommands :: Command [String]
notCommands = Parser [String] -> [String] -> Command [String]
forall a. Parser a -> [String] -> Command a
Command Parser [String]
p [String
"notcommands"]
    where
        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

-- | Get a list of available song metadata.
tagTypes :: Command [String]
tagTypes :: Command [String]
tagTypes = Parser [String] -> [String] -> Command [String]
forall a. Parser a -> [String] -> Command a
Command Parser [String]
p [String
"tagtypes"]
    where
        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

-- | Get a list of available URL handlers.
urlHandlers :: Command [String]
urlHandlers :: Command [String]
urlHandlers = Parser [String] -> [String] -> Command [String]
forall a. Parser a -> [String] -> Command a
Command Parser [String]
p [String
"urlhandlers"]
    where
        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

-- | Get a list of available decoder plugins, with their supported
-- suffixes and MIME types.
decoders :: Command [(String, [(String, String)])]
decoders :: Command [(String, [(String, String)])]
decoders = Parser [(String, [(String, String)])]
-> [String] -> Command [(String, [(String, String)])]
forall a. Parser a -> [String] -> Command a
Command Parser [(String, [(String, String)])]
p [String
"decoders"]
    where
        p :: Parser [(String, [(String, String)])]
p = [(ByteString, ByteString)] -> [(String, [(String, String)])]
takeDecoders ([(ByteString, ByteString)] -> [(String, [(String, String)])])
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> [(String, [(String, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList ([ByteString] -> [(String, [(String, String)])])
-> Parser [ByteString] -> Parser [(String, [(String, String)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ByteString]
getResponse

        takeDecoders :: [(ByteString, ByteString)] -> [(String, [(String, String)])]
takeDecoders [] = []
        takeDecoders ((ByteString
_, ByteString
m):[(ByteString, ByteString)]
xs) =
            let ([(ByteString, ByteString)]
info, [(ByteString, ByteString)]
rest) = ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)]
-> ([(ByteString, ByteString)], [(ByteString, ByteString)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) ByteString
"plugin" (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, ByteString)]
xs
            in (ByteString -> String
UTF8.toString ByteString
m, ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> (String, String)
decodePair [(ByteString, ByteString)]
info) (String, [(String, String)])
-> [(String, [(String, String)])] -> [(String, [(String, String)])]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)] -> [(String, [(String, String)])]
takeDecoders [(ByteString, ByteString)]
rest

-- | Get configuration values of interest to a client.
--
-- Note: only permitted for clients connected via a unix domain
-- socket (aka \"local clients\").
config :: Command [(String, String)]
config :: Command [(String, String)]
config = Parser [(String, String)] -> [String] -> Command [(String, String)]
forall a. Parser a -> [String] -> Command a
Command Parser [(String, String)]
p [String
"config"]
  where
    p :: Parser [(String, String)]
p = ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
k, ByteString
v) -> (ByteString -> String
UTF8.toString ByteString
k, ByteString -> String
UTF8.toString ByteString
v)) ([(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