interactive intState examples for tests
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 15 Jul 2015 09:48:40 +0000 (11:48 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 15 Jul 2015 09:48:40 +0000 (11:48 +0200)
tests/IntCommon.hs [new file with mode: 0644]
tests/IntMasterInteractive.hs [new file with mode: 0644]
tests/IntSlaveInteractive.hs [new file with mode: 0644]

diff --git a/tests/IntCommon.hs b/tests/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/tests/IntMasterInteractive.hs b/tests/IntMasterInteractive.hs
new file mode 100644 (file)
index 0000000..0f87142
--- /dev/null
@@ -0,0 +1,41 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+import Data.SafeCopy
+import Data.Typeable
+
+import Control.Monad (forever)
+import System.Exit (exitSuccess)
+
+-- state structures
+import IntCommon
+
+-- actual test
+main :: IO ()
+main = do
+    acid <- openMasterState 3333 (IntState 0)
+    putStrLn usage
+    forever $ do
+        input <- getLine
+        case input of
+            ('x':_) -> do
+                putStrLn "Bye!"
+                closeAcidState acid
+                exitSuccess
+            ('q':_) -> do
+                val <- query acid GetState
+                putStrLn $ "Current value: " ++ show val
+            ('u':val) -> do
+                update acid (SetState (read val :: Int))
+                putStrLn "State updated."
+            ('i':_) -> update acid IncrementState
+            _ -> putStrLn "Unknown command." >> putStrLn usage
+
+
+usage :: String
+usage = "Possible commands:\
+        \\n  x    exit\
+        \\n  q    query the state\
+        \\n  u v  update to value v\
+        \\n  i    increment"
diff --git a/tests/IntSlaveInteractive.hs b/tests/IntSlaveInteractive.hs
new file mode 100644 (file)
index 0000000..14c9048
--- /dev/null
@@ -0,0 +1,41 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+import Data.SafeCopy
+import Data.Typeable
+
+import Control.Monad (forever)
+import System.Exit (exitSuccess)
+
+-- state structures
+import IntCommon
+
+-- actual test
+main :: IO ()
+main = do
+    acid <- enslaveState "localhost" 3333 (IntState 0)
+    putStrLn usage
+    forever $ do
+        input <- getLine
+        case input of
+            ('x':_) -> do
+                putStrLn "Bye!"
+                closeAcidState acid
+                exitSuccess
+            ('q':_) -> do
+                val <- query acid GetState
+                putStrLn $ "Current value: " ++ show val
+            ('u':val) -> do
+                update acid (SetState (read val :: Int))
+                putStrLn "State updated."
+            ('i':_) -> update acid IncrementState
+            _ -> putStrLn "Unknown command." >> putStrLn usage
+
+
+usage :: String
+usage = "Possible commands:\
+        \\n  x    exit\
+        \\n  q    query the state\
+        \\n  u v  update to value v\
+        \\n  i    increment"