{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}

{- |
Module      : Network.MPD.Commands.Arg
Copyright   : (c) Joachim Fasting, Simon Hengel 2012
License     : MIT

Maintainer  : Joachim Fasting <joachifm@fastmail.fm>
Stability   : alpha
Portability : unportable

Prepare command arguments.
-}

module Network.MPD.Commands.Arg (Command, Args(..), MPDArg(..), (<++>), (<@>),Sign(..)) where

import           Network.MPD.Util (showBool)

import           Data.ByteString (ByteString)
import qualified Data.ByteString.UTF8 as UTF8
import           Data.String

-- | Arguments for getResponse are accumulated as strings in values of
-- this type after being converted from whatever type (an instance of
-- MPDArg) they were to begin with.
newtype Args = Args [String]
    deriving Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show

-- | A uniform interface for argument preparation
-- The basic idea is that one should be able
-- to magically prepare an argument for use with
-- an MPD command, without necessarily knowing/\caring
-- how it needs to be represented internally.
class Show a => MPDArg a where
    prep :: a -> Args
    -- Note that because of this, we almost
    -- never have to actually provide
    -- an implementation of 'prep'
    prep = [String] -> Args
Args ([String] -> Args) -> (a -> [String]) -> a -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> (a -> String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Groups together arguments to getResponse.
infixl 3 <++>
(<++>) :: (MPDArg a, MPDArg b) => a -> b -> Args
a
x <++> :: a -> b -> Args
<++> b
y = [String] -> Args
Args ([String] -> Args) -> [String] -> Args
forall a b. (a -> b) -> a -> b
$ [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ys
    where Args [String]
xs = a -> Args
forall a. MPDArg a => a -> Args
prep a
x
          Args [String]
ys = b -> Args
forall a. MPDArg a => a -> Args
prep b
y

newtype Command = Command String
  deriving String -> Command
(String -> Command) -> IsString Command
forall a. (String -> a) -> IsString a
fromString :: String -> Command
$cfromString :: String -> Command
IsString

-- | Converts a command name and a string of arguments into the string
-- to hand to getResponse.
infix 2 <@>
(<@>) :: (MPDArg a) => Command -> a -> String
Command String
x <@> :: Command -> a -> String
<@> a
y = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
y'
    where Args [String]
y' = a -> Args
forall a. MPDArg a => a -> Args
prep a
y

instance MPDArg Args where prep :: Args -> Args
prep = Args -> Args
forall a. a -> a
id

instance MPDArg String where
    -- We do this to avoid mangling
    -- non-ascii characters with 'show'
    prep :: String -> Args
prep String
x = [String] -> Args
Args [Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
addSlashes String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""]

instance MPDArg ByteString where
    prep :: ByteString -> Args
prep = String -> Args
forall a. MPDArg a => a -> Args
prep (String -> Args) -> (ByteString -> String) -> ByteString -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

instance (MPDArg a) => MPDArg (Maybe a) where
    prep :: Maybe a -> Args
prep Maybe a
Nothing = [String] -> Args
Args []
    prep (Just a
x) = a -> Args
forall a. MPDArg a => a -> Args
prep a
x

instance (MPDArg a, MPDArg b) => MPDArg (a, b) where
    prep :: (a, b) -> Args
prep (a
x, b
y) = [String] -> Args
Args [a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
y]

instance MPDArg Int
instance MPDArg Integer
instance MPDArg Bool where prep :: Bool -> Args
prep = [String] -> Args
Args ([String] -> Args) -> (Bool -> [String]) -> Bool -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> (Bool -> String) -> Bool -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. IsString a => Bool -> a
showBool
instance MPDArg Double

-- | Wrapper for creating signed instances of MPDArg.
--
-- @since 0.9.2.0
newtype Sign a = Sign {Sign a -> a
unSign :: a}
  deriving (Int -> Sign a -> ShowS
[Sign a] -> ShowS
Sign a -> String
(Int -> Sign a -> ShowS)
-> (Sign a -> String) -> ([Sign a] -> ShowS) -> Show (Sign a)
forall a. Show a => Int -> Sign a -> ShowS
forall a. Show a => [Sign a] -> ShowS
forall a. Show a => Sign a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign a] -> ShowS
$cshowList :: forall a. Show a => [Sign a] -> ShowS
show :: Sign a -> String
$cshow :: forall a. Show a => Sign a -> String
showsPrec :: Int -> Sign a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sign a -> ShowS
Show)

instance (Num a,Ord a,Show a) => MPDArg (Sign a) where
  prep :: Sign a -> Args
prep Sign a
sx | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = [String] -> Args
Args [String
"+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x]
          | Bool
otherwise  = [String] -> Args
Args [a -> String
forall a. Show a => a -> String
show a
x]
    where x :: a
x = Sign a -> a
forall a. Sign a -> a
unSign Sign a
sx

addSlashes :: String -> String
addSlashes :: ShowS
addSlashes = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeSpecial
    where specials :: String
specials = String
"\\\""
          escapeSpecial :: Char -> String
escapeSpecial Char
x
              | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
specials = [Char
'\\', Char
x]
              | Bool
otherwise = [Char
x]