From 0f022ec64bede3ad94e5bb2e99cf1ea6ac9d74ef Mon Sep 17 00:00:00 2001
From: John Goerzen <jgoerzen@complete.org>
Date: Tue, 12 Aug 2008 08:24:39 -0500
Subject: [PATCH] Changed Connection to use StateT instead of State, with
 Either

This allows us to handle "fail" in a pure way.
---
 src/Network/IMAP/Connection.hs |  9 +++++----
 testsrc/TestConnection.hs      | 10 +++++-----
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/Network/IMAP/Connection.hs b/src/Network/IMAP/Connection.hs
index 2c06d20..ace53e8 100644
--- a/src/Network/IMAP/Connection.hs
+++ b/src/Network/IMAP/Connection.hs
@@ -19,10 +19,11 @@ 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, intercalate)
 
-type IMAPState = State (IMAPString, IMAPString)
+type IMAPState = StateT (IMAPString, IMAPString) (Either String)
 
 {- | Set up an IMAPConnection that runs in the State monad.
 
@@ -62,16 +63,16 @@ newStringConnection =
 runStringConnection ::
        IMAPString               -- ^ Buffer to send to clients
     -> (IMAPConnection IMAPState -> IMAPState a) -- ^ Function to run
-    -> (a, (String, String))    -- ^ Results: func result, buffer status
+    -> Either String (a, (String, String))    -- ^ Results: func result, buffer status
 runStringConnection sbuf func =
-    runState (func newStringConnection) (sbuf::String, []::String)
+    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
-    -> (a, (String, String))    -- ^ Results: func result, buffer status
+    -> Either String (a, (String, String))    -- ^ Results: func result, buffer status
 runLinesConnection sbuf func 
     | sbuf == [] = 
         -- For the empty input, no \r\n after.
diff --git a/testsrc/TestConnection.hs b/testsrc/TestConnection.hs
index a844411..681d45e 100644
--- a/testsrc/TestConnection.hs
+++ b/testsrc/TestConnection.hs
@@ -28,16 +28,16 @@ import Network.IMAP.Connection
 import Network.IMAP.Types
 
 prop_identity :: String -> Bool
-prop_identity f = runStringConnection f (\_ -> return ()) == ((), (f, []))
+prop_identity f = runStringConnection f (\_ -> return ()) == Right ((), (f, []))
 
 prop_linesidentity :: String -> Bool
 prop_linesidentity f =
-    runLinesConnection [f] (\_ -> return ()) == ((), (f ++ "\r\n", []))
+    runLinesConnection [f] (\_ -> return ()) == Right ((), (f ++ "\r\n", []))
 
 prop_lineslistidentity :: [String] -> Property
 prop_lineslistidentity f =
     and (map (notElem '\r') f)  ==> 
-        runLinesConnection f (\_ -> return ()) @?= ((), (expected, []))
+        runLinesConnection f (\_ -> return ()) @?= Right ((), (expected, []))
     where expected = expectedString f
 
 expectedString f =
@@ -49,13 +49,13 @@ prop_readLine :: [String] -> Property
 prop_readLine s =
     (not (null s)) && (and (map (notElem '\r') s)) ==> 
         runLinesConnection s readLine @?=
-            (head s, (expectedString (tail s), []))
+            Right (head s, (expectedString (tail s), []))
 
 prop_readBytes :: String -> Int -> Property
 prop_readBytes s l =
     l <= length s && l >= 0 ==> 
       runStringConnection s (\c -> readBytes c (fromIntegral l)) ==
-                         (take l s, (drop l s, []))
+                         Right (take l s, (drop l s, []))
 
 q :: Testable a => String -> a -> HU.Test
 q = qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 5000})
-- 
2.39.2