summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Election.hs39
-rw-r--r--src/main.hs44
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