HackMail 0.0 → 0.0.1

raw patch · 3 files changed

+191/−14 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HackMail.cabal +16/−14
• HackMail/Control/DaemonMode.hs +52/−0
• HackMail/Hackmain.hs +123/−0

@@ -1,5 +1,5 @@ Name:                   HackMail-Version:                0.0+Version:                0.0.1 Synopsis:               A Procmail Replacement as Haskell EDSL  Description:            A program for filtering/sorting email. Monadic EDSL for sorting, supports multiple mail storage formats.   Homepage:               http://patch-tag.com/publicrepos/Hackmail@@ -14,12 +14,12 @@  Library          Build-Depends:          base,-                                directory >= 1.0,-                                Crypto >= 4.2,-                                parsec >= 2.1,-                                mtl >= 1.1,-                                old-time >= 1.0,-                                hint >= 0.3+                                directory >=1.0,+                                Crypto >=4.2,+                                parsec >=2.1,+                                mtl >=1.1,+                                old-time >=1.0,+                                hint >=0.3         Exposed-Modules:        HackMail.Data.MainTypes,                                 HackMail.Data.Email,                                 HackMail.Data.ParseEmail,@@ -28,16 +28,18 @@                                 HackMail.Data.FilterConf                                 HackMail.Control.Misc                                 HackMail.Control.Checksum+                                HackMail.Control.DaemonMode+                                HackMail.Hackmain                                                                   Executable hackmail         Main-is:        Main.hs         Build-Depends:  base,-                        directory >= 1.0,-                        Crypto >= 4.2,-                        parsec >= 2.1,-                        mtl >= 1.1,-                        old-time >= 1.0,-                        hdaemonize >= 0.1,-                        hint >= 0.3+                        directory >=1.0,+                        Crypto >=4.2,+                        parsec >=2.1,+                        mtl >=1.1,+                        old-time >=1.0,+                        hdaemonize >=0.1,+                        hint >=0.3                         

@@ -0,0 +1,52 @@+module HackMail.Control.DaemonMode where ++import Control.Applicative+import Control.Concurrent+import Control.Monad++import Data.IORef+import Data.List hiding (sort)+import Data.Maybe (fromJust)++import System.Directory+import System.Time++import HackMail.Data.MainTypes+++-- Plan+-- start up polling directory from opts/config, if theres a modification, call the sorting (FilterMain)+-- routine on each new file. deleting them afterward, go back to polling.+runDaemon opts conf = do+        -- an IORef to store the last modification time+        modFlag <- getModificationTime (fromJust $ incomingMailLoc opts) >>= newIORef +        poll_and_sort modFlag opts conf+                ++poll_and_sort flag opts conf = do+        b <- poll flag (fromJust $ incomingMailLoc opts) +        if b then (do {threadDelay (30 * 10^6); poll_and_sort flag opts conf}) -- poll every thirty seconds (TODO: Make configurable)+             else sort opts conf+        -- update modification time+        current_modTime <- getModificationTime (fromJust $ incomingMailLoc opts)+        prevTime <- readIORef flag+        writeIORef flag current_modTime+        -- loop+        poll_and_sort flag opts conf++poll flag path = do+        modTime <- getModificationTime path+        flagTime <- readIORef flag+        return (flagTime == modTime)+                                                                                 +sort opts conf = do+        dirContents <- filter (isSuffixOf ".eml") <$> getDirectoryContents (fromJust $ incomingMailLoc opts)+        -- this is ugly and bad...+        dirContents' <- mapM parseEmailFromFile dirContents+        let dirC = map unpack dirContents'     +        mapM fMain dirC+        mapM_ removeFile dirContents+        where fMain x = (runFilter (filterMain conf) (conf, x))++unpack (Left err) = error $ "Couldn't Sort, parse error\n" ++ (show err)+unpack (Right em) = em

@@ -0,0 +1,123 @@+--------------------------------------------------------------------------------+--------------------------------------------------------------------------------+-- |+--Module       : Hackmain.hs+--Author       : Joe Fredette+--License      : BSD3+--Copyright    : Joe Fredette+--+--Maintainer   : Joe Fredette <jfredett.at.gmail.dot.com>+--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++++