From 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Sat, 28 Sep 2019 13:43:29 -0400
Subject: Factor out some new libraries

	word64-map:
		Data.Word64Map
	network-addr:
		Network.Address
	tox-crypto:
		Crypto.Tox
	lifted-concurrent:
		Control.Concurrent.Lifted.Instrument
		Control.Concurrent.Async.Lifted.Instrument
	psq-wrap:
		Data.Wrapper.PSQInt
		Data.Wrapper.PSQ
	minmax-psq:
		Data.MinMaxPSQ
        tasks:
                Control.Concurrent.Tasks
	kad:
		Network.Kademlia
		Network.Kademlia.Bootstrap
		Network.Kademlia.Routing
		Network.Kademlia.CommonAPI
		Network.Kademlia.Persistence
		Network.Kademlia.Search
---
 src/Control/TriadCommittee.hs | 89 -------------------------------------------
 1 file changed, 89 deletions(-)
 delete mode 100644 src/Control/TriadCommittee.hs

(limited to 'src/Control/TriadCommittee.hs')

diff --git a/src/Control/TriadCommittee.hs b/src/Control/TriadCommittee.hs
deleted file mode 100644
index 88e665b6..00000000
--- a/src/Control/TriadCommittee.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-module Control.TriadCommittee where
-
-import Control.Concurrent.STM
-import Control.Monad
-import Data.Maybe
-
-
-data TriadSlot = SlotA | SlotB | SlotC
- deriving (Eq,Ord,Enum,Show,Read)
-
-data TriadCommittee voter a = TriadCommittee
-    { triadDecider :: TVar TriadSlot
-    , triadA :: TVar (Maybe (voter,a))
-    , triadB :: TVar (Maybe (voter,a))
-    , triadC :: TVar (Maybe (voter,a))
-    , triadNewDecision :: a -> STM ()
-    }
-
-triadSlot :: TriadSlot -> TriadCommittee voter a -> TVar (Maybe (voter,a))
-triadSlot SlotA = triadA
-triadSlot SlotB = triadB
-triadSlot SlotC = triadC
-
-triadDecision :: a -> TriadCommittee voter a -> STM a
-triadDecision fallback triad = do
-    slot <- readTVar (triadDecider triad)
-    maybe fallback snd <$> readTVar (triadSlot slot triad)
-
-
-newTriadCommittee :: (a -> STM ()) -> STM (TriadCommittee voter a)
-newTriadCommittee onChange =
-    TriadCommittee <$> newTVar SlotA
-                   <*> newTVar Nothing
-                   <*> newTVar Nothing
-                   <*> newTVar Nothing
-                   <*> pure onChange
-
-
-triadCountVotes :: Eq a => Maybe a -> TriadCommittee voter a -> STM ()
-triadCountVotes prior triad = do
-    a <- fmap ((SlotA,) . snd) <$> readTVar (triadA triad)
-    b <- fmap ((SlotB,) . snd) <$> readTVar (triadB triad)
-    c <- fmap ((SlotC,) . snd) <$> readTVar (triadC triad)
-    let (slot,vote) = case catMaybes [a,b,c] of
-            [  (x,xvote)
-             , (y,yvote)
-             , (z,zvote) ]  -> if xvote == yvote then (x,Just xvote)
-                                                 else (z,Just zvote)
-            []              -> (SlotA,Nothing)
-            ((slot,vote):_) -> (slot, Just vote)
-    writeTVar (triadDecider triad) slot
-    case vote of
-        Just v | vote /= prior -> triadNewDecision triad v
-        _                      -> return ()
-
-
-addVote :: (Eq voter, Eq a) => TriadCommittee voter a -> voter -> a -> STM ()
-addVote triad voter vote = do
-    a <- (SlotA,) . fmap fst <$> readTVar (triadA triad)
-    b <- (SlotB,) . fmap fst <$> readTVar (triadB triad)
-    c <- (SlotC,) . fmap fst <$> readTVar (triadC triad)
-    let avail (_,Nothing) = True
-        avail (_,Just x ) = (x == voter)
-        slots = filter avail [a,b,c]
-    forM_ (take 1 slots) $ \(slot,_) -> do
-        prior <- do
-            slotp <- readTVar (triadDecider triad)
-            fmap snd <$> readTVar (triadSlot slotp triad)
-        writeTVar (triadSlot slot triad)
-                  (Just (voter,vote))
-        triadCountVotes prior triad
-
-
-delVote :: (Eq voter, Eq a) => TriadCommittee voter a -> voter -> STM ()
-delVote triad voter = do
-    a <- (SlotA,) . fmap fst <$> readTVar (triadA triad)
-    b <- (SlotB,) . fmap fst <$> readTVar (triadB triad)
-    c <- (SlotC,) . fmap fst <$> readTVar (triadC triad)
-    let match (_,Just x ) = (x == voter)
-        match _           = False
-        slots = filter match [a,b,c]
-    forM_ (take 1 slots) $ \(slot,_) -> do
-        prior <- do
-            slotp <- readTVar (triadDecider triad)
-            fmap snd <$> readTVar (triadSlot slotp triad)
-        writeTVar (triadSlot slot triad) Nothing
-        triadCountVotes prior triad
-
-- 
cgit v1.2.3