-------------------------------------------------------------------------------- -------------------------------------------------------------------------------- -- | --Module : Hackmain.hs --Author : Joe Fredette --License : BSD3 --Copyright : Joe Fredette -- --Maintainer : Joe Fredette --Stability : Unstable --Portability : not portable -- -------------------------------------------------------------------------------- --Description : The main module, manages configs and etc. -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- -- This (Undecideable) is smelly, I do not like it, there must be -- a better soltuion {-# LANGUAGE UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-} 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 -- get arguments, parse them opts <- getOpts <$> getArgs -- determine if config folder & FilterMain.hs/lhs exist; build config configFolderPath <- configFolderPathIO b_dir <- doesDirectoryExist configFolderPath conf' <- (if' b_dir buildConf noConfFolderError) -- delegate... -- if in pipe mode, get the email, else start the daemon 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 -- TODO -- eventually make this "serviced" -- w/ error logging 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 -- determine extension type and ensure existence of FilterMain.*hs b_isHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".hs" b_isLHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".lhs" let filterMainL = (filterMainPath configFolderPath) ++ (getExt b_isHS b_isLHS $ (".hs",".lhs")) -- open and extract all necessary functions/data from FilterMain, all this takes place in -- the interpreter monad. (inboxL, fMain) <- runUnsafeInterpreter . getFilterMainStuff $ filterMainL return (Conf inboxL filterMainL fMain) where filterMainPath c = (c ++ "FilterMain") -- Returns a pair, a path to the inbox location (where new emails enter the system) and also -- a Filter, the filter delivers (it's a Reader + IO monad) the email based on the config+options. 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