diff options
author | tv <tv@shackspace.de> | 2014-11-18 16:05:40 +0100 |
---|---|---|
committer | tv <tv@shackspace.de> | 2014-11-18 16:05:40 +0100 |
commit | 179d8980e55578e3553bad0b237368d74e074f15 (patch) | |
tree | cee326bc5071a71866ede0487beb28d510ea989a /Regfish/AcidState.hs |
initial commit
Diffstat (limited to 'Regfish/AcidState.hs')
-rw-r--r-- | Regfish/AcidState.hs | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/Regfish/AcidState.hs b/Regfish/AcidState.hs new file mode 100644 index 0000000..6137f0b --- /dev/null +++ b/Regfish/AcidState.hs @@ -0,0 +1,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 + ] |