Skip to content

Instantly share code, notes, and snippets.

@ppetr
Created July 29, 2013 12:14
Show Gist options
  • Save ppetr/6103920 to your computer and use it in GitHub Desktop.
Save ppetr/6103920 to your computer and use it in GitHub Desktop.
Patched HakelNet's IMAP with network-conduit.
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment