    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}

    {- |
    Module      : Network.MPD.Applicative.Internal
    Copyright   : (c) Simon Hengel 2012
    License     : MIT

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

    Applicative MPD command interface.

    This allows us to combine commands into command lists, as in

    > (,,) <$> currentSong <*> stats <*> status

    where the requests are automatically combined into a command list and
    the result of each command passed to the consumer.
    -}

    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

    -- | A line-oriented parser that returns a value along with any remaining input.
    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

    -- | Convert a regular parser.
    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)

    -- | Return everything until the next "list_OK".
    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)

    -- | For commands returning an empty response.
    emptyResponse :: Parser ()
    emptyResponse :: Parser ()
    emptyResponse = do
        r <- Parser [ByteString]
    getResponse
        unless (null r) $
            unexpected r

    -- | Fail with unexpected response.
    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

    -- | A compound command, comprising a parser for the responses and a
    -- combined request of an arbitrary number of commands.
    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)

    -- | Execute a 'Command'.
    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
        r <- String -> m [ByteString]
    forall (m :: * -> *). MonadMPD m => String -> m [ByteString]
    Core.getResponse String
    command
        case runParser p 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"