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
+    ]