Prim.hs

   1 {-
   2     libmpd for Haskell, an MPD client library.
   3     Copyright (C) 2005  Ben Sinclair <bsinclai@turing.une.edu.au>
   4
   5     This library is free software; you can redistribute it and/or
   6     modify it under the terms of the GNU Lesser General Public
   7     License as published by the Free Software Foundation; either
   8     version 2.1 of the License, or (at your option) any later version.
   9
  10     This library is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13     Lesser General Public License for more details.
  14
  15     You should have received a copy of the GNU Lesser General Public
  16     License along with this library; if not, write to the Free Software
  17     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18 -}
  19
  20 -- | Module    : Prim
  21 -- Copyright   : (c) Ben Sinclair 2005
  22 -- License     : LGPL
  23 -- Maintainer  : bsinclai@turing.une.edu.au
  24 -- Stability   : alpha
  25 -- Portability : Haskell 98
  26 --
  27 -- MPD client library.
  28
  29 module Prim (
  30
  31              -- * Data types
  32              MPD, ACK(..),
  33
  34              -- * Running an action
  35              withMPDEx,
  36
  37              -- * Errors
  38              throwMPD, catchMPD,
  39
  40              -- * Interacting
  41              getResponse, clearerror, close, reconnect, kill,
  42
  43              module Control.Monad.Trans
  44             ) where
  45
  46 import Control.Monad (liftM, unless)
  47 import Control.Exception (finally)
  48 import Control.Monad.Trans
  49 import Prelude hiding (repeat)
  50 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
  51 import Data.List (isPrefixOf)
  52 import Data.Maybe
  53 import Network
  54 import System.IO
  55 import System.IO.Error (isEOFError)
  56
  57 --
  58 -- Data types.
  59 --
  60
  61 -- | A connection to an MPD server.
  62 -- don't export the field names.
  63 data Connection = Conn { connHostName :: String
  64                        , connPortNum  :: Integer
  65                        , connHandle   :: IORef (Maybe Handle)
  66                        , connGetPass  :: IO (Maybe String)
  67                        }
  68
  69 -- | Represents various MPD errors (aka. ACKs).
  70 data ACK = NoMPD                  -- ^ MPD not responding
  71          | TimedOut               -- ^ The connection timed out.
  72          | Auth                   -- ^ Authentication required (ACK [4\@0])
  73          | Busy                   -- ^ Update already running (ACK [54\@0])
  74          | UnknownCommand String  -- ^ Unknown command (ACK [5\@0])
  75          | FileNotFound           -- ^ File or directory not found (ACK [50\@0])
  76          | FileExists String      -- ^ File already exists (ACK [56\@0])
  77          | System String          -- ^ A system error (ACK [52\@0])
  78          | PlaylistLoad           -- ^ Playlist loading failed (ACK [53\@0])
  79          | NotPlaying             -- ^ An operation requiring playback
  80                                   --   got interrupted (ACK [55\@0])
  81          | PlaylistMax            -- ^ Playlist at maximum size (ACK [51\@0])
  82          | InvalidArgument String -- ^ Invalid argument passed (ACK [2\@0])
  83          | InvalidPassword        -- ^ Invalid password supplied (ACK [3\@0])
  84          | Custom String
  85
  86 instance Show ACK where
  87     show NoMPD               = "Could not connect to MPD"
  88     show TimedOut            = "MPD connection timed out"
  89     show Auth                = "Password needed"
  90     show Busy                = "Already updating"
  91     show (UnknownCommand s)  = s
  92     show FileNotFound        = "File or directory does not exist"
  93     show (FileExists s)      = s
  94     show (System s)          = "System error: " ++ s
  95     show PlaylistLoad        = "Failed to load playlist"
  96     show PlaylistMax         = "Playlist full"
  97     show (InvalidArgument s) = "Invalid argument: " ++ s
  98     show InvalidPassword     = "Invalid password"
  99     show NotPlaying          = "Playback stopped"
 100     show (Custom s)          = s
 101
 102 -- Export the type name but not the constructor or the field.
 103 --
 104 -- This is basically a state and an error monad combined. It's just
 105 -- nice if we can have a few custom functions that fiddle with the
 106 -- internals.
 107 newtype MPD a = MPD { runMPD :: Connection -> IO (Either ACK a) }
 108
 109 instance Functor MPD where
 110     fmap f m = MPD $ \conn -> either Left (Right . f) `liftM` runMPD m conn
 111
 112 instance Monad MPD where
 113     return a = MPD $ \_ -> return (Right a)
 114     m >>= f  = MPD $ \conn -> runMPD m conn >>=
 115                               either (return . Left) (flip runMPD conn . f)
 116     fail err = MPD $ \_ -> return $ Left (Custom err)
 117
 118 instance MonadIO MPD where
 119     liftIO m = MPD $ \_ -> liftM Right m
 120
 121 -- | Throw an exception.
 122 throwMPD :: ACK -> MPD ()
 123 throwMPD e = MPD $ \_ -> return (Left e)
 124
 125 -- | Catch an exception from an action.
 126 catchMPD :: MPD a -> (ACK -> MPD a) -> MPD a
 127 catchMPD m h = MPD $ \conn ->
 128     runMPD m conn >>= either (flip runMPD conn . h) (return . Right)
 129
 130 {-
 131 --
 132 -- Basic connection functions
 133 --
 134 -}
 135
 136 -- | Run an MPD action against a server.
 137 withMPDEx :: String            -- ^ Host name.
 138           -> Integer           -- ^ Port number.
 139           -> IO (Maybe String) -- ^ An action that supplies passwords.
 140           -> MPD a             -- ^ The action to run.
 141           -> IO (Either ACK a)
 142 withMPDEx host port getpw m = do
 143     hRef <- newIORef Nothing
 144     connect host port hRef
 145     readIORef hRef >>= maybe (return $ Left NoMPD)
 146         (\_ -> finally (runMPD m (Conn host port hRef getpw)) (closeIO hRef))
 147
 148 -- Connect to an MPD server.
 149 connect :: String -> Integer -- host and port
 150         -> IORef (Maybe Handle) -> IO ()
 151 connect host port hRef =
 152     withSocketsDo $ do
 153         closeIO hRef
 154         handle <- connectTo host . PortNumber $ fromInteger port
 155         writeIORef hRef (Just handle)
 156         checkConn handle >>= flip unless (closeIO hRef)
 157
 158 -- Check that an MPD daemon is at the other end of a connection.
 159 checkConn :: Handle -> IO Bool
 160 checkConn h = isPrefixOf "OK MPD" `liftM` hGetLine h
 161
 162 -- Close a connection.
 163 closeIO :: IORef (Maybe Handle) -> IO ()
 164 closeIO hRef = do
 165     readIORef hRef >>= maybe (return ())
 166                              (\h -> hPutStrLn h "close" >> hClose h)
 167     writeIORef hRef Nothing
 168
 169 -- | Refresh a connection.
 170 reconnect :: MPD ()
 171 reconnect = MPD $ \(Conn host port hRef _) -> do
 172     connect host port hRef
 173     liftM (maybe (Left NoMPD) (const $ Right ())) (readIORef hRef)
 174
 175 -- XXX this doesn't use the password supplying feature.
 176 --
 177 -- | Kill the server. Obviously, the connection is then invalid.
 178 kill :: MPD ()
 179 kill = MPD $ \conn -> do
 180     readIORef (connHandle conn) >>=
 181         maybe (return ()) (\h -> hPutStrLn h "kill" >> hClose h)
 182     writeIORef (connHandle conn) Nothing
 183     return (Left NoMPD)
 184
 185 -- | Send a command to the MPD and return the result.
 186 getResponse :: String -> MPD [String]
 187 getResponse cmd = MPD $ \conn -> do
 188     readIORef (connHandle conn) >>=
 189         maybe (return $ Left NoMPD)
 190               (\h -> hPutStrLn h cmd >> hFlush h >>
 191                      loop h (tryPassword conn (getResponse cmd)) [])
 192     where loop h tryPw acc = do
 193               getln h (\l -> parseResponse (loop h tryPw) l acc >>= either
 194                           (\x -> case x of Auth -> tryPw; _ -> return (Left x))
 195                           (return . Right))
 196           getln h cont =
 197               catch (liftM Right $ hGetLine h) (return . Left) >>=
 198                   either (\e -> if isEOFError e then return (Left TimedOut)
 199                                                 else ioError e)
 200                          cont
 201
 202 -- Send a password to MPD and run an action on success, return an ACK
 203 -- on failure.
 204 tryPassword :: Connection
 205             -> MPD a  -- run on success
 206             -> IO (Either ACK a)
 207 tryPassword conn cont = do
 208     readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
 209         (\h -> connGetPass conn >>= maybe (return $ Left Auth)
 210                    (\pw -> do hPutStrLn h ("password " ++ pw) >> hFlush h
 211                               result <- hGetLine h
 212                               case result of "OK" -> runMPD cont conn
 213                                              _    -> tryPassword conn cont))
 214
 215 splitAck :: String -> (String, String, String)
 216 splitAck s = (take 3 prefix, code, drop 2 msg)
 217   where
 218     (_, msg)       = break (== '}') msg'
 219     (code, msg')   = break (== ' ') rest
 220     (prefix, rest) = splitAt 4 s
 221
 222 -- > parseAck "ACK [5@0] {} unknown command \"pong\"" = Custom "unknown
 223 -- command \"pong\""
 224 parseAck :: String -> ACK
 225 parseAck s = case code of
 226                   "[4@0]"  -> Auth
 227                   "[54@0]" -> Busy
 228                   "[2@0]"  -> InvalidArgument msg
 229                   "[3@0]"  -> InvalidPassword
 230                   "[51@0]" -> PlaylistMax
 231                   "[52@0]" -> System msg
 232                   "[53@0]" -> PlaylistLoad
 233                   "[55@0]" -> NotPlaying
 234                   "[5@0]"  -> UnknownCommand msg
 235                   "[50@0]" -> FileNotFound
 236                   "[56@0]" -> FileExists msg
 237                   _        -> Custom msg
 238     where (_, code, msg) = splitAck s
 239
 240 -- Consume response and return a Response.
 241 parseResponse :: ([String] -> IO (Either ACK [String]))
 242               -> String -> [String] -> IO (Either ACK [String])
 243 parseResponse f s acc
 244     | isPrefixOf "ACK" s = return $ Left (parseAck s)
 245     | isPrefixOf "OK" s  = return $ Right (reverse acc)
 246     | otherwise          = f (s:acc)
 247
 248 -- XXX this doesn't use the password supplying feature.
 249 --
 250 -- | Clear the current error message in status.
 251 clearerror :: MPD ()
 252 clearerror = MPD $ \conn -> do
 253     readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
 254         (\h -> hPutStrLn h "clearerror" >> hFlush h >> return (Right ()))
 255
 256 -- | Close an MPD connection.
 257 close :: MPD ()
 258 close = MPD $ \conn -> closeIO (connHandle conn) >> return (Right ())