diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/CSV.hs | 71 | ||||
| -rw-r--r-- | src/Candidate.hs | 10 | ||||
| -rw-r--r-- | src/Counter.hs | 14 | ||||
| -rw-r--r-- | src/File.hs | 1 | ||||
| -rw-r--r-- | src/Miscellaneous.hs | 7 | ||||
| -rw-r--r-- | src/Preferences.hs | 1 | ||||
| -rw-r--r-- | src/Storage.hs | 5 | ||||
| -rw-r--r-- | src/main.hs | 1 |
8 files changed, 71 insertions, 39 deletions
@@ -2,6 +2,7 @@ module CSV( Settings(..), + specialChars, defaultSettings, parseRecord @@ -10,50 +11,78 @@ module CSV( -import Text.ParserCombinators.Parsec -import Data.Char +import Text.ParserCombinators.Parsec ( (<|>), (<?>) ) +import qualified Text.ParserCombinators.Parsec as Parsec +import qualified Data.Char as Char -data Settings = Settings { separator :: Char - , quote :: Char - , escape :: Char } +data Settings = Settings + { separator :: Char + , quote :: Char + , escape :: Char } -specialChars :: Settings -> String -specialChars s = (separator s):(quote s):(escape s):[] -defaultSettings = Settings { separator = ',', quote = '\"', escape = '\\' } +defaultSettings = Settings + { separator = ',' + , quote = '\"' + , escape = '\\' } -parseRecord :: Settings -> String -> Either ParseError [String] -parseRecord settings input = - parse (record settings) "error" input +specialChars :: Settings -> String +specialChars s = (separator s):(quote s):(escape s):[] + +parseRecord :: Settings -> String -> Either Parsec.ParseError [String] +parseRecord settings input = + Parsec.parse (record settings) "error" input + record s = do - f <- (field s) `sepBy` (char (separator s)) - optional eol - eof + f <- (field s) `Parsec.sepBy` (Parsec.char (separator s)) + Parsec.optional eol + Parsec.eof return f -field s = many (try (quoted s) <|> many1 (fieldChar s)) >>= return . foldl1 (++) -quoted s = between (char (quote s)) (char (quote s)) (many (quotedChar s)) +field s = + Parsec.many (Parsec.try (quoted s) <|> Parsec.many1 (fieldChar s)) >>= + return . foldl1 (++) + + +quoted s = + Parsec.between + (Parsec.char (quote s)) + (Parsec.char (quote s)) + (Parsec.many (quotedChar s)) + + fieldChar s = allExcept s (specialChars s) + + quotedChar s = allExcept s [quote s] -allExcept s c = try (escapeChar s) <|> satisfy (\x -> (not (isControl x)) && (x `notElem` c)) -escapeChar s = char (escape s) >> oneOf (specialChars s) -eol = try (string "\r\n") - <|> try (string "\r") - <|> try (string "\n") +allExcept s c = + Parsec.try (escapeChar s) <|> + Parsec.satisfy (\x -> (not (Char.isControl x)) && (x `notElem` c)) + + +escapeChar s = do + Parsec.char (escape s) + Parsec.oneOf (specialChars s) + + +eol = Parsec.try (Parsec.string "\r\n") + <|> Parsec.try (Parsec.string "\r") + <|> Parsec.try (Parsec.string "\n") <?> "end of line" + diff --git a/src/Candidate.hs b/src/Candidate.hs index e779051..d07ce14 100644 --- a/src/Candidate.hs +++ b/src/Candidate.hs @@ -4,7 +4,6 @@ module Candidate( CandidateID, AboveLineBallot, BelowLineBallot, - Criteria, readCandidates ) where @@ -18,7 +17,6 @@ import qualified System.IO as IO import qualified Data.List as List import qualified Data.Either.Unwrap as Either import qualified Data.Maybe as Maybe -import qualified Data.Char as Char @@ -34,18 +32,14 @@ type AboveLineBallot = [[Position]] -- a list of candidates in the order of how they were placed below the line type BelowLineBallot = [CandidateID] --- represents a criteria used for finding ballots that voted a specific --- way, for example voted for candidate C as #1, candidate F as #2, etc -type Criteria = [(Ranking,CandidateID)] - readCandidates :: FilePath -> String -> IO (AboveLineBallot, BelowLineBallot) readCandidates inputFile state = do h <- IO.openFile inputFile IO.ReadMode - -- e <- IO.hIsEOF h + let readFunc r c = if c then return r else do t0 <- IO.hGetLine h let t1 = CSV.parseRecord CSV.defaultSettings t0 @@ -56,8 +50,8 @@ readCandidates inputFile state = do then readFunc (t3:r) tx else readFunc r tx raw <- readFunc [] e >>= return . (List.sort) + IO.hClose h - -- return (makeAboveBallot raw, makeBelowBallot raw) diff --git a/src/Counter.hs b/src/Counter.hs index 6646133..48429ef 100644 --- a/src/Counter.hs +++ b/src/Counter.hs @@ -1,4 +1,5 @@ module Counter( + Criteria, SenateCounter, createSenateCounter, @@ -22,9 +23,14 @@ import qualified Data.List as List -data SenateCounter = SenateCounter { prefData :: Vec.Store - , ballotMap :: Typ.BelowLineBallot - , numBallots :: Int } +-- represents a criteria used for finding ballots that voted a specific +-- way, for example voted for candidate C as #1, candidate F as #2, etc +type Criteria = [(Typ.Ranking,Typ.CandidateID)] + +data SenateCounter = SenateCounter + { prefData :: Vec.Store + , ballotMap :: Typ.BelowLineBallot + , numBallots :: Int } @@ -54,7 +60,7 @@ createSenateCounter f a b = do -doCount :: SenateCounter -> Typ.Criteria -> IO Int +doCount :: SenateCounter -> Criteria -> IO Int doCount sen criteria = do -- let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria diff --git a/src/File.hs b/src/File.hs index e1245e8..01b33af 100644 --- a/src/File.hs +++ b/src/File.hs @@ -29,3 +29,4 @@ countLinesTail h n = do then IO.hClose h >> return (n + 1) else countLinesTail h (n + 1) + diff --git a/src/Miscellaneous.hs b/src/Miscellaneous.hs index de20a3d..5a559a5 100644 --- a/src/Miscellaneous.hs +++ b/src/Miscellaneous.hs @@ -7,7 +7,7 @@ module Miscellaneous( -import Control.Monad as Con +import qualified Control.Monad as Con import qualified Data.List as List import qualified Data.Maybe as Maybe @@ -26,6 +26,7 @@ infixr 1 ? + -- kinda functions like poor man's sql -- first argument is the indices of the items you want in the results -- second argument is index-item pairs to dictate what records are acceptable to select from @@ -34,13 +35,13 @@ infixr 1 ? -- (note that all indices start from 1) selectFrom :: (Num t, Eq t, Eq a, Enum t) => [t] -> [(t,a)] -> [a] -> Maybe [a] selectFrom pick has from = - let tailFunc r i = + let foldFunc r i = let check = List.lookup (fst i) has in if (Maybe.isNothing check || Maybe.fromJust check == snd i) then if (List.elem (fst i) pick) then Just (r ++ [snd i]) else Just r else Nothing - in Con.foldM tailFunc [] (zip [1,2..] from) + in Con.foldM foldFunc [] (zip [1,2..] from) diff --git a/src/Preferences.hs b/src/Preferences.hs index 4fee0bc..b40accb 100644 --- a/src/Preferences.hs +++ b/src/Preferences.hs @@ -115,3 +115,4 @@ weirdRank = do -- these ranks are standins that will be filtered out nullRank = return "0" + diff --git a/src/Storage.hs b/src/Storage.hs index 75b452b..2f0ed1c 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -16,8 +16,9 @@ import qualified Data.Vector.Unboxed.Mutable as Vec -data Store = Store { getPointer :: Vec.IOVector Int8 - , getBallotSize :: Int } +data Store = Store + { getPointer :: Vec.IOVector Int8 + , getBallotSize :: Int } diff --git a/src/main.hs b/src/main.hs index ef7589e..6e68489 100644 --- a/src/main.hs +++ b/src/main.hs @@ -171,6 +171,5 @@ main = do -- run the show Elt.doCount election numToElect - Ex.exitSuccess |