blob: b00977018b6f1f9d070dd6b364ada95d3bb6ffb2 (
plain)
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
|
module Cache (newInMemory, start, CacheM, getInbox) where
import Control.Concurrent.STM
( TVar
, atomically
, newTVarIO
, readTVar
, readTVarIO
, writeTVar
)
import Intro
import qualified Mail as M
import qualified Queue as Q
data Cache = Cache
{ count :: Int
, inbox :: [M.Mail]
}
type CacheM = TVar Cache
newInMemory :: IO CacheM
newInMemory = newTVarIO newCache
start :: Q.QueueM M.Mail -> CacheM -> IO ()
start queue cache = go
where
go :: IO ()
go = do
mail <- Q.pull queue
updateCache cache (`addMail` mail)
go
getInbox :: CacheM -> IO [M.Mail]
getInbox c = inbox <$> readTVarIO c
newCache :: Cache
newCache = Cache 0 []
addMail :: Cache -> M.Mail -> Cache
addMail cache mail = cache{count = count cache + 1, inbox = mail : inbox cache}
updateCache :: CacheM -> (Cache -> Cache) -> IO ()
updateCache c f = atomically $ do
cache <- readTVar c
writeTVar c (f cache)
|
