summaryrefslogtreecommitdiff
path: root/src/Election.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Election.hs')
-rw-r--r--src/Election.hs39
1 files changed, 24 insertions, 15 deletions
diff --git a/src/Election.hs b/src/Election.hs
index 60fd78f..350d652 100644
--- a/src/Election.hs
+++ b/src/Election.hs
@@ -29,12 +29,14 @@ data Election = Election
, getLogDir :: FilePath
, getTotalPapers :: Int
, getQuota :: Int
+ , getMainLog :: String
, getNextLogNum :: Int
, getSeats :: Int
, getVacancies :: Int
, getTransferQueue :: [Transfer]
, getNextToElect :: Int
- , isDone :: Bool }
+ , isDone :: Bool
+ , isVerbose :: Bool }
data Entry = Entry
{ getID :: Typ.CandidateID
@@ -66,10 +68,11 @@ type TransferMap = Map.Map Typ.CandidateID [(Int,Trace)]
-createElection :: FilePath -> Sen.SenateCounter -> Int -> IO Election
-createElection outDir counter numToElect = do
+createElection :: FilePath -> Sen.SenateCounter -> Int -> Bool -> IO Election
+createElection outDir counter numToElect verbosity = do
entries <- mapM (candToEntry counter) (Sen.getBallot counter)
- let total = Sen.getTotal counter
+ let mainLog = outDir ++ "/" ++ "log.txt"
+ total = Sen.getTotal counter
quota = droopQuota total numToElect
return (Election
{ getEntries = entries
@@ -77,12 +80,14 @@ createElection outDir counter numToElect = do
, getLogDir = outDir
, getTotalPapers = total
, getQuota = quota
+ , getMainLog = mainLog
, getNextLogNum = 1
, getSeats = numToElect
, getVacancies = numToElect
, getTransferQueue = []
, getNextToElect = 1
- , isDone = False })
+ , isDone = False
+ , isVerbose = verbosity })
@@ -112,11 +117,10 @@ candToEntry counter candidate = do
doCount :: Election -> IO ()
-doCount e = do
- writeLog e
- let e1 = e { getNextLogNum = 1 + getNextLogNum e }
-
- Con.when (not (isDone e1)) $ do
+doCount e =
+ Con.when (not (isDone e)) $ do
+ writeLog e
+ let e1 = e { getNextLogNum = 1 + getNextLogNum e }
-- these following calculations probably aren't the
-- intended use of Either monads, but the pattern fits
@@ -216,11 +220,15 @@ doElectCandidate e = do
allRevised = beforeEntries ++ [revisedElectedEntry] ++ afterEntries
if (getTotalVotes electedEntry >= getQuota e)
- then ET.right (e
- { getEntries = allRevised
- , getTransferQueue = (getTransferQueue e) ++ [newTransfer]
- , getNextToElect = 1 + getNextToElect e
- , getVacancies = getVacancies e - 1 })
+ then do
+ let logmsg = show (getID electedEntry) ++ " elected at logfile #" ++ show (getNextLogNum e)
+ MIO.liftIO $ IO.appendFile (getMainLog e) (logmsg ++ "\n")
+ MIO.liftIO $ Con.when (isVerbose e) (putStrLn logmsg)
+ ET.right (e
+ { getEntries = allRevised
+ , getTransferQueue = (getTransferQueue e) ++ [newTransfer]
+ , getNextToElect = 1 + getNextToElect e
+ , getVacancies = getVacancies e - 1 })
else ET.left e
@@ -265,6 +273,7 @@ doVoteTransfer e = do
revisedFromEntry = fromEntry
{ getVoteChange = -(getVoteAmount currentTransfer)
, getTotalVotes = getTotalVotes fromEntry - (getVoteAmount currentTransfer)
+ -- this last bit needs to be replaced with something more accurate
, getCritTrace = [] }
allRevised = (map reviseFunc beforeEntries) ++ [revisedFromEntry] ++ (map reviseFunc afterEntries)