module Preferences(
    Preference,
    FullPreferences,

    normalise,
    parsePreferences
    ) where




--  This source is licensed under Creative Commons CC0 v1.0.

--  To read the full text, see license.txt in the main directory of this repository
--  or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt

--  For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/




import qualified Candidate 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"