]> code.delx.au - offlineimap/blobdiff - src/Network/IMAP/Connection.hs
Test for failure in readLine and readBytes
[offlineimap] / src / Network / IMAP / Connection.hs
index 2172c50ca519a091ee5dec53e380bffe0d9def8b..998f0b550bf4af80a40bcd6f6f747d1d4f084129 100644 (file)
@@ -19,38 +19,66 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 module Network.IMAP.Connection where
 import Network.IMAP.Types
 import Control.Monad.State
+import Control.Monad.Error
 import Data.List.Utils(spanList)
-import Data.List(genericSplitAt, genericLength)
+import Data.List(genericSplitAt, genericLength, intercalate)
 
--- | Take an IMAPString and treat it as messages from the server.
--- | Remember that EOL in IMAP protocols is \r\n!
+type IMAPState = StateT (IMAPString, IMAPString) (Either String)
 
-stringConnection :: 
-    IMAPString ->               -- ^ The initial content of the buffer for the client to read from
-    IMAPString ->               -- ^ The initial content of the buffer for the client to write to
-    IMAPConnection (State (IMAPString, IMAPString))
-stringConnection sdata wdata =
+{- | Set up an IMAPConnection that runs in the State monad.
+
+The state is (bufferToClient, bufferFromClient)
+
+Remember that EOL in IMAP protocols is \r\n!
+
+closeConnection is ignored with this monad. -}
+newStringConnection :: IMAPConnection IMAPState
+newStringConnection =
     IMAPConnection {readBytes = lreadBytes,
                     readLine = lreadLine,
                     writeBytes = lwriteBytes,
                     closeConn = return ()}
     where 
-          lreadBytes count = 
-              do (s,sw) <- get
-                 if genericLength s < count
-                    then fail "EOF in input in readBytes"
-                    else do let (r, s') = genericSplitAt count s
-                            put (s', sw)
-                            return r
+          lreadBytes count
+              | count < 0 = fail "readBytes: negative count"
+              | otherwise =
+                  do (s,sw) <- get
+                     if genericLength s < count
+                       then fail "EOF in input in readBytes"
+                       else do let (r, s') = genericSplitAt count s
+                               put (s', sw)
+                               return r
           lreadLine =
               do (s, sw) <- get
                  let (line, remainder) = spanList (\x -> "\r\n" /= take 2 x) s
                  case remainder of
                    [] -> fail "EOF in input in readLine"
-                   r -> do put (drop 2 r, sw) -- strip of \r\n
+                   r -> do put (drop 2 r, sw) -- strip off \r\n
                            return line
 
           lwriteBytes outdata =
               do (s, sw) <- get
                  put (s, sw ++ outdata)
 
+{- | Runs a State monad with a String connection.  Returns
+(retval, remainingBufferToClient, bufferFromClient) -}
+runStringConnection ::
+       IMAPString               -- ^ Buffer to send to clients
+    -> (IMAPConnection IMAPState -> IMAPState a) -- ^ Function to run
+    -> Either String (a, (String, String))    -- ^ Results: func result, buffer status
+runStringConnection sbuf func =
+    runStateT (func newStringConnection) (sbuf::String, []::String)
+
+{- | Runs a State monad with a String connection, initializing it with 
+the passed lines.  -}
+runLinesConnection ::
+       [IMAPString]             -- ^ Buffer to send to clients
+    -> (IMAPConnection IMAPState -> IMAPState a) -- ^ Function to run
+    -> Either String (a, (String, String))    -- ^ Results: func result, buffer status
+runLinesConnection sbuf func 
+    | sbuf == [] = 
+        -- For the empty input, no \r\n after.
+        runStringConnection [] func
+    | otherwise = 
+        -- Put \r\n between the lines, and also after the last one.
+        runStringConnection (intercalate "\r\n" sbuf ++ "\r\n") func
\ No newline at end of file