diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Election.hs | 39 | ||||
| -rw-r--r-- | src/main.hs | 44 |
2 files changed, 54 insertions, 29 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) diff --git a/src/main.hs b/src/main.hs index 7b08e64..b0baaa4 100644 --- a/src/main.hs +++ b/src/main.hs @@ -67,7 +67,10 @@ stateOpt str = -optionHeader = "Usage: stv [OPTION...]" +optionHeader = + "Usage: stv [OPTION...]\n\n" ++ + "Note that the -c, -p, -o, -e, -s options are all\n" ++ + "required for normal operation.\n" optionData :: [Opt.OptDescr (Options -> Options)] optionData = @@ -85,18 +88,18 @@ optionData = , Opt.Option ['c'] ["candidates"] (Opt.ReqArg (\c opts -> opts { getCandFile = Just c }) "FILE") - "file containing AEC candidate data" + ".csv file containing AEC candidate data" , Opt.Option ['p'] ["preferences"] (Opt.ReqArg (\p opts -> opts { getPrefFile = Just p}) "FILE") - "file containing AEC formal preferences" + ".csv file containing AEC formal preferences" , Opt.Option ['o'] ["outdir"] (Opt.ReqArg (\d opts -> opts { getOutDir = Just d}) "DIR") - "directory to output count logging" + "new directory to output count logging" , Opt.Option ['e'] ["elect"] - (Opt.ReqArg electOpt "NUM") + (Opt.ReqArg electOpt "INT") "number of candidates to elect" , Opt.Option ['s'] ["state"] @@ -115,6 +118,14 @@ getOpts argv = +furtherHelp :: String +furtherHelp = + "Please be sure to provide all required options to run the election counter.\n" ++ + "For further information consult '--help'.\n" + + + + main = do rawArgs <- Env.getArgs (options, arguments) <- getOpts rawArgs @@ -134,42 +145,47 @@ main = do -- both present and valid let candidateFile = Maybe.fromJust (getCandFile options) Con.when (Maybe.isNothing (getCandFile options)) $ - Ex.die "Candidate data file not provided" + Ex.die ("Candidate data file not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesFileExist candidateFile Con.when (not doesExist) $ - Ex.die "Candidate data file does not exist" + Ex.die ("Candidate data file does not exist.\n\n" ++ furtherHelp) let preferenceFile = Maybe.fromJust (getPrefFile options) Con.when (Maybe.isNothing (getPrefFile options)) $ - Ex.die "Formal preference data file not provided" + Ex.die ("Formal preference data file not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesFileExist preferenceFile Con.when (not doesExist) $ - Ex.die "Formal preference data file does not exist" + Ex.die ("Formal preference data file does not exist.\n\n" ++ furtherHelp) let outputDir = Maybe.fromJust (getOutDir options) Con.when (Maybe.isNothing (getOutDir options)) $ - Ex.die "Output logging directory not provided" + Ex.die ("Output logging directory not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesDirectoryExist outputDir Con.when doesExist $ - Ex.die "Output directory already exists" + Ex.die ("Output directory already exists.\n\n" ++ furtherHelp) let numToElect = Maybe.fromJust (getNumToElect options) Con.when (Maybe.isNothing (getNumToElect options)) $ - Ex.die "Invalid number of candidates to elect or number not provided" + Ex.die ("Invalid number of candidates to elect or number not provided.\n\n" ++ furtherHelp) let state = Maybe.fromJust (getState options) Con.when (Maybe.isNothing (getState options)) $ - Ex.die "Invalid state/territory or state/territory not provided" + Ex.die ("Invalid state/territory or state/territory not provided.\n\n" ++ furtherHelp) -- set up the election processing (aboveBallot, belowBallot) <- Cand.readCandidates candidateFile state + Con.when (isVerbose options) $ putStrLn "Reading preference data..." counter <- Sen.createSenateCounter preferenceFile aboveBallot belowBallot + Con.when (isVerbose options) $ putStrLn "Done.\n" Dir.createDirectory outputDir - election <- Elt.createElection outputDir counter numToElect + Con.when (isVerbose options) $ putStrLn "Setting up election..." + election <- Elt.createElection outputDir counter numToElect (isVerbose options) + Con.when (isVerbose options) $ putStrLn "Done.\n" -- run the show + Con.when (isVerbose options) $ putStrLn "Running...\n" Elt.doCount election |