-- -*- Mode: haskell; indent-tabs-mode: nil -*-
module Maildir
    ( filterDir
    , maildirDo
    , importMaildir
    )
    where

import SingleMail

import System.Directory
import System.IO

import Control.Exception
import Control.Monad

import Graphics.UI.WX hiding (when)
import Graphics.UI.WXCore hiding (when)

import Prelude hiding (catch)

import Utils

guard True _    = return ()
guardIO False msg = fail msg

filterDir = filter (\file -> file /= "." && file /= "..")

dialogStyle = 0x1   -- can_abort
            + 0x4   -- auto_hide
            + 0x40  -- remaining_time

maildirDo w db tags mdir subdir isRecur =
    importFiles >> when isRecur doRecursive
    where dir = mdir+/subdir
          importFiles =
              do files <- liftM filterDir $ getDirectoryContents dir
                 dialog <- progressDialogCreate ("importing " ++ mdir) ""
                             (length files) w dialogStyle
                 zipWithM_ (importSingleFile dialog (length files)) files [1..]
                 progressDialogUpdate dialog (length files)
          importSingleFile dialog max fpath v =
              doesFileExist (dir+/fpath) >>= \able ->
              when able $ do content' <- readFile (dir+/fpath)
                             content <- return $ tail $
                                        dropWhile (/='\n') content'
                             addSingleMail content tags db
                             canceled <- progressDialogUpdateWithMessage
                                         dialog v fpath
                             when (canceled == 0) $
                                  do progressDialogUpdate dialog max
                                     close dialog
                                     fail "canceled"
          doRecursive =
              do dirs <- liftM filterDir $ getDirectoryContents mdir
                 mapM_ (\d -> doesDirectoryExist (mdir+/d) >>= \exists ->
                        when (exists && head d == '.') $
                                 (maildirDo w db (tail d : tags)
                                                (mdir+/d) subdir isRecur))
                       (filterDir dirs)


importMaildir w db tags =
    do homedir <- getHomeDirectory
       maildirDo w db tags (homedir+/"Maildir") "cur" True `catch` (\_ -> return ())