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)
+
+type IMAPState = StateT (IMAPString, IMAPString) (Either String)
{- | Set up an IMAPConnection that runs in the State monad.
Remember that EOL in IMAP protocols is \r\n!
closeConnection is ignored with this monad. -}
-newStringConnection :: IMAPConnection (State (IMAPString, IMAPString))
+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 =
{- | Runs a State monad with a String connection. Returns
(retval, remainingBufferToClient, bufferFromClient) -}
-{-
-runStringConnection ::
- IMAPString ->
- ((State s a) -> a) ->
- (a, IMAPString, IMAPString)
--}
runStringConnection ::
IMAPString -- ^ Buffer to send to clients
- -> (IMAPConnection (State (IMAPString, IMAPString)) -> State (IMAPString, IMAPString) a) -- ^ Function to run
- -> (a, (String, String)) -- ^ Results: func result, buffer status
+ -> (IMAPConnection IMAPState -> IMAPState a) -- ^ Function to run
+ -> 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
+ -> 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