module ParseVoteRecord where import System.IO import Network.CGI import Text.XML.HaXml import Text.XML.HaXml.Posn import Text.XML.HaXml.Types import Control.Monad (filterM) import XmlUtil import VotesUtil import Text.XML.HaXml.Pretty (document, element) import Control.Monad.Trans (lift) import Control.Monad (liftM) import Data.Map (Map, empty, adjustWithKey, member, insert, foldWithKey) parseResults :: String -> String -> String -- parseResults fileName testStr = firstElementStr (makeDocument fileName testStr) --parseResults fileName testStr = friendlyString (findElement "congress" (firstElement (makeDocument fileName testStr))) --parseResults fileName testStr = foldr1 (\x y -> x ++ "\n" ++ y) (listLegislators (firstElement (makeDocument fileName testStr))) -- parseResults fileName testStr = show (listLegislatorsAndVotes (firstElement (makeDocument fileName testStr))) -- parseResults fileName testStr = show $ getLegislatorVote "Cummings" (firstElement (makeDocument fileName testStr)) parseResults fileName testStr = show (getBill (firstElement (makeDocument fileName testStr))) getLegisInfo :: Int -> IO [LegisInfo] --getLegisInfo year = map (\v -> read v) (lines (readFile $ legisFileNameFromYear year)) getLegisInfo year = do fileContents <- readFile $ legisFileNameFromYear year return $ map (\v -> read v) (lines fileContents) getInterestInfo :: Int -> IO [InterestVote] getInterestInfo year = do fileContents <- readFile $ interestFileNameFromYear year return $ map (\v -> read v) (lines fileContents) legislatorScores :: Int -> [(Int, Bool, Int)] -> IO (Map Legislator (Int, Int)) legislatorScores year voteTests = legislatorScoresAccum empty year voteTests legislatorScoresToXML :: Map Legislator (Int, Int) -> String legislatorScoresToXML legMap = "" ++ (foldWithKey (\ key (matches, total) accum -> ("" ++ key ++ "" ++ (show matches) ++ "" ++ (show total) ++ "" ++ accum)) "" legMap) ++ "" legislatorScoresAccum :: (Map Legislator (Int, Int)) -> Int -> [(Int, Bool, Int)] -> IO (Map Legislator (Int, Int)) legislatorScoresAccum accum year [] = return accum legislatorScoresAccum accum year ((v1,b1,w1):vbs) = do fileContents <- readFile $ parsedVoteFromVoteIndex (VoteIndex year v1) legislatorScoresAccum (updateLegislatorScoresAccum accum b1 w1 (parseLegisVotes $ lines $ fileContents)) year vbs updateLegislatorScoresAccum :: Map Legislator (Int, Int) -> Bool -> Int -> [(Legislator, Vote)] -> Map Legislator (Int, Int) updateLegislatorScoresAccum result _ _ [] = result updateLegislatorScoresAccum result b w ((leg,vote):lv) = updateLegislatorScoresAccum (updateLegisScoresMap result (leg,vote) b w) b w lv updateLegisScoresMap :: (Map Legislator (Int, Int)) -> (Legislator, Vote) -> Bool -> Int -> (Map Legislator (Int, Int)) updateLegisScoresMap map (leg, vote) bool weight = case isComparable of False -> map True -> if (member leg map) then adjustWithKey (\ key (matches, total) -> if (isMatch) then (matches + weight, total + weight) else (matches, total + weight)) leg map else insert leg (if isMatch then (weight, weight) else (0, weight)) map where isComparable = (vote == Yes || vote == No) isMatch = ((vote == Yes && bool == True) || (vote == No && bool == False)) getBillFilenamesFromYearsVotes :: Int -> [(Int,Int)] -> [String] getBillFilenamesFromYearsVotes _ [] = [] getBillFilenamesFromYearsVotes year ((y1,v1):yvs) | year == y1 = map (\v -> parsedBillFromVoteIndex (VoteIndex y1 v)) [1..v1] | otherwise = getBillFilenamesFromYearsVotes year yvs getAllBills :: Int -> IO [Bill] getAllBills year = do yAndV <- yearsAndVotes fs <- mapM (\fn -> readFile fn) (getBillFilenamesFromYearsVotes year yAndV) return (map (\str -> read str) fs) --getAllBillsVoteTypes :: Int -> IO () getAllBillsVoteTypes :: Int -> IO [((String,Int),Int)] getAllBillsVoteTypes year = do bills <- getAllBills year -- putStrLn (show (map Text.XML.HaXml.Pretty.element elems)) return (foldl (\oldl arg -> combineNoDuplicates oldl ((voteType arg), (num arg))) [] bills) -- TODO combineNoDuplicates :: (Eq a, Num c) => [((a,b),c)] -> (a,b) -> [((a,b),c)] combineNoDuplicates [] arg = [(arg,1)] --combineNoDuplicates l arg = ((arg,1):l) -- TODO combineNoDuplicates (((a1,b1),n1):as) i2@(a2,b2) | a1 == a2 = (((a1,b1),n1+1):as) | otherwise = (((a1,b1),n1):(combineNoDuplicates as i2)) --getAllBills :: Int -> IO [Bill] --getAllBills year = (mapM (\fs -> (getBill (getElemFromString "fake.txt" fs))) (getAllBillsFiles year)) --do yAndV <- yearsAndVotes --(y, maxVote) <- filterM (\ (y,_) -> (y == year)) yAndV --names <- mapM (\v -> VoteIndex year v) [1..maxVote] -- fileStrs <- mapM (\fn -> readFile fn) (getFilenamesFromYearsVotes year yAndV) -- files <- mapM (\fs -> getBill (getElemFromString "fake.txt" fs)) fileStrs -- return (mapM (\fs -> getBill (getElemFromString "fake.txt" fs)) fileStrs) getLegislatorVote :: Legislator -> Element Posn -> Vote getLegislatorVote leg el = snd $ head (filter (\(a,_) -> (a == leg)) (listLegislatorsAndVotes el)) listLegislators :: Element Posn -> [Legislator] listLegislators el = map getLegislatorFromElem (getAllTags "legislator" el) listLegislatorsAndVotes :: Element Posn -> [(Legislator, Vote)] listLegislatorsAndVotes el = map getLegislatorAndVoteFromElem (getAllTags "recorded-vote" el) getVoteFromElem :: Element Posn -> Vote getVoteFromElem el = strToVote (getContentFromElem el) getLegislatorFromElem :: Element Posn -> Legislator getLegislatorFromElem = getContentFromElem getLegislatorAndVoteFromElem :: Element Posn -> (Legislator, Vote) getLegislatorAndVoteFromElem el = (maybe "" getLegislatorFromElem (findElement "legislator" el), (maybe Unknown (\x -> strToVote (getContentFromElem x)) (findElement "vote" el))) --main = do types <- getAllBillsVoteTypes 2007 -- putStrLn (show types) --main = do yAndV <- yearsAndVotes -- putStrLn (show yAndV) --years <- voteYears -- yearsLen <- mapM numVotesPerYear years -- putStrLn (show (zip years yearsLen)) --main = do testStr <- readFile fileName -- putStrLn (parseResults fileName testStr) -- where fileName = fileNameFromVoteIndex (VoteIndex 2007 143)