Patched HakelNet's IMAP with network-conduit.

gistfile1.hs

import Prelude as P
import Control.Exception
import Control.Monad
import Control.Monad.Trans (MonadIO(..))
import Data.ByteString.Char8 as BS
import Data.Conduit
import Data.Conduit.Binary as B
import Data.Functor
import Data.Conduit.Network
import Data.Monoid
import Network.HaskellNet.IMAP
import Network.HaskellNet.BSStream

{-
main = do
    bracket (connectIMAPPort "imap.centrum.cz" 143) logout $ \c -> do
        capability c >>= print
-}

main = runTCPClient (clientSettings 143 (BS.pack "imap.centrum.cz")) capabilities

capabilities :: Application IO
capabilities ad = appSource ad $= f $$ appSink ad
  where
    f :: Conduit BS.ByteString IO ByteString
    f = do
            c <- connectStream conduitBSStream
            noop c
            capability c >>= liftIO . print
            noop c
            capability c >>= liftIO . print
            noop c
            logout c

type BSPipe m = ConduitM ByteString ByteString m

conduitBSStream :: (Monad m) => BSStreamM (BSPipe m)
conduitBSStream = BSStream
    (liftM (maybe BS.empty id) line)
    (liftM (maybe BS.empty id) . readN)
    yield
    (return ()) -- flush - unimplemented
    (return ()) -- close - unimplemented
    isOpen

isOpen :: (Monad m) => ConduitM i o m Bool
isOpen = await >>= maybe (return False) ((True <$) . leftover)

-- | Folds a given function on inputs. Repeat while the function returns @Left@
-- and accumulate its results in a list. When the function returns @Right@,
-- concatenate the accumulated result (including the last one) and return it,
-- storing what's left using @leftover@. Returns @Nothing@ if no input is
-- available.
chunk :: (Monad m, Monoid a) => (s -> i -> Either (a, s) (a, i)) -> s -> ConduitM i o m (Maybe a)
chunk f = loop []
  where
    loop xs s = await >>= maybe (emit xs) (go xs s)

    go xs s i = case f s i of
        Left (x, s')    -> loop (x : xs) s'
        Right (x, l)    -> leftover l >> emit (x : xs)

    emit [] = return Nothing
    emit xs = return (Just . mconcat . P.reverse $ xs)

readN :: (Monad m) => Int -> ConduitM ByteString o m (Maybe ByteString)
readN = chunk f
  where
    f n bs | n' > 0     = Left (bs, n')
           | otherwise  = Right $ BS.splitAt n bs
      where n' = n - BS.length bs

line :: (Monad m) => ConduitM ByteString o m (Maybe ByteString)
line = chunk f ()
  where
    f _ bs = maybe (Left (bs, ())) (\i -> Right $ BS.splitAt (i + 1) bs) (BS.findIndex (== '\n') bs)

lines :: (Monad m) => Conduit ByteString m ByteString
lines = loop
  where loop = line >>= maybe (return ()) (\i -> yield i >> loop)