diff --git a/Internal.hs b/Internal.hs deleted file mode 100644 index 36804ee..0000000 --- a/Internal.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# 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 Internal - ( Parser(..) - , liftParser - , getResponse - , emptyResponse - , unexpected - , Command(..) - , runCommand - ) where - -import Control.Applicative -import Control.Monad -import Data.ByteString.Char8 (ByteString) - -import Network.MPD.Core hiding (getResponse) -import qualified Network.MPD.Core as Core -import Control.Monad.Error - --- | A line-oriented parser that returns a value along with any remaining input. -newtype Parser a - = Parser { runParser :: [ByteString] -> Either String (a, [ByteString]) } - deriving Functor - -instance Monad Parser where - fail = Parser . const . Left - return a = Parser $ \input -> Right (a, input) - p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2) - -instance Applicative Parser where - pure = return - (<*>) = ap - --- | Convert a regular parser. -liftParser :: ([ByteString] -> Either String a) -> Parser a -liftParser p = Parser $ \input -> case break (== "list_OK") input of - (xs, ys) -> fmap (, drop 1 ys) (p xs) - --- | Return everything until the next "list_OK". -getResponse :: Parser [ByteString] -getResponse = Parser $ \input -> case break (== "list_OK") input of - (xs, ys) -> Right (xs, drop 1 ys) - --- | For commands returning an empty response. -emptyResponse :: Parser () -emptyResponse = do - r <- getResponse - unless (null r) $ - unexpected r - --- | Fail with unexpected response. -unexpected :: [ByteString] -> Parser a -unexpected = fail . ("unexpected Response: " ++) . show - --- | A compound command, comprising a parser for the responses and a --- combined request of an arbitrary number of commands. -data Command a = Command { - commandParser :: Parser a - , commandRequest :: [String] - } deriving Functor - -instance Applicative Command where - pure a = Command (pure a) [] - (Command p1 c1) <*> (Command p2 c2) = Command (p1 <*> p2) (c1 ++ c2) - --- | Execute a 'Command'. -runCommand :: MonadMPD m => Command a -> m a -runCommand (Command p c) = do - r <- Core.getResponse command - case runParser p r of - Left err -> throwError (Unexpected err) - Right (a, []) -> return a - Right (_, xs) -> throwError (Unexpected $ "superfluous input: " ++ show xs) - where - command = case c of - [x] -> x - xs -> unlines ("command_list_ok_begin" : xs) - ++ "command_list_end"