acid-state 0.12.3 → 0.12.4

raw patch · 11 files changed

+57/−33 lines, 11 filesdep ~basedep ~criterionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, criterion

API changes (from Hackage documentation)

Files

• acid-state.cabal +2/−2
• examples/HelloDatabase.hs +0/−1
• examples/HelloWorldNoTH.hs +1/−1
• examples/Proxy.hs +7/−7
• examples/RemoteClient.hs +4/−4
• examples/StressTest.hs +4/−4
• examples/StressTestNoTH.hs +4/−4
• examples/errors/Exceptions.hs +17/−3
• src/Data/Acid/Core.hs +7/−3
• src/Data/Acid/Local.hs +7/−4
• src/Data/Acid/TemplateHaskell.hs +4/−0

@@ -1,5 +1,5 @@ Name:                acid-state-Version:             0.12.3+Version:             0.12.4 Synopsis:            Add ACID guarantees to any serializable Haskell data structure. Description:         Use regular Haskell data structures as your database and get stronger ACID guarantees than most RDBMS offer. Homepage:            http://acid-state.seize.it/@@ -74,7 +74,7 @@     directory,     system-fileio == 0.3.*,     system-filepath,-    criterion == 0.8.*,+    criterion >= 0.8 && < 1.1,     mtl,     base,     acid-state

@@ -6,7 +6,6 @@  import           Data.Acid -import           Control.Applicative  ((<$>)) import           Control.Monad.Reader (ask) import           Control.Monad.State  (get, put) import           Data.SafeCopy

@@ -46,7 +46,7 @@              then do string <- query acid QueryState                      putStrLn $ "The state is: " ++ string              else do update acid (WriteState (unwords args))-                     putStrLn $ "The state has been modified!"+                     putStrLn "The state has been modified!"   ------------------------------------------------------

@@ -74,10 +74,10 @@             ["checkpoint", socket]               -> do acid <- openRemote socket                     createCheckpoint acid-            _ -> do putStrLn $ "Commands:"-                    putStrLn $ "  server socket      Start a new server instance."-                    putStrLn $ "  proxy from to      Pipe events between 'from' and 'to'."-                    putStrLn $ "  query socket       Prints out the current state."-                    putStrLn $ "  poke socket        Spawn 100k transactions."-                    putStrLn $ "  clear socket       Reset the state and write a checkpoint."-                    putStrLn $ "  checkpoint socket  Create a new checkpoint."+            _ -> do putStrLn "Commands:"+                    putStrLn "  server socket      Start a new server instance."+                    putStrLn "  proxy from to      Pipe events between 'from' and 'to'."+                    putStrLn "  query socket       Prints out the current state."+                    putStrLn "  poke socket        Spawn 100k transactions."+                    putStrLn "  clear socket       Reset the state and write a checkpoint."+                    putStrLn "  checkpoint socket  Create a new checkpoint."

@@ -36,7 +36,7 @@               -> do acid <- open                     update acid ClearState                     createCheckpoint acid-            _ -> do putStrLn $ "Commands:"-                    putStrLn $ "  query            Prints out the current state."-                    putStrLn $ "  poke             Spawn 100k transactions."-                    putStrLn $ "  checkpoint       Create a new checkpoint."+            _ -> do putStrLn "Commands:"+                    putStrLn "  query            Prints out the current state."+                    putStrLn "  poke             Spawn 100k transactions."+                    putStrLn "  checkpoint       Create a new checkpoint."

@@ -59,7 +59,7 @@             ["clear"]               -> do update acid ClearState                     createCheckpoint acid-            _ -> do putStrLn $ "Commands:"-                    putStrLn $ "  query            Prints out the current state."-                    putStrLn $ "  poke             Spawn 100k transactions."-                    putStrLn $ "  checkpoint       Create a new checkpoint."+            _ -> do putStrLn "Commands:"+                    putStrLn "  query            Prints out the current state."+                    putStrLn "  poke             Spawn 100k transactions."+                    putStrLn "  checkpoint       Create a new checkpoint."

@@ -53,10 +53,10 @@                     hFlush stdout                     groupUpdates acid (replicate 100000 PokeState)                     putStrLn "Done"-            _ -> do putStrLn $ "Commands:"-                    putStrLn $ "  query            Prints out the current state."-                    putStrLn $ "  poke             Spawn 100k transactions."-                    putStrLn $ "  checkpoint       Create a new checkpoint."+            _ -> do putStrLn "Commands:"+                    putStrLn "  query            Prints out the current state."+                    putStrLn "  poke             Spawn 100k transactions."+                    putStrLn "  checkpoint       Create a new checkpoint."  ------------------------------------------------------ -- The gritty details. These things may be done with

@@ -19,7 +19,7 @@ ------------------------------------------------------ -- The Haskell structure that we want to encapsulate -newtype MyState = MyState Integer+data MyState = MyState Integer     deriving (Show, Typeable)  $(deriveSafeCopy 0 'base ''MyState)@@ -36,12 +36,24 @@ stateError :: Update MyState () stateError = put (error "state error!") +stateNestedError1 :: Update MyState ()+stateNestedError1 = put (MyState (error "nested state error (1)"))++stateNestedError2 :: Integer -> Update MyState ()+stateNestedError2 n = put (MyState n)+ tick :: Update MyState Integer tick = do MyState n <- get           put $ MyState (n+1)           return n -$(makeAcidic ''MyState ['failEvent, 'errorEvent, 'stateError, 'tick])+$(makeAcidic ''MyState [ 'failEvent+                       , 'errorEvent+                       , 'stateError+                       , 'stateNestedError1+                       , 'stateNestedError2+                       , 'tick+                       ])  ------------------------------------------------------ -- This is how AcidState is used:@@ -54,7 +66,9 @@             ["2"] -> update acid FailEvent             ["3"] -> update acid ErrorEvent             ["4"] -> update acid StateError-            _     -> do putStrLn "Call with '1', '2', '3' or '4' to test error scenarios."+            ["5"] -> update acid StateNestedError1+            ["6"] -> update acid (StateNestedError2 (error "nested state error (2)"))+            _     -> do putStrLn "Call with [123456] to test error scenarios."                         putStrLn "If the tick doesn't get stuck, everything is fine."                         n <- update acid Tick                         putStrLn $ "Tick: " ++ show n

@@ -59,9 +59,13 @@ -- of base. We could do something better, but happstack-state is -- end-of-life anyway. showQualifiedTypeRep :: TypeRep -> String-showQualifiedTypeRep tr =-    let (TypeRep _f con _rep) = tr-    in tyConModule con ++ "." ++ show tr+showQualifiedTypeRep tr = tyConModule con ++ "." ++ show tr+  where con = extractTypeRepCon tr+#if MIN_VERSION_base(4,8,0)+        extractTypeRepCon (TypeRep _ c _ _) = c+#else+        extractTypeRepCon (TypeRep _ c _) = c+#endif  #else 

@@ -26,12 +26,12 @@ import Data.Acid.Abstract  import Control.Concurrent             ( newEmptyMVar, putMVar, takeMVar, MVar )-import Control.Exception              ( onException )+import Control.Exception              ( onException, evaluate ) import Control.Monad.State            ( runState ) import Control.Monad                  ( join ) import Control.Applicative            ( (<$>), (<*>) ) import Data.ByteString.Lazy           ( ByteString )---import qualified Data.ByteString.Lazy as Lazy ( length )+import qualified Data.ByteString.Lazy as Lazy ( length )   import Data.Serialize                 ( runPutLazy, runGetLazy )@@ -80,8 +80,11 @@ scheduleLocalUpdate acidState event     = do mvar <- newEmptyMVar          let encoded = runPutLazy (safePut event)-         --evaluate (Lazy.length encoded) -- It would be best to encode the event before we lock the core-                                          -- but it hurts performance /-:++         -- It is important that we encode the event now so that we can catch+         -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs)+         evaluate (Lazy.length encoded)+          modifyCoreState_ (localCore acidState) $ \st ->            do let !(result, !st') = runState hotMethod st               -- Schedule the log entry. Very important that it happens when 'localCore' is locked

@@ -141,8 +141,12 @@     where       -- | rename the type variables in a Pred       unify :: [(Name, Name)] -> Pred -> Pred+#if MIN_VERSION_template_haskell(2,10,0)+      unify table p = rename p table p -- in 2.10.0: type Pred = Type+#else       unify table p@(ClassP n tys) = ClassP n (map (rename p table) tys)       unify table p@(EqualP a b)   = EqualP (rename p table a) (rename p table b)+#endif        -- | rename the type variables in a Type       rename :: Pred -> [(Name, Name)] -> Type -> Type