{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Network.MPD.Applicative.Internal
( Parser(..)
, liftParser
, getResponse
, emptyResponse
, unexpected
, Command(..)
, runCommand
) where
import Control.Monad
import Data.ByteString.Char8 (ByteString)
import Network.MPD.Core hiding (getResponse)
import qualified Network.MPD.Core as Core
import Control.Monad.Except
import qualified Control.Monad.Fail as Fail
newtype Parser a
= Parser { forall a.
Parser a -> [ByteString] -> Either String (a, [ByteString])
runParser :: [ByteString] -> Either String (a, [ByteString]) }
deriving (forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
$c<$ :: forall a b. a -> Parser b -> Parser a
<$ :: forall a b. a -> Parser b -> Parser a
Functor
instance Monad Parser where
return :: forall a. a -> Parser a
return a
a = ([ByteString] -> Either String (a, [ByteString])) -> Parser a
forall a.
([ByteString] -> Either String (a, [ByteString])) -> Parser a
Parser (([ByteString] -> Either String (a, [ByteString])) -> Parser a)
-> ([ByteString] -> Either String (a, [ByteString])) -> Parser a
forall a b. (a -> b) -> a -> b
$ \[ByteString]
input -> (a, [ByteString]) -> Either String (a, [ByteString])
forall a b. b -> Either a b
Right (a
a, [ByteString]
input)
Parser a
p1 >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
p2 = ([ByteString] -> Either String (b, [ByteString])) -> Parser b
forall a.
([ByteString] -> Either String (a, [ByteString])) -> Parser a
Parser (([ByteString] -> Either String (b, [ByteString])) -> Parser b)
-> ([ByteString] -> Either String (b, [ByteString])) -> Parser b
forall a b. (a -> b) -> a -> b
$ \[ByteString]
input -> Parser a -> [ByteString] -> Either String (a, [ByteString])
forall a.
Parser a -> [ByteString] -> Either String (a, [ByteString])
runParser Parser a
p1 [ByteString]
input Either String (a, [ByteString])
-> ((a, [ByteString]) -> Either String (b, [ByteString]))
-> Either String (b, [ByteString])
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> [ByteString] -> Either String (b, [ByteString]))
-> (a, [ByteString]) -> Either String (b, [ByteString])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Parser b -> [ByteString] -> Either String (b, [ByteString])
forall a.
Parser a -> [ByteString] -> Either String (a, [ByteString])
runParser (Parser b -> [ByteString] -> Either String (b, [ByteString]))
-> (a -> Parser b)
-> a
-> [ByteString]
-> Either String (b, [ByteString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser b
p2)
instance Fail.MonadFail Parser where
fail :: forall a. String -> Parser a
fail = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
instance Applicative Parser where
pure :: forall a. a -> Parser a
pure = a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
liftParser :: ([ByteString] -> Either String a) -> Parser a
liftParser :: forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String a
p = ([ByteString] -> Either String (a, [ByteString])) -> Parser a
forall a.
([ByteString] -> Either String (a, [ByteString])) -> Parser a
Parser (([ByteString] -> Either String (a, [ByteString])) -> Parser a)
-> ([ByteString] -> Either String (a, [ByteString])) -> Parser a
forall a b. (a -> b) -> a -> b
$ \[ByteString]
input -> case (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"list_OK") [ByteString]
input of
([ByteString]
xs, [ByteString]
ys) -> (a -> (a, [ByteString]))
-> Either String a -> Either String (a, [ByteString])
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 [ByteString]
ys) ([ByteString] -> Either String a
p [ByteString]
xs)
getResponse :: Parser [ByteString]
getResponse :: Parser [ByteString]
getResponse = ([ByteString] -> Either String ([ByteString], [ByteString]))
-> Parser [ByteString]
forall a.
([ByteString] -> Either String (a, [ByteString])) -> Parser a
Parser (([ByteString] -> Either String ([ByteString], [ByteString]))
-> Parser [ByteString])
-> ([ByteString] -> Either String ([ByteString], [ByteString]))
-> Parser [ByteString]
forall a b. (a -> b) -> a -> b
$ \[ByteString]
input -> case (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"list_OK") [ByteString]
input of
([ByteString]
xs, [ByteString]
ys) -> ([ByteString], [ByteString])
-> Either String ([ByteString], [ByteString])
forall a b. b -> Either a b
Right ([ByteString]
xs, Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 [ByteString]
ys)
emptyResponse :: Parser ()
emptyResponse :: Parser ()
emptyResponse = do
[ByteString]
r <- Parser [ByteString]
getResponse
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
r) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
[ByteString] -> Parser ()
forall a. [ByteString] -> Parser a
unexpected [ByteString]
r
unexpected :: [ByteString] -> Parser a
unexpected :: forall a. [ByteString] -> Parser a
unexpected = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a)
-> ([ByteString] -> String) -> [ByteString] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"unexpected Response: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> ([ByteString] -> String) -> [ByteString] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> String
forall a. Show a => a -> String
show
data Command a = Command {
forall a. Command a -> Parser a
commandParser :: Parser a
, forall a. Command a -> [String]
commandRequest :: [String]
} deriving (forall a b. (a -> b) -> Command a -> Command b)
-> (forall a b. a -> Command b -> Command a) -> Functor Command
forall a b. a -> Command b -> Command a
forall a b. (a -> b) -> Command a -> Command b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Command a -> Command b
fmap :: forall a b. (a -> b) -> Command a -> Command b
$c<$ :: forall a b. a -> Command b -> Command a
<$ :: forall a b. a -> Command b -> Command a
Functor
instance Applicative Command where
pure :: forall a. a -> Command a
pure a
a = Parser a -> [String] -> Command a
forall a. Parser a -> [String] -> Command a
Command (a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) []
(Command Parser (a -> b)
p1 [String]
c1) <*> :: forall a b. Command (a -> b) -> Command a -> Command b
<*> (Command Parser a
p2 [String]
c2) = Parser b -> [String] -> Command b
forall a. Parser a -> [String] -> Command a
Command (Parser (a -> b)
p1 Parser (a -> b) -> Parser a -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p2) ([String]
c1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
c2)
runCommand :: MonadMPD m => Command a -> m a
runCommand :: forall (m :: * -> *) a. MonadMPD m => Command a -> m a
runCommand (Command Parser a
p [String]
c) = do
[ByteString]
r <- String -> m [ByteString]
forall (m :: * -> *). MonadMPD m => String -> m [ByteString]
Core.getResponse String
command
case Parser a -> [ByteString] -> Either String (a, [ByteString])
forall a.
Parser a -> [ByteString] -> Either String (a, [ByteString])
runParser Parser a
p [ByteString]
r of
Left String
err -> MPDError -> m a
forall a. MPDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> MPDError
Unexpected String
err)
Right (a
a, []) -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Right (a
_, [ByteString]
xs) -> MPDError -> m a
forall a. MPDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> MPDError
Unexpected (String -> MPDError) -> String -> MPDError
forall a b. (a -> b) -> a -> b
$ String
"superfluous input: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ByteString] -> String
forall a. Show a => a -> String
show [ByteString]
xs)
where
command :: String
command = case [String]
c of
[String
x] -> String
x
[String]
xs -> [String] -> String
unlines (String
"command_list_ok_begin" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"command_list_end"