[gitconv @ N.M.Commands.takeSongInfo: redundant parens]
[libmpd-haskell.git] / Prim.hs
blob6590d0daa56475f71e993ee3e79b2101f7faf14c
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 (
30 -- * Data types
31 MPD, ACK(..), ACKType(..), Response,
33 -- * Running an action
34 withMPDEx,
36 -- * Errors
37 throwMPD, catchMPD,
39 -- * Interacting
40 getResponse, clearerror, close, reconnect, kill,
41 ) where
43 import Control.Monad (liftM, unless)
44 import Control.Exception (finally)
45 import Control.Monad.Trans
46 import Prelude hiding (repeat)
47 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
48 import Data.List (isPrefixOf)
49 import Data.Maybe
50 import Network
51 import System.IO
52 import System.IO.Error (isEOFError)
55 -- Data types.
58 -- | A connection to an MPD server.
59 -- don't export the field names.
60 data Connection = Conn { connHostName :: String
61 , connPortNum :: Integer
62 , connHandle :: IORef (Maybe Handle)
63 , connGetPass :: IO (Maybe String)
66 -- | The ACK type is used to signal errors, both from the MPD and otherwise.
67 data ACK = NoMPD -- ^ MPD not responding
68 | TimedOut -- ^ The connection timed out
69 | Custom String -- ^ Used for misc. errors
70 | ACK ACKType String -- ^ ACK type and a message from the server.
72 instance Show ACK where
73 show NoMPD = "Could not connect to MPD"
74 show TimedOut = "MPD connection timed out"
75 show (Custom s) = s
76 show (ACK _ s) = s
78 -- | Represents various MPD errors (aka. ACKs).
79 data ACKType = InvalidArgument -- ^ Invalid argument passed (ACK 2)
80 | InvalidPassword -- ^ Invalid password supplied (ACK 3)
81 | Auth -- ^ Authentication required (ACK 4)
82 | UnknownCommand -- ^ Unknown command (ACK 5)
83 | FileNotFound -- ^ File or directory not found ACK 50)
84 | PlaylistMax -- ^ Playlist at maximum size (ACK 51)
85 | System -- ^ A system error (ACK 52)
86 | PlaylistLoad -- ^ Playlist loading failed (ACK 53)
87 | Busy -- ^ Update already running (ACK 54)
88 | NotPlaying -- ^ An operation requiring playback
89 -- got interrupted (ACK 55)
90 | FileExists -- ^ File already exists (ACK 56)
91 | UnknownACK -- ^ An unknown ACK (aka. bug)
93 -- | A response is either an ACK or some result.
94 type Response a = Either ACK a
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 (Response 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 (Response 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 -- XXX this doesn't use the password supplying feature.
188 -- | Clear the current error message in status.
189 clearerror :: MPD ()
190 clearerror = MPD $ \conn -> do
191 readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
192 (\h -> hPutStrLn h "clearerror" >> hFlush h >> return (Right ()))
194 -- | Close an MPD connection.
195 close :: MPD ()
196 close = MPD $ \conn -> closeIO (connHandle conn) >> return (Right ())
198 -- | Send a command to the MPD and return the result.
199 getResponse :: String -> MPD [String]
200 getResponse cmd = MPD $ \conn -> do
201 readIORef (connHandle conn) >>=
202 maybe (return $ Left NoMPD)
203 (\h -> hPutStrLn h cmd >> hFlush h >>
204 loop h (tryPassword conn (getResponse cmd)) [])
205 where loop h tryPw acc = do
206 getln h (\l -> parseResponse (loop h tryPw) l acc >>= either
207 (\x -> case x of
208 ACK Auth _ -> tryPw
209 _ -> return $ Left x)
210 (return . Right))
211 getln h cont =
212 catch (liftM Right $ hGetLine h) (return . Left) >>=
213 either (\e -> if isEOFError e then return (Left TimedOut)
214 else ioError e)
215 cont
217 -- Send a password to MPD and run an action on success, return an ACK
218 -- on failure.
219 tryPassword :: Connection
220 -> MPD a -- run on success
221 -> IO (Response a)
222 tryPassword conn cont = do
223 readIORef (connHandle conn) >>= maybe (return $ Left NoMPD)
224 (\h -> connGetPass conn >>= maybe (return . Left $
225 ACK Auth "Password required")
226 (\pw -> do hPutStrLn h ("password " ++ pw) >> hFlush h
227 result <- hGetLine h
228 case result of "OK" -> runMPD cont conn
229 _ -> tryPassword conn cont))
231 -- Break an ACK into (error code, current command, message).
232 -- ACKs are of the form:
233 -- ACK [error@command_listNum] {current_command} message_text\n
234 splitAck :: String -> (String, String, String)
235 splitAck s = (code, cmd, msg)
236 where (code, notCode) = between (== '[') (== '@') s
237 (cmd, notCmd) = between (== '{') (== '}') notCode
238 msg = drop 1 . snd $ break (== ' ') notCmd
240 -- take whatever is between 'f' and 'g'.
241 between f g xs = let (_, y) = break f xs
242 in break g (drop 1 y)
244 parseAck :: String -> ACK
245 parseAck s = ACK ack msg
247 where
248 ack = case code of
249 "2" -> InvalidArgument
250 "3" -> InvalidPassword
251 "4" -> Auth
252 "5" -> UnknownCommand
253 "50" -> FileNotFound
254 "51" -> PlaylistMax
255 "52" -> System
256 "53" -> PlaylistLoad
257 "54" -> Busy
258 "55" -> NotPlaying
259 "56" -> FileExists
260 _ -> UnknownACK
261 (code, _, msg) = splitAck s
263 -- Consume response and return a Response.
264 parseResponse :: ([String] -> IO (Response [String])) -> String -> [String]
265 -> IO (Response [String])
266 parseResponse f s acc
267 | isPrefixOf "ACK" s = return . Left $ parseAck s
268 | isPrefixOf "OK" s = return . Right $ reverse acc
269 | otherwise = f (s:acc)