1 files changed, 117 insertions, 0 deletions
diff --git a/src/Preferences.hs b/src/Preferences.hs
new file mode 100644
index 0000000..7a67e63
--- /dev/null
+++ b/src/Preferences.hs
@@ -0,0 +1,117 @@
+module Preferences(
+    Preference,
+    FullPreferences,
+
+    normalise,
+    parsePreferences
+    ) where
+
+
+
+
+import qualified SenateTypes as Typ
+import qualified Text.ParserCombinators.Parsec as Parsec
+import qualified Data.List as List
+
+
+
+
+type Preference = (Typ.Position,Typ.Ranking)
+type FullPreferences = ([Preference],[Preference])
+
+
+
+
+minAboveTheLine = 1
+minBelowTheLine = 6
+
+
+
+
+--  converts a set of above+below-the-line preferences to just formal below-the-line
+normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe [Preference]
+normalise a b f =
+    let na = extractFormal (fst f)
+        nb = extractFormal (snd f)
+    in if (isValidFormal minBelowTheLine b nb)
+            then Just nb
+            else if (isValidFormal minAboveTheLine a na)
+                    then Just (fromAboveToBelow a na)
+                    else Nothing
+
+
+
+
+extractFormal :: [Preference] -> [Preference]
+extractFormal pref =
+    let formTail n r p =
+            let (matches,rest) = List.partition ((== n) . snd) p
+            in if (p == [] || (length matches) /= 1)
+                then r
+                else formTail (n + 1) ((head matches):r) rest
+    in formTail 1 [] pref
+
+
+
+
+isValidFormal :: Foldable t => Int -> t a -> [Preference] -> Bool
+isValidFormal minLimit ballot pref =
+    (length pref >= minLimit) || (length pref == length ballot)
+
+
+
+
+--  inefficient?
+fromAboveToBelow :: Typ.AboveLineBallot -> [Preference] -> [Preference]
+fromAboveToBelow a p =
+    let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p
+        tailFunc n bp ap =
+            if (ap == [])
+                then bp
+                else let place = fst (head ap)
+                         newPrefs = zip (a !! (place - 1)) [n, n+1 ..]
+                     in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap)
+    in tailFunc 1 [] sortedByRanking
+
+
+
+
+--  the two int arguments are the number of boxes above the line and the number
+--  of boxes below the line respectively
+parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences
+parsePreferences aboveBoxes belowBoxes input =
+    Parsec.parse (preference aboveBoxes belowBoxes) "error" input
+
+
+preference a b = do
+    x <- Parsec.count a rank
+    y <- Parsec.count b rank
+    Parsec.eof
+    let xr = map (read :: String -> Typ.Ranking) x
+        yr = map (read :: String -> Typ.Ranking) y
+        xp = (filter ((> 0) . snd) (zip [1,2..] xr))
+        yp = (filter ((> 0) . snd) (zip [1,2..] yr))
+    return (xp,yp)
+
+
+rank = do
+    n <- Parsec.choice [normalRank, weirdRank, nullRank]
+    Parsec.choice [Parsec.char ',' >> return (), Parsec.eof]
+    return n
+
+
+normalRank = do
+    n <- Parsec.oneOf "123456789"
+    ns <- Parsec.many Parsec.digit
+    return (n:ns)
+
+
+--  these symbols are taken to mean '1' according to AEC guidelines
+weirdRank = do
+    Parsec.choice [Parsec.char '/', Parsec.char '*']
+    return "1"
+
+
+--  these ranks are standins that will be filtered out
+nullRank = return "0"
+