[gitconv @ README: remove 'Initialisation' part.]
[libmpd-haskell.git] / Prim.hs
blob3047b32afdbaab8aa3500e2edca6f6c25b4f8c07
1 {-
2 libmpd for Haskell, an MPD client library.
3 Copyright (C) 2005-2007 Ben Sinclair <bsinclai@turing.une.edu.au>
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.
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.
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
20 -- | Module : Prim
21 -- Copyright : (c) Ben Sinclair 2005-2007
22 -- License : LGPL
23 -- Maintainer : bsinclai@turing.une.edu.au
24 -- Stability : alpha
25 -- Portability : Haskell 98
27 -- Core functionality.
29 module Prim (
31 -- * Data types
32 MPD, ACK(..), ACKType(..),
34 -- * Running an action
35 withMPDEx,
37 -- * Errors
38 throwMPD, catchMPD,
40 -- * Interacting
41 getResponse, clearerror, close, reconnect, kill,
43 module Control.Monad.Trans
44 ) where
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)
58 -- Data types.
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)
69 -- | The ACK type is used to signal errors, both from the MPD and otherwise.
70 data ACK = NoMPD -- ^ MPD not responding
71 | TimedOut -- ^ The connection timed out
72 | Custom String -- ^ Used for misc. errors
73 | ACK ACKType String -- ^ ACK type and a message from the server.
75 instance Show ACK where
76 show NoMPD = "Could not connect to MPD"
77 show TimedOut = "MPD connection timed out"
78 show (Custom s) = s
79 show (ACK _ s) = s
81 -- | Represents various MPD errors (aka. ACKs).
82 data ACKType = InvalidArgument -- ^ Invalid argument passed (ACK 2)
83 | InvalidPassword -- ^ Invalid password supplied (ACK 3)
84 | Auth -- ^ Authentication required (ACK 4)
85 | UnknownCommand -- ^ Unknown command (ACK 5)
86 | FileNotFound -- ^ File or directory not found ACK 50)
87 | PlaylistMax -- ^ Playlist at maximum size (ACK 51)
88 | System -- ^ A system error (ACK 52)
89 | PlaylistLoad -- ^ Playlist loading failed (ACK 53)
90 | Busy -- ^ Update already running (ACK 54)
91 | NotPlaying -- ^ An operation requiring playback
92 -- got interrupted (ACK 55)
93 | FileExists -- ^ File already exists (ACK 56)
94 | UnknownACK -- ^ An unknown ACK (aka. bug)
96 -- Export the type name but not the constructor or the field.
98 -- This is basically a state and an error monad combined. It's just
99 -- nice if we can have a few custom functions that fiddle with the
100 -- internals.
101 newtype MPD a = MPD { runMPD :: Connection -> IO (Either ACK a) }
103 instance Functor MPD where
104 fmap f m = MPD $ \conn -> either Left (Right . f) `liftM` runMPD m conn
106 instance Monad MPD where
107 return a = MPD $ \_ -> return (Right a)
108 m >>= f = MPD $ \conn -> runMPD m conn >>=
109 either (return . Left) (flip runMPD conn . f)
110 fail err = MPD $ \_ -> return . Left $ Custom err
112 instance MonadIO MPD where
113 liftIO m = MPD $ \_ -> liftM Right m
115 -- | Throw an exception.
116 throwMPD :: ACK -> MPD ()
117 throwMPD e = MPD $ \_ -> return (Left e)
119 -- | Catch an exception from an action.
120 catchMPD :: MPD a -> (ACK -> MPD a) -> MPD a
121 catchMPD m h = MPD $ \conn ->
122 runMPD m conn >>= either (flip runMPD conn . h) (return . Right)
126 -- Basic connection functions
130 -- | Run an MPD action against a server.
131 withMPDEx :: String -- ^ Host name.
132 -> Integer -- ^ Port number.
133 -> IO (Maybe String) -- ^ An action that supplies passwords.
134 -> MPD a -- ^ The action to run.
135 -> IO (Either ACK a)
136 withMPDEx host port getpw m = do
137 hRef <- newIORef Nothing
138 connect host port hRef
139 readIORef hRef >>= maybe (return $ Left NoMPD)
140 (\_ -> finally (runMPD m (Conn host port hRef getpw)) (closeIO hRef))
142 -- Connect to an MPD server.
143 connect :: String -> Integer -- host and port
144 -> IORef (Maybe Handle) -> IO ()
145 connect host port hRef =
146 withSocketsDo $ do
147 closeIO hRef
148 --handle <- connectTo host . PortNumber $ fromInteger port
149 handle <- safeConnectTo host port
150 writeIORef hRef handle
151 maybe (return ()) (\h -> checkConn h >>= flip unless (closeIO hRef))
152 handle
154 safeConnectTo :: String -> Integer -> IO (Maybe Handle)
155 safeConnectTo host port =
156 catch (liftM Just $ connectTo host (PortNumber $ fromInteger port))
157 (const $ return Nothing)
159 -- Check that an MPD daemon is at the other end of a connection.
160 checkConn :: Handle -> IO Bool
161 checkConn h = isPrefixOf "OK MPD" `liftM` hGetLine h
163 -- Close a connection.
164 closeIO :: IORef (Maybe Handle) -> IO ()
165 closeIO hRef = do
166 readIORef hRef >>= maybe (return ())
167 (\h -> hPutStrLn h "close" >> hClose h)
168 writeIORef hRef Nothing
170 -- | Refresh a connection.
171 reconnect :: MPD ()
172 reconnect = MPD $ \(Conn host port hRef _) -> do
173 connect host port hRef
174 liftM (maybe (Left NoMPD) (const $ Right ())) (readIORef hRef)
176 -- XXX this doesn't use the password supplying feature.
178 -- | Kill the server. Obviously, the connection is then invalid.
179 kill :: MPD ()
180 kill = MPD $ \conn -> do
181 readIORef (connHandle conn) >>=
182 maybe (return ()) (\h -> hPutStrLn h "kill" >> hClose h)
183 writeIORef (connHandle conn) Nothing
184 return (Left NoMPD)
186 -- | Send a command to the MPD and return the result.
187 getResponse :: String -> MPD [String]
188 getResponse cmd = MPD $ \conn -> do
189 readIORef (connHandle conn) >>=
190 maybe (return $ Left NoMPD)
191 (\h -> hPutStrLn h cmd >> hFlush h >>
192 loop h (tryPassword conn (getResponse cmd)) [])
193 where loop h tryPw acc = do
194 getln h (\l -> parseResponse (loop h tryPw) l acc >>= either
195 (\x -> case x of
196 ACK Auth _ -> tryPw
197 _ -> return $ Left x)
198 (return . Right))
199 getln h cont =
200 catch (liftM Right $ hGetLine h) (return . Left) >>=
201 either (\e -> if isEOFError e then return (Left TimedOut)
202 else ioError e)
203 cont
205 -- Send a password to MPD and run an action on success, return an ACK
206 -- on failure.
207 tryPassword :: Connection
208 -> MPD a -- run on success
209 -> IO (Either ACK a)
210 tryPassword conn cont = do
211 readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
212 (\h -> connGetPass conn >>= maybe (return . Left $
213 ACK Auth "Password required")
214 (\pw -> do hPutStrLn h ("password " ++ pw) >> hFlush h
215 result <- hGetLine h
216 case result of "OK" -> runMPD cont conn
217 _ -> tryPassword conn cont))
219 -- Break an ACK into (error code, current command, message).
220 -- ACKs are of the form:
221 -- ACK [error@command_listNum] {current_command} message_text\n
222 splitAck :: String -> (String, String, String)
223 splitAck s = (code, cmd, msg)
224 where (code, notCode) = between (== '[') (== '@') s
225 (cmd, notCmd) = between (== '{') (== '}') notCode
226 msg = drop 1 . snd $ break (== ' ') notCmd
228 -- take whatever is between 'f' and 'g'.
229 between f g xs = let (_, y) = break f xs
230 in break g (drop 1 y)
232 parseAck :: String -> ACK
233 parseAck s = ACK ack msg
235 where
236 ack = case code of
237 "2" -> InvalidArgument
238 "3" -> InvalidPassword
239 "4" -> Auth
240 "5" -> UnknownCommand
241 "50" -> FileNotFound
242 "51" -> PlaylistMax
243 "52" -> System
244 "53" -> PlaylistLoad
245 "54" -> Busy
246 "55" -> NotPlaying
247 "56" -> FileExists
248 _ -> UnknownACK
249 (code, _, msg) = splitAck s
251 -- Consume response and return a Response.
252 parseResponse :: ([String] -> IO (Either ACK [String]))
253 -> String -> [String] -> IO (Either ACK [String])
254 parseResponse f s acc
255 | isPrefixOf "ACK" s = return . Left $ parseAck s
256 | isPrefixOf "OK" s = return . Right $ reverse acc
257 | otherwise = f (s:acc)
259 -- XXX this doesn't use the password supplying feature.
261 -- | Clear the current error message in status.
262 clearerror :: MPD ()
263 clearerror = MPD $ \conn -> do
264 readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
265 (\h -> hPutStrLn h "clearerror" >> hFlush h >> return (Right ()))
267 -- | Close an MPD connection.
268 close :: MPD ()
269 close = MPD $ \conn -> closeIO (connHandle conn) >> return (Right ())