{-# 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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

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

newtype Command = Command String
  deriving String -> 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 <@> :: forall a. MPDArg a => Command -> a -> String
<@> a
y = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
x forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
y'
    where Args [String]
y' = forall a. MPDArg a => a -> Args
prep a
y

instance MPDArg Args where prep :: Args -> Args
prep = 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
'"' forall a. a -> [a] -> [a]
: ShowS
addSlashes String
x forall a. [a] -> [a] -> [a]
++ String
"\""]

instance MPDArg ByteString where
    prep :: ByteString -> Args
prep = forall a. MPDArg a => a -> Args
prep 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) = 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 [forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {forall a. Sign a -> a
unSign :: a}
  deriving (Int -> Sign a -> ShowS
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 forall a. Ord a => a -> a -> Bool
>= a
0 = [String] -> Args
Args [String
"+" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x]
          | Bool
otherwise  = [String] -> Args
Args [forall a. Show a => a -> String
show a
x]
    where x :: a
x = forall a. Sign a -> a
unSign Sign a
sx

addSlashes :: String -> String
addSlashes :: ShowS
addSlashes = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
specials = [Char
'\\', Char
x]
              | Bool
otherwise = [Char
x]