module HackMail.Hackmain where
import System.Environment
import System.Directory
import System.Exit
import System.IO
import Control.Arrow
import Control.Monad
import Control.Monad.Reader
import Control.Applicative
import Data.Typeable
import Data.Maybe
import Data.List
import Language.Haskell.Interpreter
import System.Posix.Daemonize
import HackMail.Data.MainTypes
import HackMail.Control.DaemonMode
import HackMail.Control.Misc
configFolderPathIO :: IO FilePath
configFolderPathIO = do
home <- (getEnv "HOME")
return $ home ++ "/.hackmail/"
debugBool = True
debug s = if debugBool then putStrLn s else return ()
main = do
opts <- getOpts <$> getArgs
configFolderPath <- configFolderPathIO
b_dir <- doesDirectoryExist configFolderPath
conf' <- (if' b_dir buildConf noConfFolderError)
if (daemonMode opts) then daemon_mode opts conf'
else pipe_mode opts conf'
daemon_mode, pipe_mode :: Options -> Config -> IO ()
daemon_mode opts conf = daemonize $ runDaemon opts conf
pipe_mode opts conf = do
error "Pipe mode not implemented yet."
content <- getContents
content <- if (".eml" `isSuffixOf` content) then readFile content else return content
let email = unpack . parseEmail $ content
runFilter (filterMain conf) (conf, email)
where unpack (Left err) = error $ "Parse Error:\n " ++ show err
unpack (Right em) = em
buildConf :: IO Config
buildConf = do
configFolderPath <- configFolderPathIO
b_isHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".hs"
b_isLHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".lhs"
let filterMainL = (filterMainPath configFolderPath) ++ (getExt b_isHS b_isLHS $ (".hs",".lhs"))
(inboxL, fMain) <- runUnsafeInterpreter . getFilterMainStuff $ filterMainL
return (Conf inboxL filterMainL fMain)
where filterMainPath c = (c ++ "FilterMain")
getFilterMainStuff :: FilePath -> Interpreter (Path, Filter ())
getFilterMainStuff fMainLoc = do
loadModules [fMainLoc]; setTopLevelModules ["FilterMain"]
inboxL <- parse <$> interpret "(inbox)" infer
fMain <- (interpret "(mainFilter)" infer)
return (inboxL, fMain)
getExt :: Bool -> Bool -> ((a,a) -> a)
getExt True True = error $ "Both FilterMain.hs and FilterMain.lhs exist, don't know which one to"
++ "use, exiting."
getExt False False = error $ "FilterMain.hs and FilterMain.lhs do not exist, exiting."
getExt True False = fst
getExt False True = snd
noConfFolderError = do
putStrLn "~/.hackmail/ does not exist, creating and exiting."
configFolderPathIO >>= createDirectory
exitFailure
runUnsafeInterpreter :: Interpreter a -> IO a
runUnsafeInterpreter s = do
res <- runInterpreter s
case res of
Left r -> error (show r)
Right r -> return r