1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
{- Event handlers for Lazymail
-
- Copyright 2013 Raúl Benencia <rul@kalgan.cc>
-
- Licensed under the GNU GPL version 3 or higher
-}
module Handlers where
import Codec.MIME.Parse(parseMIMEMessage)
import Codec.MIME.Type(MIMEValue(..))
import Control.Exception(evaluate)
import Control.Monad.State
import Data.List(intercalate, stripPrefix, sort)
import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
import System.IO(openFile, IOMode(..), hClose)
import System.Locale(rfc822DateFormat)
import Data.DateTime(parseDateTime, startOfTime, formatDateTime)
import qualified System.IO.UTF8 as UTF8
import Email(lookupField, getBody, formatBody)
import Maildir
import Print
import State
import Types
previousMode :: Mode -> LazymailCurses ()
previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
previousMode EmailMode = do
st <- get
if (triggerUpdateIn . indexState $ st)
then do
changeMode MaildirMode
solveIndexUpdate
else put $ st { mode = IndexMode }
previousMode IndexMode = do
st <- get
let ist = (indexState st) { selectedRowIn = 0, scrollRowIn = 0 }
put $ st { mode = MaildirMode, indexState = ist }
changeMode :: Mode -> LazymailCurses ()
changeMode EmailMode = return ()
changeMode IndexMode = do
st <- get
let fp = selectedEmailPath . indexState $ st
nfp <- if (isNew fp)
then liftIO $ markAsRead fp
else return fp
when (fp /= nfp) triggerIndexUpdate
st <- get
msg <- liftIO $ UTF8.readFile nfp
let email = parseMIMEMessage msg
let body = getBody $ email
let el = formatBody body $ screenColumns st
let est = (emailState st) { currentEmail = email, emailLines = el, scrollRowEm = 0 }
put $ st { mode = EmailMode, emailState = est }
changeMode MaildirMode = do
st <- get
unsortedEmails <- liftIO $ do
freeOldHandlers st
let md = (selectedMD . maildirState) $ st
emails <- getMaildirEmails md
mapM toEmail emails
let selectedEmails' = reverse $ sort unsortedEmails
let scrollRow = scrollRowIn . indexState $ st
let scrRows = screenRows st
let indexState' = (indexState st) {
selectedEmails = selectedEmails'
, currentInLen = length selectedEmails'
, scrollBufferIn = formatIndexModeRows st $ scrollCrop scrollRow scrRows selectedEmails'
}
put $ st { mode = IndexMode, indexState = indexState' }
where
toEmail fp = do
handle <- openFile fp ReadMode
msg <- UTF8.hGetContents handle
let value = parseMIMEMessage msg
let headers = mime_val_headers value
let date = maybe startOfTime id $ parseDateTime rfc822DateFormat $ takeWhile (/= '(') $ lookupField "date" headers
return (Email value date fp handle)
freeOldHandlers st = mapM (hClose . emailHandle) $ selectedEmails . indexState $ st
{- Boilerplate code -}
incSelectedRow IndexMode = do
st <- get
let inSt = indexState st
let selRow = selectedRowIn inSt
let topScrollRow = scrollRowIn inSt
let startScrolling = (div (screenRows st) 4) * 3
let totalRows = currentInLen inSt
if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
then do -- Scroll emails
let scrollRowIn' = scrollRowIn inSt + 1
let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
put st { indexState = inSt' }
else -- Move the selected row
put $ incrementSelectedRow st
incSelectedRow MaildirMode = do
st <- get
let mdSt = maildirState st
let selRow = selectedRowMD mdSt
let topScrollRow = scrollRowMD mdSt
let startScrolling = (div (screenRows st) 4) * 3
let totalRows = length $ detectedMDs mdSt
if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
then do -- Scroll emails
let scrollRowMD' = topScrollRow + 1
let scrollBufferMD' = scrollCrop scrollRowMD' (screenRows st) $ detectedMDs mdSt
let mdSt' = mdSt { scrollRowMD = scrollRowMD', scrollBufferMD = scrollBufferMD' }
put st { maildirState = mdSt' }
else -- Move the selected row
put $ incrementSelectedRow st
{- Down-scrolling in Email mode -}
incSelectedRow EmailMode = do
st <- get
let est = emailState st
let cur = scrollRowEm est
let scrRows = screenRows st
let totalRows = length $ emailLines est
let est' = est { scrollRowEm = (cur + 1) }
when ((totalRows - scrRows + (bodyStartRow est) - 1) > (scrollRowEm est)) $
put $ st { emailState = est' }
incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
{- More boilerplate code -}
decSelectedRow IndexMode = do
st <- get
let inSt = indexState st
let selRow = selectedRowIn inSt
let startScrolling = (div (screenRows st) 4)
let topScrollRow = scrollRowIn inSt
if topScrollRow > 0 && selRow < startScrolling
then do
let scrollRowIn' = scrollRowIn inSt - 1
let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
put st { indexState = inSt' }
else
put $ decrementSelectedRow st
decSelectedRow MaildirMode = do
st <- get
let mdSt = maildirState st
let selRow = selectedRowMD mdSt
let startScrolling = (div (screenRows st) 4)
let topScrollRow = scrollRowMD mdSt
if topScrollRow > 0 && selRow < startScrolling
then do
let scrollRowMD' = scrollRowMD mdSt - 1
let scrollBufferMD' = scrollCrop scrollRowMD' (screenRows st) $ detectedMDs mdSt
let mdSt' = mdSt { scrollRowMD = scrollRowMD', scrollBufferMD = scrollBufferMD' }
put st { maildirState = mdSt' }
else
put $ decrementSelectedRow st
decSelectedRow EmailMode = do
st <- get
let est = emailState st
let cur = scrollRowEm est
let scrRows = screenRows st
let totalRows = length $ emailLines est
let est' = est { scrollRowEm = (cur - 1) }
when (cur > 0) $
put $ st { emailState = est' }
decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
{- Given a list, it returns the elements that will be in the next screen refresh
- TODO: find a better name -}
scrollCrop top rows xs = take rows $ drop top xs
formatIndexModeRows :: LazymailState -> [Email] -> [(FilePath, String)]
formatIndexModeRows st = map formatRow where
formatRow e =
let fp = emailPath e
email = emailValue e
hs = mime_val_headers email
str = normalizeLen (screenColumns st) $ intercalate ppSep $
[ "[" ++ normalizeLen maxFlags (ppFlags . getFlags $ fp) ++ "]"
, formatDateTime "%b %d" $ emailDate e
, normalizeLen fromLen $ ppField $ lookupField "from" hs
, ppField $ lookupField "subject" hs
]
in (fp, str)
formatMaildirModeRows st = mapM formatRow where
formatRow fp = return $ (fp, (concat $ replicate (numPads - 1) pad) ++ name) where
bp = basePath st
str = case (stripPrefix bp fp) of
Nothing -> fp
Just s -> s
name' = takeFileName . dropTrailingPathSeparator $ str
name = takeFileName $ map (\x -> if x `elem` imapSep then '/' else x) name'
pad = " "
numPads = (length $ filter (== '/') str) + (length $ filter (`elem` imapSep) str)
imapSep = ['.'] -- IMAP usually separates its directories with dots
triggerIndexUpdate :: LazymailCurses ()
triggerIndexUpdate = do
st <- get
let ist = indexState st
put $ st { indexState = (ist { triggerUpdateIn = True }) }
solveIndexUpdate :: LazymailCurses ()
solveIndexUpdate = do
st <- get
let ist = indexState st
put $ st { indexState = (ist { triggerUpdateIn = False }) }
triggerMaildirUpdate :: LazymailCurses ()
triggerMaildirUpdate = do
st <- get
let mst = maildirState st
put $ st { maildirState = (mst { triggerUpdateMD = True }) }
solveMaildirUpdate :: LazymailCurses ()
solveMaildirUpdate = do
st <- get
let mst = maildirState st
put $ st { maildirState = (mst { triggerUpdateMD = False }) }
|
