<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>Network/MPD/Core.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-}</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-comment'>-- | Module : Network.MPD.Core</span>
<a name="line-4"></a><span class='hs-comment'>-- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010</span>
<a name="line-5"></a><span class='hs-comment'>-- License : LGPL (see LICENSE)</span>
<a name="line-6"></a><span class='hs-comment'>-- Maintainer : Joachim Fasting <joachim.fasting@gmail.com></span>
<a name="line-7"></a><span class='hs-comment'>-- Stability : alpha</span>
<a name="line-8"></a><span class='hs-comment'>--</span>
<a name="line-9"></a><span class='hs-comment'>-- The core datatypes and operations are defined here, including the</span>
<a name="line-10"></a><span class='hs-comment'>-- primary instance of the 'MonadMPD' class, 'MPD'.</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Network</span><span class='hs-varop'>.</span><span class='hs-conid'>MPD</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span> <span class='hs-layout'>(</span>
<a name="line-13"></a> <span class='hs-comment'>-- * Classes</span>
<a name="line-14"></a> <span class='hs-conid'>MonadMPD</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-15"></a> <span class='hs-comment'>-- * Data types</span>
<a name="line-16"></a> <span class='hs-conid'>MPD</span><span class='hs-layout'>,</span> <span class='hs-conid'>MPDError</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>ACKType</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Response</span><span class='hs-layout'>,</span> <span class='hs-conid'>Host</span><span class='hs-layout'>,</span> <span class='hs-conid'>Port</span><span class='hs-layout'>,</span> <span class='hs-conid'>Password</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-comment'>-- * Running</span>
<a name="line-18"></a> <span class='hs-varid'>withMPDEx</span><span class='hs-layout'>,</span>
<a name="line-19"></a> <span class='hs-comment'>-- * Interacting</span>
<a name="line-20"></a> <span class='hs-varid'>getResponse</span><span class='hs-layout'>,</span> <span class='hs-varid'>kill</span><span class='hs-layout'>,</span>
<a name="line-21"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-22"></a>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Network</span><span class='hs-varop'>.</span><span class='hs-conid'>MPD</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span><span class='hs-varop'>.</span><span class='hs-conid'>Class</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Network</span><span class='hs-varop'>.</span><span class='hs-conid'>MPD</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span><span class='hs-varop'>.</span><span class='hs-conid'>Error</span>
<a name="line-25"></a>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span> <span class='hs-layout'>(</span><span class='hs-conid'>Applicative</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varop'><$></span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-layout'>(</span><span class='hs-varid'>ap</span><span class='hs-layout'>,</span> <span class='hs-varid'>unless</span><span class='hs-layout'>)</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Error</span> <span class='hs-layout'>(</span><span class='hs-conid'>ErrorT</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadError</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Reader</span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderT</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>ask</span><span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadIO</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>put</span><span class='hs-layout'>,</span> <span class='hs-varid'>get</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalStateT</span><span class='hs-layout'>)</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Foldable</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>F</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span> <span class='hs-layout'>(</span><span class='hs-varid'>isPrefixOf</span><span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Network</span> <span class='hs-layout'>(</span><span class='hs-conid'>PortID</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>withSocketsDo</span><span class='hs-layout'>,</span> <span class='hs-varid'>connectTo</span><span class='hs-layout'>)</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Handle</span><span class='hs-layout'>,</span> <span class='hs-varid'>hPutStrLn</span><span class='hs-layout'>,</span> <span class='hs-varid'>hReady</span><span class='hs-layout'>,</span> <span class='hs-varid'>hClose</span><span class='hs-layout'>,</span> <span class='hs-varid'>hFlush</span><span class='hs-layout'>)</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Error</span> <span class='hs-layout'>(</span><span class='hs-varid'>isEOFError</span><span class='hs-layout'>)</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>UTF8</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>U</span>
<a name="line-37"></a>
<a name="line-38"></a><span class='hs-comment'>--</span>
<a name="line-39"></a><span class='hs-comment'>-- Data types.</span>
<a name="line-40"></a><span class='hs-comment'>--</span>
<a name="line-41"></a>
<a name="line-42"></a><a name="Host"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Host</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>String</span>
<a name="line-43"></a><a name="Port"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Port</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Integer</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-comment'>--</span>
<a name="line-46"></a><span class='hs-comment'>-- IO based MPD client implementation.</span>
<a name="line-47"></a><span class='hs-comment'>--</span>
<a name="line-48"></a>
<a name="line-49"></a><a name="MPD"></a><span class='hs-comment'>-- | The main implementation of an MPD client. It actually connects</span>
<a name="line-50"></a><a name="MPD"></a><span class='hs-comment'>-- to a server and interacts with it.</span>
<a name="line-51"></a><a name="MPD"></a><span class='hs-comment'>--</span>
<a name="line-52"></a><a name="MPD"></a><span class='hs-comment'>-- To use the error throwing\/catching capabilities:</span>
<a name="line-53"></a><a name="MPD"></a><span class='hs-comment'>--</span>
<a name="line-54"></a><a name="MPD"></a><span class='hs-comment'>-- > import Control.Monad.Error (throwError, catchError)</span>
<a name="line-55"></a><a name="MPD"></a><span class='hs-comment'>--</span>
<a name="line-56"></a><a name="MPD"></a><span class='hs-comment'>-- To run IO actions within the MPD monad:</span>
<a name="line-57"></a><a name="MPD"></a><span class='hs-comment'>--</span>
<a name="line-58"></a><a name="MPD"></a><span class='hs-comment'>-- > import Control.Monad.Trans (liftIO)</span>
<a name="line-59"></a><a name="MPD"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>MPD</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span>
<a name="line-60"></a> <span class='hs-conid'>MPD</span> <span class='hs-layout'>{</span> <span class='hs-varid'>runMPD</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ErrorT</span> <span class='hs-conid'>MPDError</span>
<a name="line-61"></a> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Handle</span><span class='hs-layout'>)</span>
<a name="line-62"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Host</span><span class='hs-layout'>,</span> <span class='hs-conid'>Port</span><span class='hs-layout'>,</span> <span class='hs-conid'>Password</span><span class='hs-layout'>)</span> <span class='hs-conid'>IO</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span>
<a name="line-63"></a> <span class='hs-layout'>}</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monad</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadIO</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadError</span> <span class='hs-conid'>MPDError</span><span class='hs-layout'>)</span>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Applicative</span> <span class='hs-conid'>MPD</span> <span class='hs-keyword'>where</span>
<a name="line-66"></a> <span class='hs-layout'>(</span><span class='hs-varop'><*></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ap</span>
<a name="line-67"></a> <span class='hs-varid'>pure</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span>
<a name="line-68"></a>
<a name="line-69"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadMPD</span> <span class='hs-conid'>MPD</span> <span class='hs-keyword'>where</span>
<a name="line-70"></a> <span class='hs-varid'>open</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mpdOpen</span>
<a name="line-71"></a> <span class='hs-varid'>close</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mpdClose</span>
<a name="line-72"></a> <span class='hs-varid'>send</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mpdSend</span>
<a name="line-73"></a> <span class='hs-varid'>getPassword</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MPD</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ask</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>pw</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>pw</span>
<a name="line-74"></a>
<a name="line-75"></a><a name="Response"></a><span class='hs-comment'>-- | A response is either an 'MPDError' or some result.</span>
<a name="line-76"></a><a name="Response"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Response</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Either</span> <span class='hs-conid'>MPDError</span>
<a name="line-77"></a>
<a name="line-78"></a><a name="withMPDEx"></a><span class='hs-comment'>-- | The most configurable API for running an MPD action.</span>
<a name="line-79"></a><span class='hs-definition'>withMPDEx</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Host</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Port</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Password</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MPD</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Response</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-80"></a><span class='hs-definition'>withMPDEx</span> <span class='hs-varid'>host</span> <span class='hs-varid'>port</span> <span class='hs-varid'>pw</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withSocketsDo</span> <span class='hs-varop'>$</span>
<a name="line-81"></a> <span class='hs-varid'>runReaderT</span> <span class='hs-layout'>(</span><span class='hs-varid'>evalStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>runErrorT</span> <span class='hs-varop'>.</span> <span class='hs-varid'>runMPD</span> <span class='hs-varop'>$</span> <span class='hs-varid'>open</span> <span class='hs-varop'>>></span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-82"></a> <span class='hs-layout'>(</span><span class='hs-varid'>host</span><span class='hs-layout'>,</span> <span class='hs-varid'>port</span><span class='hs-layout'>,</span> <span class='hs-varid'>pw</span><span class='hs-layout'>)</span>
<a name="line-83"></a>
<a name="line-84"></a><a name="mpdOpen"></a><span class='hs-definition'>mpdOpen</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MPD</span> <span class='hs-conid'>()</span>
<a name="line-85"></a><span class='hs-definition'>mpdOpen</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MPD</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-86"></a> <span class='hs-layout'>(</span><span class='hs-varid'>host</span><span class='hs-layout'>,</span> <span class='hs-varid'>port</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ask</span>
<a name="line-87"></a> <span class='hs-varid'>runMPD</span> <span class='hs-varid'>close</span>
<a name="line-88"></a> <span class='hs-varid'>handle</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>liftIO</span> <span class='hs-layout'>(</span><span class='hs-varid'>safeConnectTo</span> <span class='hs-varid'>host</span> <span class='hs-varid'>port</span><span class='hs-layout'>)</span>
<a name="line-89"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>handle</span>
<a name="line-90"></a> <span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>forM_</span> <span class='hs-varid'>handle</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-varop'>$</span> <span class='hs-varid'>runMPD</span> <span class='hs-varid'>checkConn</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>flip</span> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>runMPD</span> <span class='hs-varid'>close</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-91"></a> <span class='hs-keyword'>where</span>
<a name="line-92"></a> <span class='hs-varid'>safeConnectTo</span> <span class='hs-varid'>host</span> <span class='hs-varid'>port</span> <span class='hs-keyglyph'>=</span>
<a name="line-93"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varop'><$></span> <span class='hs-varid'>connectTo</span> <span class='hs-varid'>host</span> <span class='hs-layout'>(</span><span class='hs-conid'>PortNumber</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fromInteger</span> <span class='hs-varid'>port</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-94"></a> <span class='hs-varop'>`catch`</span> <span class='hs-varid'>const</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-95"></a>
<a name="line-96"></a> <span class='hs-varid'>checkConn</span> <span class='hs-keyglyph'>=</span>
<a name="line-97"></a> <span class='hs-varid'>isPrefixOf</span> <span class='hs-str'>"OK MPD"</span> <span class='hs-varop'><$></span> <span class='hs-varid'>send</span> <span class='hs-str'>""</span>
<a name="line-98"></a>
<a name="line-99"></a><a name="mpdClose"></a><span class='hs-definition'>mpdClose</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MPD</span> <span class='hs-conid'>()</span>
<a name="line-100"></a><span class='hs-definition'>mpdClose</span> <span class='hs-keyglyph'>=</span>
<a name="line-101"></a> <span class='hs-conid'>MPD</span> <span class='hs-varop'>$</span> <span class='hs-varid'>get</span> <span class='hs-varop'>>>=</span> <span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>liftIO</span> <span class='hs-varop'>.</span> <span class='hs-varid'>sendClose</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span> <span class='hs-varid'>put</span> <span class='hs-conid'>Nothing</span>
<a name="line-102"></a> <span class='hs-keyword'>where</span>
<a name="line-103"></a> <span class='hs-varid'>sendClose</span> <span class='hs-varid'>handle</span> <span class='hs-keyglyph'>=</span>
<a name="line-104"></a> <span class='hs-layout'>(</span><span class='hs-varid'>hPutStrLn</span> <span class='hs-varid'>handle</span> <span class='hs-str'>"close"</span> <span class='hs-varop'>>></span> <span class='hs-varid'>hReady</span> <span class='hs-varid'>handle</span> <span class='hs-varop'>>></span> <span class='hs-varid'>hClose</span> <span class='hs-varid'>handle</span><span class='hs-layout'>)</span>
<a name="line-105"></a> <span class='hs-varop'>`catch`</span> <span class='hs-varid'>whenEOF</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-106"></a>
<a name="line-107"></a> <span class='hs-varid'>whenEOF</span> <span class='hs-varid'>result</span> <span class='hs-varid'>err</span>
<a name="line-108"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isEOFError</span> <span class='hs-varid'>err</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>result</span>
<a name="line-109"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ioError</span> <span class='hs-varid'>err</span>
<a name="line-110"></a>
<a name="line-111"></a><a name="mpdSend"></a><span class='hs-definition'>mpdSend</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MPD</span> <span class='hs-conid'>String</span>
<a name="line-112"></a><span class='hs-definition'>mpdSend</span> <span class='hs-varid'>str</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>send'</span> <span class='hs-varop'>`catchError`</span> <span class='hs-varid'>handler</span>
<a name="line-113"></a> <span class='hs-keyword'>where</span>
<a name="line-114"></a> <span class='hs-varid'>handler</span> <span class='hs-conid'>TimedOut</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mpdOpen</span> <span class='hs-varop'>>></span> <span class='hs-varid'>send'</span>
<a name="line-115"></a> <span class='hs-varid'>handler</span> <span class='hs-varid'>err</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwError</span> <span class='hs-varid'>err</span>
<a name="line-116"></a>
<a name="line-117"></a> <span class='hs-varid'>send'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MPD</span> <span class='hs-varop'>$</span> <span class='hs-varid'>get</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>throwError</span> <span class='hs-conid'>NoMPD</span><span class='hs-layout'>)</span> <span class='hs-varid'>go</span>
<a name="line-118"></a>
<a name="line-119"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>handle</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-120"></a> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-121"></a> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-conid'>U</span><span class='hs-varop'>.</span><span class='hs-varid'>hPutStrLn</span> <span class='hs-varid'>handle</span> <span class='hs-varid'>str</span> <span class='hs-varop'>>></span> <span class='hs-varid'>hFlush</span> <span class='hs-varid'>handle</span>
<a name="line-122"></a> <span class='hs-varid'>liftIO</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varop'><$></span> <span class='hs-varid'>getLines</span> <span class='hs-varid'>handle</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varop'>`catch`</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Left</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-123"></a> <span class='hs-varop'>>>=</span> <span class='hs-varid'>either</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>err</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isEOFError</span> <span class='hs-varid'>err</span> <span class='hs-keyword'>then</span>
<a name="line-124"></a> <span class='hs-varid'>put</span> <span class='hs-conid'>Nothing</span> <span class='hs-varop'>>></span> <span class='hs-varid'>throwError</span> <span class='hs-conid'>TimedOut</span>
<a name="line-125"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>liftIO</span> <span class='hs-layout'>(</span><span class='hs-varid'>ioError</span> <span class='hs-varid'>err</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-126"></a> <span class='hs-varid'>return</span>
<a name="line-127"></a>
<a name="line-128"></a> <span class='hs-varid'>getLines</span> <span class='hs-varid'>handle</span> <span class='hs-varid'>acc</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-129"></a> <span class='hs-varid'>l</span> <span class='hs-keyglyph'><-</span> <span class='hs-conid'>U</span><span class='hs-varop'>.</span><span class='hs-varid'>hGetLine</span> <span class='hs-varid'>handle</span>
<a name="line-130"></a> <span class='hs-keyword'>if</span> <span class='hs-str'>"OK"</span> <span class='hs-varop'>`isPrefixOf`</span> <span class='hs-varid'>l</span> <span class='hs-varop'>||</span> <span class='hs-str'>"ACK"</span> <span class='hs-varop'>`isPrefixOf`</span> <span class='hs-varid'>l</span>
<a name="line-131"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unlines</span> <span class='hs-varop'>$</span> <span class='hs-varid'>reverse</span> <span class='hs-layout'>(</span><span class='hs-varid'>l</span><span class='hs-conop'>:</span><span class='hs-varid'>acc</span><span class='hs-layout'>)</span>
<a name="line-132"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>getLines</span> <span class='hs-varid'>handle</span> <span class='hs-layout'>(</span><span class='hs-varid'>l</span><span class='hs-conop'>:</span><span class='hs-varid'>acc</span><span class='hs-layout'>)</span>
<a name="line-133"></a>
<a name="line-134"></a>
<a name="line-135"></a><span class='hs-comment'>--</span>
<a name="line-136"></a><span class='hs-comment'>-- Other operations.</span>
<a name="line-137"></a><span class='hs-comment'>--</span>
<a name="line-138"></a>
<a name="line-139"></a><a name="ignore"></a><span class='hs-definition'>ignore</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<a name="line-140"></a><span class='hs-definition'>ignore</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <span class='hs-varop'>>></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-141"></a>
<a name="line-142"></a><a name="kill"></a><span class='hs-comment'>-- | Kill the server. Obviously, the connection is then invalid.</span>
<a name="line-143"></a><span class='hs-definition'>kill</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadMPD</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<a name="line-144"></a><span class='hs-definition'>kill</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ignore</span> <span class='hs-layout'>(</span><span class='hs-varid'>send</span> <span class='hs-str'>"kill"</span><span class='hs-layout'>)</span> <span class='hs-varop'>`catchError`</span> <span class='hs-varid'>cleanup</span>
<a name="line-145"></a> <span class='hs-keyword'>where</span>
<a name="line-146"></a> <span class='hs-varid'>cleanup</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>e</span> <span class='hs-varop'>==</span> <span class='hs-conid'>TimedOut</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>close</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>throwError</span> <span class='hs-varid'>e</span>
<a name="line-147"></a>
<a name="line-148"></a><a name="getResponse"></a><span class='hs-comment'>-- | Send a command to the MPD server and return the result.</span>
<a name="line-149"></a><span class='hs-definition'>getResponse</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadMPD</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span>
<a name="line-150"></a><span class='hs-definition'>getResponse</span> <span class='hs-varid'>cmd</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>send</span> <span class='hs-varid'>cmd</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>parseResponse</span><span class='hs-layout'>)</span> <span class='hs-varop'>`catchError`</span> <span class='hs-varid'>sendpw</span>
<a name="line-151"></a> <span class='hs-keyword'>where</span>
<a name="line-152"></a> <span class='hs-varid'>sendpw</span> <span class='hs-varid'>e</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ACK</span> <span class='hs-conid'>Auth</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-153"></a> <span class='hs-varid'>pw</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getPassword</span>
<a name="line-154"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>pw</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>throwError</span> <span class='hs-varid'>e</span>
<a name="line-155"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>send</span> <span class='hs-layout'>(</span><span class='hs-str'>"password "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>pw</span><span class='hs-layout'>)</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>parseResponse</span>
<a name="line-156"></a> <span class='hs-varop'>>></span> <span class='hs-varid'>send</span> <span class='hs-varid'>cmd</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>parseResponse</span>
<a name="line-157"></a> <span class='hs-varid'>sendpw</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span>
<a name="line-158"></a> <span class='hs-varid'>throwError</span> <span class='hs-varid'>e</span>
<a name="line-159"></a>
<a name="line-160"></a><a name="parseResponse"></a><span class='hs-comment'>-- Consume response and return a Response.</span>
<a name="line-161"></a><span class='hs-definition'>parseResponse</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadError</span> <span class='hs-conid'>MPDError</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span>
<a name="line-162"></a><span class='hs-definition'>parseResponse</span> <span class='hs-varid'>s</span>
<a name="line-163"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwError</span> <span class='hs-varop'>$</span> <span class='hs-conid'>NoMPD</span>
<a name="line-164"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isPrefixOf</span> <span class='hs-str'>"ACK"</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwError</span> <span class='hs-varop'>$</span> <span class='hs-varid'>parseAck</span> <span class='hs-varid'>s</span>
<a name="line-165"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Prelude</span><span class='hs-varop'>.</span><span class='hs-varid'>takeWhile</span> <span class='hs-layout'>(</span><span class='hs-str'>"OK"</span> <span class='hs-varop'>/=</span><span class='hs-layout'>)</span> <span class='hs-varid'>xs</span>
<a name="line-166"></a> <span class='hs-keyword'>where</span>
<a name="line-167"></a> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lines</span> <span class='hs-varid'>s</span>
<a name="line-168"></a>
<a name="line-169"></a><a name="parseAck"></a><span class='hs-comment'>-- Turn MPD ACK into the corresponding 'MPDError'</span>
<a name="line-170"></a><span class='hs-definition'>parseAck</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MPDError</span>
<a name="line-171"></a><span class='hs-definition'>parseAck</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ACK</span> <span class='hs-varid'>ack</span> <span class='hs-varid'>msg</span>
<a name="line-172"></a> <span class='hs-keyword'>where</span>
<a name="line-173"></a> <span class='hs-varid'>ack</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>code</span> <span class='hs-keyword'>of</span>
<a name="line-174"></a> <span class='hs-num'>2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>InvalidArgument</span>
<a name="line-175"></a> <span class='hs-num'>3</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>InvalidPassword</span>
<a name="line-176"></a> <span class='hs-num'>4</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Auth</span>
<a name="line-177"></a> <span class='hs-num'>5</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UnknownCommand</span>
<a name="line-178"></a> <span class='hs-num'>50</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FileNotFound</span>
<a name="line-179"></a> <span class='hs-num'>51</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PlaylistMax</span>
<a name="line-180"></a> <span class='hs-num'>52</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>System</span>
<a name="line-181"></a> <span class='hs-num'>53</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PlaylistLoad</span>
<a name="line-182"></a> <span class='hs-num'>54</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Busy</span>
<a name="line-183"></a> <span class='hs-num'>55</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NotPlaying</span>
<a name="line-184"></a> <span class='hs-num'>56</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FileExists</span>
<a name="line-185"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UnknownACK</span>
<a name="line-186"></a> <span class='hs-layout'>(</span><span class='hs-varid'>code</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>msg</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitAck</span> <span class='hs-varid'>s</span>
<a name="line-187"></a>
<a name="line-188"></a><a name="splitAck"></a><span class='hs-comment'>-- Break an ACK into (error code, current command, message).</span>
<a name="line-189"></a><span class='hs-comment'>-- ACKs are of the form:</span>
<a name="line-190"></a><span class='hs-comment'>-- ACK [error@command_listNum] {current_command} message_text\n</span>
<a name="line-191"></a><span class='hs-definition'>splitAck</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>String</span><span class='hs-layout'>,</span> <span class='hs-conid'>String</span><span class='hs-layout'>)</span>
<a name="line-192"></a><span class='hs-definition'>splitAck</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>read</span> <span class='hs-varid'>code</span><span class='hs-layout'>,</span> <span class='hs-varid'>cmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>msg</span><span class='hs-layout'>)</span>
<a name="line-193"></a> <span class='hs-keyword'>where</span>
<a name="line-194"></a> <span class='hs-layout'>(</span><span class='hs-varid'>code</span><span class='hs-layout'>,</span> <span class='hs-varid'>notCode</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>between</span> <span class='hs-chr'>'['</span> <span class='hs-chr'>'@'</span> <span class='hs-varid'>s</span>
<a name="line-195"></a> <span class='hs-layout'>(</span><span class='hs-varid'>cmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>notCmd</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>between</span> <span class='hs-chr'>'{'</span> <span class='hs-chr'>'}'</span> <span class='hs-varid'>notCode</span>
<a name="line-196"></a> <span class='hs-varid'>msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>drop</span> <span class='hs-num'>1</span> <span class='hs-varop'>$</span> <span class='hs-varid'>dropWhile</span> <span class='hs-layout'>(</span><span class='hs-chr'>' '</span> <span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varid'>notCmd</span>
<a name="line-197"></a>
<a name="line-198"></a> <span class='hs-comment'>-- take whatever is between 'f' and 'g'.</span>
<a name="line-199"></a> <span class='hs-varid'>between</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>break</span> <span class='hs-layout'>(</span><span class='hs-varop'>==</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varid'>xs</span>
<a name="line-200"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>break</span> <span class='hs-layout'>(</span><span class='hs-varop'>==</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>drop</span> <span class='hs-num'>1</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span>
</pre></body>
</html>
distrib
>
Fedora
>
13
>
x86_64
>
media
>
updates
>
by-pkgid
>
02c18074d3336e49c76b205748ff9df8
>
files
>
48
