Senate counter (mostly) reworked to use new Storage module

1 files changed, 43 insertions, 42 deletions

diff --git a/src/Senate.hs b/src/Senate.hs
index ef2ed9b..40f8521 100644
--- a/src/Senate.hs
+++ b/src/Senate.hs
@@ -9,6 +9,7 @@ module Senate(
 
 import qualified SenateTypes as Typ
 import qualified CSV as CSV
+import qualified Storage as Store
 import qualified Text.ParserCombinators.Parsec as Parsec
 import qualified Data.Either as Either
 import qualified Data.Maybe as Maybe
@@ -20,15 +21,14 @@ import qualified Data.List as List
 type Preferences = [(Typ.Position,Typ.Ranking)]
 type FullPreferences = (Preferences,Preferences)
 
-data SenateCounter = SenateCounter { prefData :: [Preferences]
-                                   , aboveMap :: Typ.AboveLineBallot
-                                   , belowMap :: Typ.BelowLineBallot }
+data SenateCounter = SenateCounter { prefData   :: Store.PrefStorage
+                                   , ballotMap  :: Typ.BelowLineBallot
+                                   , numBallots :: Integer }
 
 
 
 
 headerLines = 2
-fieldsInRecord = 6
 minAboveTheLine = 1
 minBelowTheLine = 6
 
@@ -37,37 +37,34 @@ minBelowTheLine = 6
 
 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
 createSenateCounter f a b = do
+    --
     raw <- readFile f
-    let rawRecs = drop headerLines (lines raw)
-        parsedRecs = Either.rights (filter Either.isRight (map (CSV.parseRecord CSV.defaultSettings) rawRecs))
-        rawPrefs = Either.rights (filter Either.isRight (map ((parsePreferences (length a) (length b)) . last) parsedRecs))
-        normedPrefs = map Maybe.fromJust (filter Maybe.isJust (map (normalise a b) rawPrefs))
-    return (SenateCounter normedPrefs a b)
+    let numLines = length (lines raw)
+    arrayData <- Store.createStorage numLines (length b)
+    --
+    raw2 <- readFile f
+    let rawRecs = drop headerLines (lines raw2)
+        parsedRecs = fromRights (map (CSV.parseRecord CSV.defaultSettings) rawRecs)
+        rawPrefs = map last parsedRecs
+        parsedPrefs = fromRights (map (parsePreferences (length a) (length b)) rawPrefs)
+        normedPrefs = fromJusts (map (normalise a b) parsedPrefs)
+        addToArray x (n,p) = mapM_ (uncurry (Store.pokePref x n)) p
+    mapM_ (addToArray arrayData) (zip [1,2..] normedPrefs)
+    --
+    return (SenateCounter arrayData b (length normedPrefs))
 
 
 
 
 doCount :: SenateCounter -> Typ.Criteria -> Int
-doCount sen tr =
-    let fits = filter (tester (belowMap sen) tr) (prefData sen)
-    in length fits
-
-
-
-
---  tests to see if a given set of preferences matches a specified criteria
-tester :: Typ.BelowLineBallot -> Typ.Criteria -> Preferences -> Bool
-tester _ [] _ = True
-tester m tr p =
-    let result = do
-            index <- List.elemIndex (snd (head tr)) m
-            hasRank <- List.lookup (index + 1) p
-            if (hasRank == (fst (head tr)))
-                then Just True
-                else Nothing
-    in if (Maybe.isJust result)
-        then tester m (tail tr) p
-        else False
+doCount sen crit =
+    let isValidCriteria = all ((`List.elem` (ballotMap sen)) . snd) crit
+        critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r)
+        neededPrefs = map critToPref crit
+        papers = map (Store.peekPref (prefData sen)) [1 .. (numBallots sen)]
+        check paper = all (> 0) (map (uncurry paper) neededPrefs)
+        result = filter id check papers
+    in if isValidCriteria then (length result) else 0
 
 
 
@@ -77,9 +74,9 @@ normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Ma
 normalise a b f =
     let na = extractFormal (fst f)
         nb = extractFormal (snd f)
-    in if (isValidBelowPreference b nb)
+    in if (isValidFormal minBelowTheLine b nb)
             then Just nb
-            else if (isValidAbovePreference a na)
+            else if (isValidFormal minAboveTheLine a na)
                     then Just (fromAboveToBelow a na)
                     else Nothing
 
@@ -98,16 +95,9 @@ extractFormal p =
 
 
 
-isValidAbovePreference :: Typ.AboveLineBallot -> Preferences -> Bool
-isValidAbovePreference a p =
-    (((length a) < minAboveTheLine) && ((length a) == (length p))) || ((length p) >= minAboveTheLine)
-
-
-
-
-isValidBelowPreference :: Typ.BelowLineBallot -> Preferences -> Bool
-isValidBelowPreference b p =
-    (((length b) < minBelowTheLine) && ((length b) == (length p))) || ((length p) >= minBelowTheLine)
+isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool
+isValidFormal minLimit ballot pref =
+    (length pref >= minLimit) || (length pref == length ballot)
 
 
 
@@ -163,5 +153,16 @@ weirdRank = do
 
 
 --  these ranks are standins that will be filtered out
-nullRank = return "-1"
+nullRank = return "0"
+
+
+
+
+--  utility functions
+fromJusts :: [Maybe a] -> [a]
+fromJusts = (map Maybe.fromJust) . (filter Maybe.isJust)
+
+
+fromRights :: [Either a b] -> [b]
+fromRights = Either.rights . (filter Either.isRight)