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
21 -- Copyright : (c) Ben Sinclair 2005-2007
23 -- Maintainer : bsinclai@turing.une.edu.au
25 -- Portability : Haskell 98
27 -- Core functionality.
32 MPD
, ACK
(..), ACKType
(..),
34 -- * Running an action
41 getResponse
, clearerror
, close
, reconnect
, kill
,
43 module Control
.Monad
.Trans
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)
55 import System
.IO.Error
(isEOFError)
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"
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
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.
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
=
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
))
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 ()
166 readIORef hRef
>>= maybe (return ())
167 (\h
-> hPutStrLn h
"close" >> hClose h
)
168 writeIORef hRef Nothing
170 -- | Refresh a connection.
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.
180 kill
= MPD
$ \conn
-> do
181 readIORef
(connHandle conn
) >>=
182 maybe (return ()) (\h
-> hPutStrLn h
"kill" >> hClose h
)
183 writeIORef
(connHandle conn
) Nothing
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
197 _
-> return $ Left x
)
200 catch (liftM Right
$ hGetLine h
) (return . Left
) >>=
201 either (\e
-> if isEOFError e
then return (Left TimedOut
)
205 -- Send a password to MPD and run an action on success, return an ACK
207 tryPassword
:: Connection
208 -> MPD a
-- run on success
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
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
237 "2" -> InvalidArgument
238 "3" -> InvalidPassword
240 "5" -> UnknownCommand
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.
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.
269 close
= MPD
$ \conn
-> closeIO
(connHandle conn
) >> return (Right
())