packages feed

smtps-gmail-1.0.0: src/Main.hs

---------------------------------------------------------------
-- Copyright (c) 2013, Enzo Haussecker. All rights reserved. --
---------------------------------------------------------------

{-# OPTIONS -Wall #-}

module Main where

import Control.Exception
import Network.SMTPS.Gmail
import System.IO

main :: IO ()
main = do
  putStr "Username: "
  hFlush stdout
  user <- withEcho True  getLine
  putStr "Password: "
  hFlush stdout
  pass <- withEcho False getLine
  putChar '\n'
  putStr "To: "
  hFlush stdout
  to   <- withEcho True  getLine >>= return . split
  putStr "CC: "
  hFlush stdout
  cc   <- withEcho True  getLine >>= return . split
  putStr "BCC: "
  hFlush stdout
  bcc  <- withEcho True  getLine >>= return . split
  putStr "Subject: "
  hFlush stdout  
  sub  <- withEcho True  getLine
  putStr "Body: "
  hFlush stdout  
  body <- withEcho True  getLine
  sendGmail stdout user pass to cc bcc sub body

withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
  old <- hGetEcho stdin
  bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action

split :: String -> [String]
split "" = []
split xs = a : split (drop 1 b)
  where (,) a b = break (==',') xs