module Senate(
    SenateCounter,
    createSenateCounter,
    doCount
    ) where




import qualified SenateTypes as Typ
import qualified CSV as CSV
import qualified Storage as Vec
import qualified System.IO as IO
import qualified Control.Monad as Con
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   :: Vec.Store
                                   , ballotMap  :: Typ.BelowLineBallot
                                   , numBallots :: Int }




minAboveTheLine = 1
minBelowTheLine = 6




createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
createSenateCounter f a b = do
    --
    numLines <- countLines f
    arrayData <- Vec.createStore numLines (length b)
    --
    h <- IO.openFile f IO.ReadMode
    let readFunc n p h = if (n > numLines) then return p else do
            t0 <- IO.hGetLine h
            let t1 = CSV.parseRecord CSV.defaultSettings t0
                t2 = last (head (Either.rights [t1]))
                t3 = parsePreferences (length a) (length b) t2
                t4 = normalise a b (head (Either.rights [t3]))
                t5 = Maybe.fromJust t4
            if (Either.isRight t1) && (Either.isRight t3) && (Maybe.isJust t4)
                then (mapM_ (uncurry (Vec.setPref arrayData n)) t5) >> (readFunc (n + 1) (p + 1) h)
                else readFunc (n + 1) p h
    p <- readFunc 1 0 h
    IO.hClose h
    --
    return (SenateCounter arrayData b p)




countLines :: FilePath -> IO Int
countLines f = do
    let tailFunc x h = do
            t <- IO.hGetLine h
            e <- IO.hIsEOF h
            if e then (IO.hClose h >> return (x + 1)) else tailFunc (x + 1) h
    h <- IO.openFile f IO.ReadMode
    e <- IO.hIsEOF h
    if e then (IO.hClose h >> return 0) else tailFunc 0 h




doCount :: SenateCounter -> Typ.Criteria -> IO Int
doCount sen crit = do
    --
    let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit
    --
    let critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r)
        neededPrefs = map critToPref crit
        checkFunc n r = if (n > (numBallots sen)) then return r else do
            t <- Con.liftM and (mapM (uncurry (Vec.checkPref (prefData sen) n)) neededPrefs)
            if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r
    --
    if isValidCriteria
        then checkFunc 1 0
        else return 0




--  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 (isValidFormal minBelowTheLine b nb)
            then Just nb
            else if (isValidFormal minAboveTheLine 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




isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool
isValidFormal minLimit ballot pref =
    (length pref >= minLimit) || (length pref == length ballot)




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 "0"