test: replication, needs fix for slave/master state
authorMax Voit <max.voit+gtdv@with-eyes.net>
Mon, 20 Jul 2015 16:50:18 +0000 (18:50 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Mon, 20 Jul 2015 16:50:18 +0000 (18:50 +0200)
acid-state-dist.cabal
test/IntCommon.hs [new file with mode: 0644]
test/simple.hs [new file with mode: 0644]

index 2a9d27b..17db8f9 100644 (file)
@@ -81,3 +81,11 @@ library
   -- Base language which the package is written in.
   default-language:    Haskell2010
 
+test-suite simple
+  main-is:          simple.hs
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  ghc-options:      -Wall
+  default-language: Haskell2010
+  build-depends:    base,
+                    acid-state-dist
diff --git a/test/IntCommon.hs b/test/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/test/simple.hs b/test/simple.hs
new file mode 100644 (file)
index 0000000..d116505
--- /dev/null
@@ -0,0 +1,43 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+import Data.Acid.Centered.Master (createArchiveGlobally)
+import Data.SafeCopy
+import Data.Typeable
+
+import Control.Monad (forever, forM_)
+import Control.Concurrent
+import System.Exit
+
+-- state structures
+import IntCommon
+
+delaySec n = threadDelay $ n*1000*1000
+
+-- actual test
+master :: IO ()
+master = do
+    acid <- openMasterState 3333 (IntState 0)
+    update acid (SetState 23)
+    delaySec 1
+    closeAcidState acid
+
+slave :: IO ()
+slave = do
+    -- TODO other working dir or openStateFrom
+    acid <- enslaveState "localhost" 3333 (IntState 0)
+    val <- query acid GetState
+    closeAcidState acid
+    if val == 23 then
+        exitSuccess
+    else
+        exitFailure
+
+main :: IO ()
+main = do
+    forkIO slave
+    delaySec 1
+    forkIO master
+    exitSuccess
+