Skip to content

Instantly share code, notes, and snippets.

@tvh
Last active August 29, 2015 14:09
Show Gist options
  • Save tvh/7bc680ad357b63b93247 to your computer and use it in GitHub Desktop.
Save tvh/7bc680ad357b63b93247 to your computer and use it in GitHub Desktop.
set 10: 4.98707s
delete 10: 4.750214s
delete 10: 5.021166s
set 10: 5.073635s
delete 10: 5.090525s
delete 10: 5.106929s
set 10: 5.145212s
set 10: 5.283383s
set 10: 5.077518s
delete 10: 5.175202s
set 10: 5.180288s
delete 10: 5.468919s
set 10: 5.246395s
set 10: 5.262679s
delete 10: 5.570295s
delete 10: 4.895424s
children: 4100
children: 4100
children: 4090
children: 4080
children: 4070
children: 4060
children: 4050
children: 4040
children: 4030
children: 4020
children: 4010
children: 4000
children: 3990
children: 3980
children: 3970
children: 3960
children: 3950
delete 10: 5.466908s
set 10: 5.015142s
delete 10: 5.071939s
set 10: 5.96868s
children: 4113
children: 4113
children: 4103
children: 4093
children: 4083
^Cinsert 10: 9.108567s
insert 10: 9.813199s
set 10: 4.248619s
insert 10: 10.518352s
children: 4147
children: 4147
set 10: 4.997883s
children: 4137
insert 10: 10.911797s
delete 10: 5.087405s
children: 4127
insert 10: 10.960071s
delete 10: 5.129062s
children: 4117
set 10: 5.141148s
children: 4107
insert 10: 11.023512s
insert 10: 11.031749s
insert 10: 11.076987s
insert 10: 11.088876s
set 10: 5.293174s
children: 4097
set 10: 5.300343s
children: 4087
delete 10: 5.331058s
children: 4077
set 10: 5.343587s
children: 4067
delete 10: 5.360299s
children: 4057
set 10: 5.443199s
children: 4047
set 10: 5.453343s
children: 4037
delete 10: 5.466835s
children: 4027
delete 10: 5.718761s
set 10: 4.951221s
delete 10: 5.765211s
insert 10: 11.856207s
delete 10: 5.49447s
delete 10: 6.323867s
children: 4161
children: 4161
children: 4151
children: 4141
delete 10: 5.912087s
set 10: 5.912455s
children: 4163
children: 4163
children: 4153
children: 4143
children: 4133
set 10: 4.840007s
children: 4123
delete 10: 5.091039s
children: 4113
set 10: 5.047681s
children: 4103
delete 10: 5.077323s
children: 4093
set 10: 4.928633s
children: 4083
set 10: 4.96745s
children: 4073
delete 10: 4.949078s
children: 4063
set 10: 4.967404s
children: 4053
set 10: 5.338434s
children: 4043
delete 10: 5.233125s
children: 4033
set 10: 5.290647s
children: 4023
set 10: 5.295571s
children: 4013
delete 10: 5.29333s
children: 4003
delete 10: 5.148076s
set 10: 5.271761s
delete 10: 5.368704s
children: 4210
children: 4210
children: 4200
children: 4190
delete 10: 5.308387s
children: 4180
delete 10: 5.338613s
children: 4170
set 10: 5.333571s
children: 4160
delete 10: 5.408922s
children: 4150
insert 10: 11.200033s
set 10: 5.348563s
insert 10: 12.108535s
delete 10: 5.309238s
set 10: 5.337098s
set 10: 5.36213s
insert 10: 10.962623s
set 10: 5.336683s
delete 10: 5.385468s
insert 10: 10.519215s
set 10: 5.391425s
insert 10: 10.703607s
children: 4246
children: 4246
children: 4236
children: 4226
children: 4216
children: 4206
children: 4196
children: 4186
delete 10: 5.223063s
set 10: 5.273156s
set 10: 5.797148s
children: 4176
children: 4166
children: 4156
delete 10: 5.973862s
children: 4146
set 10: 5.580122s
children: 4136
delete 10: 5.771248s
children: 4126
insert 10: 11.392472s
insert 10: 11.435812s
insert 10: 11.567199s
insert 10: 11.730542s
delete 10: 4.901959s
children: 4116
delete 10: 4.934502s
children: 4106
delete 10: 5.054407s
children: 4096
set 10: 5.103366s
children: 4086
delete 10: 4.985678s
children: 4076
set 10: 5.104731s
children: 4066
delete 10: 5.200039s
children: 4056
insert 10: 11.983397s
set 10: 5.646052s
set 10: 5.703585s
delete 10: 5.723323s
delete 10: 5.754553s
set 10: 5.568362s
set 10: 5.838921s
set 10: 5.678811s
delete 10: 5.679065s
delete 10: 5.603686s
set 10: 6.307126s
children: 4296
children: 4296
children: 4286
children: 4276
children: 4266
children: 4256
children: 4246
children: 4236
children: 4226
children: 4216
children: 4206
set 10: 5.967936s
children: 4196
set 10: 6.79506s
children: 4186
delete 10: 6.721933s
delete 10: 5.858011s
delete 10: 6.229735s
delete 10: 6.240273s
delete 10: 6.186697s
set 10: 6.146861s
delete 10: 6.274917s
set 10: 6.290742s
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Foldable
import Control.Monad (forever,void,when,replicateM)
import Network.Etcd
import Control.Concurrent
import System.Random
import Control.Concurrent.STM
import qualified Data.Sequence as S
import Data.Time.Clock
maxn = 300000
url = "http://127.0.0.1:4001"
insertThread :: TMVar (S.Seq String) -> IO ()
insertThread tchan = do
client <- createClient [url]
forever $ do
t1 <- getCurrentTime
replicateM 10 $ do
n <- randomIO :: IO Int
let node = "/nodes/node" ++ show n
atomically $ do
n <- readTMVar tchan
when (S.length n > maxn) retry
ex <- get client node
case ex of
Nothing -> do
void $ create client node "bla" Nothing
Just _ -> do
void $ set client node "foo" Nothing
t2 <- getCurrentTime
putStrLn $ "insert 10: " ++ (show $ diffUTCTime t2 t1)
setThread :: TMVar (S.Seq String) -> IO ()
setThread tchan = do
client <- createClient [url]
forever $ do
childs <- atomically $ do
chan <- takeTMVar tchan
if (not . S.null $ chan)
then let (xs,ys) = S.splitAt 10 chan in putTMVar tchan ys >> return (Just (S.length chan, xs))
else return Nothing
case childs of
Just (n,children) -> do
t1 <- getCurrentTime
putStrLn $ "children: " ++ show n
forM_ children $ \child -> set client ("/nodes/" ++ child) "boo" Nothing
t2 <- getCurrentTime
putStrLn $ "set 10: " ++ (show $ diffUTCTime t2 t1)
Nothing -> do
children' <- listDirectoryContents client "/nodes"
putStrLn $ "children: " ++ show (length children')
atomically $ putTMVar tchan (S.fromList $ map _nodeKey children')
deleteThread :: TMVar (S.Seq String) -> IO ()
deleteThread tchan = do
client <- createClient [url]
forever $ do
childs <- atomically $ do
chan <- takeTMVar tchan
if (not . S.null $ chan)
then let (xs,ys) = S.splitAt 10 chan in putTMVar tchan ys >> return (Just (S.length chan, xs))
else return Nothing
case childs of
Just (n,children) -> do
t1 <- getCurrentTime
putStrLn $ "children: " ++ show n
forM_ children $ \child -> removeDirectory client ("/nodes/" ++ child)
t2 <- getCurrentTime
putStrLn $ "delete 10: " ++ (show $ diffUTCTime t2 t1)
Nothing -> do
children' <- listDirectoryContents client "/nodes"
putStrLn $ "children: " ++ show (length children')
atomically $ putTMVar tchan (S.fromList $ map _nodeKey children')
printThread :: TMVar (S.Seq String) -> IO ()
printThread tchan = do
client <- createClient [url]
forever $ do
threadDelay 3000
children' <- listDirectoryContents client "/"
atomically $ do
void $ takeTMVar tchan
putTMVar tchan (S.fromList $ map _nodeKey children')
main :: IO ()
main = do
client <- createClient [url]
createDirectory client "/nodes" Nothing
chan <- newTMVarIO S.empty
replicateM 10 $ void $ forkIO $ insertThread chan
replicateM 10 $ void $ forkIO $ setThread chan
replicateM 10 $ void $ forkIO $ deleteThread chan
printThread chan
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment