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.
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.
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 =
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})