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




data SenateCounter = SenateCounter { inputData :: FilePath
                                   , upperMap  :: Typ.UpperMap
                                   , lowerMap  :: Typ.LowerMap }




headerLines = 2
fieldsInRecord = 6
minBelowTheLine = 6




createSenateCounter :: FilePath -> Typ.UpperMap -> Typ.LowerMap -> IO (Maybe SenateCounter)
createSenateCounter f a b = do
    raw <- readFile f
    let recs = drop headerLines (lines raw)
    if (and (map isValidRecord recs))
        then return (Just (SenateCounter f a b))
        else return Nothing




--  preference data may contain odd symbols like '/' or '*' so
--  testing for that stuff is relegated to when actual counts are
--  performed, while this routine only checks that the CSV format
--  is valid and that the required number of fields are present
isValidRecord :: String -> Bool
isValidRecord record =
    case (CSV.parseRecord CSV.defaultSettings record) of
        Left _ -> False
        Right x -> length x == fieldsInRecord




doCount :: SenateCounter -> Typ.Trace -> IO Int
doCount sen tr = do
    raw <- readFile (inputData sen)
    let recs = drop headerLines (lines raw)
        parsedRecs = Either.rights (map (CSV.parseRecord CSV.defaultSettings) recs)
        prefs = Either.rights
                    (filter Either.isRight
                        (map ((parsePreferences
                                (length (upperMap sen))
                                (length (lowerMap sen))) . last)
                            parsedRecs))
        fits = filter (tester (lowerMap sen) tr) (map (normalise (upperMap sen) (lowerMap sen)) prefs)
    return (length fits)




--  tests to see if a given set of preferences matches a specified trace criteria
tester :: Typ.LowerMap -> Typ.Trace -> Typ.BelowPreferences -> 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 below-the-line
normalise :: Typ.UpperMap -> Typ.LowerMap -> Typ.FullPreferences -> Typ.BelowPreferences
normalise a b f =
    if (isValidBelowPreference b (snd f))
        then (snd f)
        else (fromAboveToBelow a (fst f))




isValidBelowPreference :: Typ.LowerMap -> Typ.BelowPreferences -> Bool
isValidBelowPreference b p =
    (((length b) < minBelowTheLine) && ((length b) == (length p))) || ((length p) >= minBelowTheLine)




fromAboveToBelow :: Typ.UpperMap -> Typ.AbovePreferences -> Typ.BelowPreferences
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 Typ.FullPreferences
parsePreferences a b input = Parsec.parse (preference a b) "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)) :: Typ.AbovePreferences
        yp = (filter ((> 0) . snd) (zip [1,2..] yr)) :: Typ.BelowPreferences
    return (xp,yp)


rank = do
    n <- Parsec.choice [normalRank, weirdRank, nullRank]
    Parsec.char ','
    return n


normalRank = do
    n <- Parsec.oneOf "123456789"
    ns <- Parsec.many Parsec.digit
    return (n:ns)


--  currently assuming that these symbols always mean '1'
weirdRank = do
    Parsec.choice [Parsec.char '/', Parsec.char '*']
    return "1"


nullRank = return "-1"