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