summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Election.hs51
1 files changed, 32 insertions, 19 deletions
diff --git a/src/Election.hs b/src/Election.hs
index 41cbfbe..6d946cd 100644
--- a/src/Election.hs
+++ b/src/Election.hs
@@ -9,6 +9,7 @@ module Election(
import qualified System.IO as IO
+import qualified System.Exit as Ex
import qualified Control.Monad as Con
import qualified Control.Monad.Trans.Either as ET
import qualified Control.Monad.IO.Class as MIO
@@ -63,6 +64,7 @@ data Transfer = Transfer
, getVoteAmount :: Int
, getNewValue :: Rational
, getWhatToDist :: [Trace] }
+ deriving (Eq)
@@ -123,19 +125,23 @@ doCount e =
Con.when (not (isDone e)) $ do
writeLog e
let e1 = e { getNextLogNum = 1 + getNextLogNum e }
+ let e2 = e1 { getEntries = map clearChange (getEntries e1) }
-- these following calculations probably aren't the
-- intended use of Either monads, but the pattern fits
-- and it's certainly a lot better than a bunch of
-- if-then-else constructs in haskell
r <- ET.eitherT return return $
- clearChanges e1 >>=
- electCandidates >>=
+ electCandidates e2 >>=
checkIfDone >>=
transferVotes >>=
checkNoQuota >>=
excludeCandidates
+ -- this should never happen unless there's a bug somewhere
+ Con.when (getEntries e2 == getEntries r && getTransferQueue e2 == getTransferQueue r && not (isDone r)) $
+ Ex.die "Infinite loop detected in election counting"
+
doCount r
@@ -178,12 +184,10 @@ writeLog e = do
-clearChanges :: Election -> ET.EitherT Election IO Election
-clearChanges e = do
- let clear entry = entry
- { getChanged = False
- , getVoteChange = 0 }
- ET.right (e { getEntries = map clear (getEntries e) })
+clearChange :: Entry -> Entry
+clearChange entry = entry
+ { getChanged = False
+ , getVoteChange = 0 }
@@ -201,6 +205,7 @@ electCandidates e = do
-- needs to be modified to take into account ties
+-- may be prudent to put this just in the IO monad instead of EitherT
doElectCandidate :: Election -> ET.EitherT Election IO Election
doElectCandidate e = do
let (running, notRunning) = List.partition ((== Running) . getStatus) (getEntries e)
@@ -255,6 +260,7 @@ transferVotes e =
+-- may be prudent to put this just in the IO monad instead of EitherT
doVoteTransfer :: Election -> ET.EitherT Election IO Election
doVoteTransfer e = do
let (currentTransfer:remainingTransfers) = getTransferQueue e
@@ -301,18 +307,25 @@ checkNoQuota e = do
minimumEntry = List.minimumBy compareVotes running
(beforeEntries, afterEntries) = Misc.partBeforeAfter minimumEntry (getEntries e)
- makeElect x = x
- { getStatus = Elected
- , getChanged = True }
+ makeElect entry = do
+ let logmsg = show (getID entry) ++ " elected at logfile #" ++ show (getNextLogNum e)
+ MIO.liftIO $ IO.appendFile (getMainLog e) (logmsg ++ "\n")
+ MIO.liftIO $ Con.when (isVerbose e) (IO.hPutStrLn IO.stderr logmsg)
+ return (entry
+ { getStatus = Elected
+ , getChanged = True })
reviseFunc entry =
if ((getStatus entry == Running) && (entry /= minimumEntry))
then makeElect entry
- else entry
- revisedMinEntry =
- if (length running <= getVacancies e)
- then makeElect minimumEntry
- else minimumEntry
- allRevised = (map reviseFunc beforeEntries) ++ [revisedMinEntry] ++ (map reviseFunc afterEntries)
+ else return entry
+
+ revisedMinEntry <-
+ if (length running <= getVacancies e)
+ then makeElect minimumEntry
+ else return minimumEntry
+ revisedBeforeEntries <- mapM reviseFunc beforeEntries
+ revisedAfterEntries <- mapM reviseFunc afterEntries
+ let allRevised = revisedBeforeEntries ++ [revisedMinEntry] ++ revisedAfterEntries
if (length running <= getVacancies e + 1)
then ET.left (e
@@ -327,13 +340,13 @@ excludeCandidates :: Election -> ET.EitherT Election IO Election
excludeCandidates e = do
let running = filter ((== Running) . getStatus) (getEntries e)
sorted = reverse (List.sortBy compareVotes running)
- voteGap = getQuota e - getTotalVotes (head sorted)
+ appliedBreakpoint = getQuota e - getTotalVotes (head sorted)
excludeLoop n v e = do
(i,r) <- MIO.liftIO $ excludeSomeone e
let v1 = v + i
n1 = n + 1
- if (v1 > voteGap)
+ if (v1 > appliedBreakpoint)
then if (n > 0)
then ET.left e
else ET.left r