diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Election.hs | 51 |
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 |