module Senate(
    SenateCounter,
    createSenateCounter,
    doCount
    ) where




import qualified SenateTypes as Typ
import qualified CSV as CSV
import qualified Text.ParserCombinators.Parsec as Parsec
import qualified Data.Either as Either
import qualified Data.Maybe as Maybe
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 }




headerLines = 2
fieldsInRecord = 6
minAboveTheLine = 1
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)




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




--  converts a set of above+below-the-line preferences to just formal below-the-line
normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe Preferences
normalise a b f =
    let na = extractFormal (fst f)
        nb = extractFormal (snd f)
    in if (isValidBelowPreference b nb)
            then Just nb
            else if (isValidAbovePreference a na)
                    then Just (fromAboveToBelow a na)
                    else Nothing




extractFormal :: Preferences -> Preferences
extractFormal p =
    let funcTail n r p =
            let (matches,rest) = List.partition ((== n) . snd) p
            in if (p == [] || (length matches) /= 1)
                then r
                else funcTail (n + 1) ((head matches):r) rest
    in funcTail 1 [] 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)




fromAboveToBelow :: Typ.AboveLineBallot -> Preferences -> Preferences
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 "-1"