blob: 6137f0bdcbfe5efb4d3ff1fae3c2b62cd1df4fdd (
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
47
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Regfish.AcidState where
import Control.Exception (bracket)
import Control.Lens
import Control.Monad.Reader
import Data.Acid
import Data.Typeable
import Regfish.Types
import Network.HTTP.Client (CookieJar)
-- TODO Regfish.Types.CookieJar ?
withLocalState :: (IsAcidic q, Typeable q) =>
q -> (AcidState q -> IO a) -> IO a
withLocalState initialState a =
bracket (liftIO $ openLocalState initialState)
--(liftIO . createCheckpointAndClose)
(liftIO . closeAcidState)
(\q -> createArchive q >> a q)
cookieJarQuery :: Query RFState CookieJar
cookieJarQuery =
asks _cookieJar
cookieJarUpdate :: CookieJar -> Update RFState ()
cookieJarUpdate =
(cookieJar .=)
dumpQuery :: Query RFState RFState
dumpQuery =
ask
makeAcidic ''RFState
[ 'cookieJarQuery
, 'cookieJarUpdate
, 'dumpQuery
]
|
