-- -*- Mode: haskell; indent-tabs-mode: nil -*-
module Main(main) where

import Graphics.UI.WX as WX hiding (when, empty)
import Graphics.UI.WXCore hiding (when, empty)

import System.Directory

import Text.Estraier.EstDB
import Text.Estraier.EstCond
import Text.Estraier.EstDoc
import qualified QDBM.Curia as C

import Control.Concurrent
import Control.Monad
import Data.Maybe

import CreateMail
import ParseMail
import Receive
import Maildir
import Config

import SHA1

optimize status edb =
    do syncDB edb
       optimizeDB edb True True
       set status [ text := "done" ]
       return ()

viewmail e (_, ldb) idlist t w (ListItemSelected i) =
    do mid <- liftM (!!i) $ varGet idlist
       content <- liftM (maybe (SinglePart [] "") parseMail)
                    (C.lookupLarge ldb mid)
       set t [ text := [] ]
       C.lookupLarge ldb mid >>= return . fromMaybe "" >>= hexHash >>= print
       setText content
       textCtrlSetInsertionPoint t 0
    where
      setText (SinglePart hs s) =
          do mapM_ addHeader hs
             appendText t "\n"
             mapM_ addLine $ lines s
      setText (MultiPart hs s) =
          do mapM_ addHeader hs
             appendText t "---------------------------------------------\n"
             mapM_ setText s
      addHeader (f, s)
          | elem f ["subject", "from", "to", "date"] =
              do appendText t (f ++ ": ")
                 set t [ textColor := red ]
                 appendText t (s++"\n")
                 set t [ textColor := black ]
          | otherwise = return ()
      addLine l@('>':_) =
              do set t [ textColor := blue]
                 appendText t (l ++ "\n")
                 set t [ textColor := black]
      addLine l = appendText t (l ++ "\n")
viewmail e (edb, ldb) idlist t w (ListColClick n) =
    do cols <- get w columns
       when (n >= 0 && n < length cols)
            $ do let (key, _, _) = cols !! n
                 do searchMain (empty { ordering = order key } ) edb w idlist e
                    return ()
    where order "Date"    = NumDesc "@cdate"
          order "Subject" = DictAsc "@subject"
          order "From"    = DictAsc "@from"
viewmail e (edb, ldb) idlist t w _ = return ()

searchMain base edb lst idlist e =
    do txt <- get e text
       if null txt
         then return 0
         else let cond = (base `with` txt) { maxResult = Just 200
                                           , options = CondSimple :
                                                       options base }
              in do (ids, maps) <- dbSearch edb cond
                    itemsDelete lst
                    idlist' <- mapM itemsAppend ids
                    varSet idlist idlist'
                    return $ fromMaybe 0 $ lookup "" maps
    where itemsAppend docid =
              do subject <- getDocAttr edb docid "@title"
                 from <- getDocAttr edb docid "@author"
                 date <- getDocAttr edb docid "@cdate"
                 mid <- getDocAttr edb docid "@uri"
                 itemAppend lst [subject, from, date]
                 return mid

searchEvent edb lst idlist s e =
    searchMain empty edb lst idlist e >>= updateStatus
    where updateStatus 0 = set s [ text := "there are no results" ]
          updateStatus n =
              do set s [ text := "there are " ++ show n ++ " results" ]
                 when (n > 200) $ set s [ text :~ (++" but top 200 results are shown") ] 
          

hazakura db@(edb,ldb) config =
    do f <- frame [ text := "hazakura", clientSize := sz 640 480 ]
       p <- panel f []
       s <- splitterWindow p []
       b <- textCtrlRich s [ alignment := AlignLeft
                           , wrap := WrapWord
                           , enabled := False
                           ]
       idlist <- varCreate []
       lst <- listCtrl s [ columns := [("Subject", AlignLeft, 380)
                                      ,("From", AlignLeft, 150)
                                      ,("Date", AlignLeft, 90)
                                      ]
                         ]
       status <- statusField [ text := "no results for search" ]
       srch <- textEntry p [ alignment := AlignLeft
                           , enabled := True
                           , on enterKey ::= searchEvent edb lst idlist status
                           ]
       set lst [ on listEvent ::= viewmail srch db idlist b ]
       menuFile <- menuPane [ text := "&File" ]
       menuCreate <- menuItem menuFile [ text := "&Create mail"
                                       , on command := createMail f config ]
       menuReceive <- menuItem menuFile [ text := "&Receive"
                                        , on command := receiveMails f config db ]
       menuImport <- menuItem menuFile [ text := "&Import"
                                       , on command :=
                                                (do importMaildir f db []
                                                    optimize status edb)
                                       ]
       menuQuit <- menuQuit menuFile [ text := "&Quit"
                                     , on command := do C.close ldb
                                                        closeDB edb
                                                        WX.close f
                                     ]

       set f [ layout := container p $ margin 0 $
                      column 0 [ hfill $ widget srch
                               , fill $ hsplit s 3 120 (widget lst) (widget b)]
             , menuBar := [menuFile]
             , statusBar := [status]
             , clientSize := sz 640 480
             ]
       return ()

initializeDB =
    do homedir <- getHomeDirectory
       setCurrentDirectory homedir
       createDirectoryIfMissing False ".hazakura"
       setCurrentDirectory ".hazakura"
       estdb <- doesDirectoryExist "_fulltext" >>= openEst
       setCacheSize estdb (128*1024*1024)
       curia <- C.open "_docs" [C.CrReader, C.CrWriter, C.CrCreat]
       return (estdb, curia)
    where openEst True  = openDB "_fulltext" [EstReader, EstWriter]
          openEst False =
              do edb <- openDB "_fulltext" [ EstReader, EstWriter
                                           , EstCreat , EstPerfNGram]
                 addAttrIndex edb "@title" AttrStr
                 addAttrIndex edb "subject" AttrStr
                 addAttrIndex edb "@author" AttrStr
                 addAttrIndex edb "from" AttrStr
                 addAttrIndex edb "to" AttrStr
                 addAttrIndex edb "cc" AttrStr
                 addAttrIndex edb "@mailtag" AttrStr
                 addAttrIndex edb "@cdate" AttrNum
                 addAttrIndex edb "@mdate" AttrNum
                 return edb
          

main =
    do db <- initializeDB
       config <- loadConfig
       start $ hazakura db config