{-# LANGUAGE ScopedTypeVariables #-}

module HSH.Helpers.Email where
import HSH
import HSH.Helpers.Utils
import Text.StringTemplate.Helpers
import System.IO.Error

newtype PureInput = PureInput { unpureinput :: String }
  deriving (Read,Show)


{- |
  Send an email via mailx.

  For sysadmin steps required for this command to work with most of the work outsourced to gmail, see last three posts in thread

  http://groups.google.com/group/HAppS/browse_thread/thread/93317d4d7317040f/14cd89d98f1f4041

  This assumes a unixy environment, 
-}
--mailxEmail :: String -> String -> String -> IO (Either String ())
mailxEmail emailBody subject "" = return . Left $ "no email recipient"
mailxEmail emailBody subject recipient = do
  etR <- try $ run $ echo emailBody -|- mailxCommand
  case etR of
    Left e -> return $ Left $ show e
    Right okmsg -> return $ Right okmsg
  where mailxCommand = render1 [("subject",subject),("recipient",recipient)]
                               "mailx -s \"$subject$\" $recipient$"


t = do
  etR <- mailxEmail "meh" "mah" "moo@gmail.com"
  case etR of
    Left e -> fail $ "error, e: " ++ e
    Right () -> return "cool"