enhan: benchmarks, debug via flag: -f-debug to disable
authorMax Voit <max.voit+gtdv@with-eyes.net>
Fri, 24 Jul 2015 12:56:15 +0000 (14:56 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Fri, 24 Jul 2015 12:56:15 +0000 (14:56 +0200)
acid-state-dist.cabal
benchmark/IntCommon.hs [new file with mode: 0644]
benchmark/Local.hs [new file with mode: 0644]
benchmark/MasterOnly.hs [new file with mode: 0644]
benchmark/MasterSlave.hs [new file with mode: 0644]
makefile

index 32044cf..edc1ed4 100644 (file)
@@ -45,6 +45,11 @@ build-type:          Simple
 -- Constraint on the version of Cabal needed to build this package.
 cabal-version:       >=1.10
 
+-- Flag for controlling debug output
+flag debug
+  description:       enable debug output
+  default:           True
+
 
 library
   -- Modules exported by the library.
@@ -80,10 +85,13 @@ library
   -- Base language which the package is written in.
   default-language:    Haskell2010
 
-  extensions:       CPP
+  default-extensions:       CPP
   ghc-options:      -Wall -threaded
   -- Switch on debugging by "-Unodebug", off by "-Dnodebug"
-  cpp-options:      -Unodebug
+  if flag(debug)
+    cpp-options:      -Unodebug
+  else
+    cpp-options:      -Dnodebug
 
 
 ----------------------------------------------------------------------
@@ -123,3 +131,32 @@ test-suite OrderingRandom
   default-language: Haskell2010
   build-depends:    base, directory, mtl, random,
                     safecopy, acid-state, acid-state-dist
+
+----------------------------------------------------------------------
+-- Benchmarks
+benchmark Local
+  main-is:          Local.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   benchmark
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl, criterion,
+                    safecopy, acid-state
+
+benchmark MasterOnly
+  main-is:          MasterOnly.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   benchmark
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl, criterion,
+                    safecopy, acid-state, acid-state-dist
+
+benchmark MasterSlave
+  main-is:          MasterSlave.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   benchmark
+  ghc-options:      -Wall -threaded
+  default-language: Haskell2010
+  build-depends:    base, directory, mtl, criterion,
+                    safecopy, acid-state, acid-state-dist
diff --git a/benchmark/IntCommon.hs b/benchmark/IntCommon.hs
new file mode 100644 (file)
index 0000000..928e0f2
--- /dev/null
@@ -0,0 +1,35 @@
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}
+
+module IntCommon where
+
+import Data.Acid
+import Data.SafeCopy
+import Data.Typeable
+
+import Control.Monad.Reader (ask)
+import Control.Monad.State (put, get)
+
+
+-- encapsulate some integers
+
+data IntState = IntState Int
+    deriving (Show, Typeable)
+
+$(deriveSafeCopy 0 'base ''IntState)
+
+-- transactions
+
+setState :: Int -> Update IntState ()
+setState value = put (IntState value)
+
+getState :: Query IntState Int
+getState = do
+    IntState val <- ask
+    return val
+
+incrementState :: Update IntState ()
+incrementState = do
+    IntState val <- get
+    put (IntState (val + 1))
+
+$(makeAcidic ''IntState ['setState, 'getState, 'incrementState])
diff --git a/benchmark/Local.hs b/benchmark/Local.hs
new file mode 100644 (file)
index 0000000..4c14efd
--- /dev/null
@@ -0,0 +1,38 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Criterion
+import Criterion.Main
+
+import Data.Acid
+
+import Control.Monad (when, replicateM_)
+import System.Exit (exitSuccess)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+
+-- state structures
+import IntCommon
+
+-- helpers
+cleanup :: FilePath -> IO ()
+cleanup path = do
+    sp <- doesDirectoryExist path
+    when sp $ removeDirectoryRecursive path
+
+-- benchmark
+masterBench :: AcidState IntState -> IO ()
+masterBench acid = replicateM_ 100 $ update acid IncrementState
+
+main :: IO ()
+main = do
+    -- init acid
+    cleanup "state/Local"
+    acid <- openLocalStateFrom "state/Local/m" (IntState 0)
+
+    -- run benchmark
+    defaultMain
+        [ bench "Local" $ nfIO (masterBench acid)
+        ]
+
+    -- cleanup
+    closeAcidState acid
+    exitSuccess
diff --git a/benchmark/MasterOnly.hs b/benchmark/MasterOnly.hs
new file mode 100644 (file)
index 0000000..0c10104
--- /dev/null
@@ -0,0 +1,44 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Criterion
+import Criterion.Main
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, replicateM_)
+import Control.Concurrent (threadDelay)
+import System.Exit (exitSuccess)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+
+-- state structures
+import IntCommon
+
+-- helpers
+delaySec :: Int -> IO ()
+delaySec n = threadDelay $ n*1000*1000
+
+cleanup :: FilePath -> IO ()
+cleanup path = do
+    sp <- doesDirectoryExist path
+    when sp $ removeDirectoryRecursive path
+
+-- benchmark
+masterBench :: AcidState IntState -> IO ()
+masterBench acid = replicateM_ 100 $ update acid IncrementState
+
+main :: IO ()
+main = do
+    -- init acid
+    cleanup "state/MasterOnly"
+    acid <- openMasterStateFrom "state/MasterOnly/m" "127.0.0.1" 3333 (IntState 0)
+    delaySec 2
+
+    -- run benchmark
+    defaultMain
+        [ bench "MasterOnly" $ nfIO (masterBench acid)
+        ]
+
+    -- cleanup
+    closeAcidState acid
+    exitSuccess
diff --git a/benchmark/MasterSlave.hs b/benchmark/MasterSlave.hs
new file mode 100644 (file)
index 0000000..c7526a3
--- /dev/null
@@ -0,0 +1,54 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Criterion
+import Criterion.Main
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (void, when, replicateM_)
+import Control.Concurrent (threadDelay, forkIO)
+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
+import System.Exit (exitSuccess)
+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+
+-- state structures
+import IntCommon
+
+-- helpers
+delaySec :: Int -> IO ()
+delaySec n = threadDelay $ n*1000*1000
+
+cleanup :: FilePath -> IO ()
+cleanup path = do
+    sp <- doesDirectoryExist path
+    when sp $ removeDirectoryRecursive path
+
+-- benchmark
+masterBench :: AcidState IntState -> IO ()
+masterBench acid = replicateM_ 100 $ update acid IncrementState
+
+slave :: MVar () -> IO ()
+slave sync = do
+    acid <- enslaveStateFrom "state/MasterSlave/s1" "localhost" 3333 (IntState 0)
+    takeMVar sync
+    closeAcidState acid
+
+main :: IO ()
+main = do
+    -- init acid
+    cleanup "state/MasterSlave"
+    acid <- openMasterStateFrom "state/MasterSlave/m" "127.0.0.1" 3333 (IntState 0)
+    sync <- newEmptyMVar
+    void $ forkIO $ slave sync
+    delaySec 2
+
+    -- run benchmark
+    defaultMain
+        [ bench "MasterSlave" $ nfIO (masterBench acid)
+        ]
+
+    -- cleanup
+    putMVar sync ()
+    closeAcidState acid
+    exitSuccess
index 2dda63b..849b9dd 100644 (file)
--- a/makefile
+++ b/makefile
@@ -1,8 +1,9 @@
 all-test:
        cabal clean
-       cabal configure --enable-test
+       cabal configure --enable-test --enable-benchmarks
        cabal build
        cabal test | grep --color -C 999 PASS
+       cabal bench
 
 clean-all-state:
        find . -name state -type d -exec rm -rf {} \;