module Counter( SenateCounter, Criteria, createSenateCounter, doCount, getBallot, getTotal, matchID, matchList ) where import qualified Candidate as Typ import qualified Preferences as Pref import qualified CSV as CSV import qualified Storage as Vec import qualified System.IO as IO import qualified File as File import qualified Control.Monad as Con import qualified Data.Either.Unwrap as Either import qualified Data.Maybe as Maybe import qualified Data.List as List import Data.Array ( (!) ) import qualified Data.Array as Arr data SenateCounter = SenateCounter { prefData :: Vec.Store , ballotMap :: Typ.BelowLineBallot , numBallots :: Int } type Criteria = [Either Typ.CandidateID [Typ.CandidateID]] createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do numLines <- File.countLines f prefStore <- Vec.createStore numLines (length b) h <- IO.openFile f IO.ReadMode let readFunc n p = if (n > numLines) then return p else do t0 <- IO.hGetLine h let prefs = parseRawLine a b t0 result = Maybe.fromJust prefs if (Maybe.isJust prefs) then Vec.setPrefs prefStore (p + 1) result >> readFunc (n + 1) (p + 1) else readFunc (n + 1) p p <- readFunc 1 0 IO.hClose h return (SenateCounter { prefData = prefStore , ballotMap = b , numBallots = p }) parseRawLine :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> String -> Maybe [Pref.Preference] parseRawLine a b input = let t1 = CSV.parseRecord CSV.defaultSettings (input ++ "\n") t2 = Maybe.listToMaybe . reverse . Either.fromRight $ t1 t3 = Pref.parsePreferences (length a) (length b) (Maybe.fromJust t2) t4 = Pref.normalise a b (Either.fromRight t3) in if (Either.isRight t1 && Maybe.isJust t2 && Either.isRight t3) then t4 else Nothing doCount :: SenateCounter -> Criteria -> IO Int doCount sen criteria = do let checkList = map (toInternal (ballotMap sen)) criteria upperBound = length checkList checkArray = Arr.listArray (1,upperBound) checkList testFunc bal check rank = if (check > upperBound) then return True else do case (checkArray ! check) of Left x -> do r <- Vec.checkPref (prefData sen) bal (x,rank) if r then testFunc bal (check + 1) (rank + 1) else return False Right xs -> do rs <- mapM (\p -> Vec.checkPref (prefData sen) bal (p,rank)) xs if (or rs) then testFunc bal check (rank + 1) else testFunc bal (check + 1) rank tailFunc n p = if (n > numBallots sen) then return p else do r <- testFunc n 1 1 if r then tailFunc (n + 1) (p + 1) else tailFunc (n + 1) p tailFunc 1 0 toInternal :: Typ.BelowLineBallot -> Either Typ.CandidateID [Typ.CandidateID] -> Either Typ.Position (Arr.Array Int Typ.Position) toInternal ballot (Left c) = let r = Maybe.fromJust (List.elemIndex c ballot) in Left (r + 1) toInternal ballot (Right cs) = let f x = Maybe.fromJust (List.elemIndex x ballot) r = map ((+ 1) . f) cs in Right (Arr.listArray (1,length r) r) getBallot :: SenateCounter -> Typ.BelowLineBallot getBallot = ballotMap getTotal :: SenateCounter -> Int getTotal = numBallots matchID :: Typ.CandidateID -> Either Typ.CandidateID [Typ.CandidateID] matchID = Left matchList :: [Typ.CandidateID] -> Either Typ.CandidateID [Typ.CandidateID] matchList = Right