module VotesUtil where import System.Directory import Control.Monad (filterM) import Data.List (sort) import Text.XML.HaXml import Text.XML.HaXml.Posn import Text.XML.HaXml.Types import XmlUtil import System.Posix.Files (fileExist) votesDir = "votes" parsedVotesDir = "parsedVotes" interestDir = "interests" data InterestVote = InterestVote {intGroup, voteName, yesOrNo :: String, rollCall :: Int, url :: String} instance Read InterestVote where readsPrec d s = [(parseInterestVoteFromList (split s '|'), "")] type Legislator = String data LegisInfo = LegisInfo {name, legId, party, state :: String } instance Show LegisInfo where show li = name li ++ ":" ++ legId li ++ ":" ++ party li ++ ":" ++ state li instance Read LegisInfo where readsPrec d s = [(parseLegisInfoFromList (split s ':'), "")] data VoteIndex = VoteIndex {year, voteNum :: Int} instance Show VoteIndex where show vi = "VoteIndex: year " ++ (show $ year vi) ++ ", voteNum " ++ (show $ voteNum vi) data Vote = Yes | No | Present | NotVoting | Unknown deriving (Enum, Eq) instance Show Vote where show = voteToStr instance Read Vote where readsPrec d s = [(strToVote s, "")] data Bill = Bill {billName, title :: String, voteType :: String, dateTime :: String, num :: Int} instance Show Bill where show b = show (num b) ++ "\n" ++ billName b ++ "\n" ++ title b ++ "\n" ++ voteType b ++ "\n" ++ dateTime b -- show b = "Bill: number " ++ (show (num b)) ++ ", name " ++ billName b ++ ", title " ++ title b ++ ", voteType " ++ voteType b ++ ", date " ++ dateTime b instance Read Bill where readsPrec d s = [(parseBillInfoFromList $ lines s, "")] parseBillInfoFromList :: [String] -> Bill parseBillInfoFromList (s0:s1:s2:s3:s4:[]) = Bill s1 s2 s3 s4 (read s0) parseBillInfoFromList _ = Bill "" "" "" "" 0 parseInterestVoteFromList :: [String] -> InterestVote parseInterestVoteFromList (s0:s1:s2:s3:s4:[]) = InterestVote s0 s1 s2 (read s3) s4 parseInterestVoteFromList _ = InterestVote "" "" "" 0 "" parseLegisVotes :: [String] -> [(Legislator, Vote)] parseLegisVotes = parseLegisVoteAccum [] parseLegisVoteAccum :: [(Legislator, Vote)] -> [String] -> [(Legislator, Vote)] parseLegisVoteAccum accum [] = accum parseLegisVoteAccum accum (s:ss) = parseLegisVoteAccum (parseLegisVoteSplit (split s ':'):accum) ss parseLegisVoteSplit :: [String] -> (Legislator, Vote) parseLegisVoteSplit (s0:s1:[]) = (s0, read s1) parseLegisVoteSplit _ = ("", Unknown) interestVotesToXML :: [InterestVote] -> String interestVotesToXML iList = "" ++ interestVoteListToXML "" iList ++ "" interestVoteListToXML :: String -> [InterestVote] -> String interestVoteListToXML accum [] = accum interestVoteListToXML accum (i:is) = interestVoteListToXML (accum ++ "" ++ intGroup i ++ "" ++ voteName i ++ "" ++ yesOrNo i ++ "" ++ show (rollCall i) ++ "" ++ url i ++ "") is parseLegisInfoFromList :: [String] -> LegisInfo parseLegisInfoFromList (s0:s1:s2:s3:[]) = LegisInfo s0 s1 s2 s3 parseLegisInfoFromList _ = LegisInfo "" "" "" "" legisInfosToXML :: [LegisInfo] -> String legisInfosToXML liList = "" ++ legisInfoListToXML "" liList ++ "" legisInfoListToXML :: String -> [LegisInfo] -> String legisInfoListToXML accum [] = accum legisInfoListToXML accum (li:lis) = legisInfoListToXML (accum ++ "" ++ name li ++ "" ++ legId li ++ "" ++ party li ++ "" ++ state li ++ "") lis billsToXML :: [Bill] -> String billsToXML bList = "" ++ billListToXML "" bList ++ "" billListToXML :: String -> [Bill] -> String billListToXML accum [] = accum billListToXML accum (b:bs) = billListToXML (accum ++ "" ++ billName b ++ "" ++ title b ++ "" ++ voteType b ++ "" ++ show (num b) ++ "") bs yearsToXML :: [Int] -> String yearsToXML yList = "" ++ yearListToXML "" yList ++ "" yearListToXML :: String -> [Int] -> String yearListToXML accum [] = accum yearListToXML accum (y:ys) = yearListToXML (accum ++ "" ++ show y ++ "") ys split :: String -> Char -> [String] split [] delim = [""] split (c:cs) delim | c == delim = "" : rest | otherwise = (c : head rest) : tail rest where rest = split cs delim getBill :: Element Posn -> Bill getBill el = Bill (getStringContent el "legis-num") (getStringContent el "vote-desc") (getStringContent el "vote-question") ((getStringContent el "action-date") ++ (getStringContent el "action-time")) (read (getStringContent el "rollcall-num")) padString :: Int -> String -> String -> String padString len padder str | length(str) >= len = str | otherwise = padString len padder (padder ++ str) fileNameFromVoteIndex :: VoteIndex -> String fileNameFromVoteIndex vi = votesDir ++ "/" ++ (show $ year vi) ++ "/roll" ++ (padString 3 "0" (show $ voteNum vi)) ++ ".xml" parsedVoteFromVoteIndex :: VoteIndex -> String parsedVoteFromVoteIndex vi = parsedVotesDir ++ "/" ++ (show $ year vi) ++ "/roll" ++ (padString 3 "0" (show $ voteNum vi)) ++ ".votes.txt" parsedBillFromVoteIndex :: VoteIndex -> String parsedBillFromVoteIndex vi = parsedVotesDir ++ "/" ++ (show $ year vi) ++ "/roll" ++ (padString 3 "0" (show $ voteNum vi)) ++ ".bill.txt" legisFileNameFromYear :: Int -> String legisFileNameFromYear y = parsedVotesDir ++ "/" ++ (show y) ++ "/legisinfo.txt" interestFileNameFromYear :: Int -> String interestFileNameFromYear y = interestDir ++ "/interest" ++ (show y) ++ ".txt" strToVote :: String -> Vote strToVote "Yea" = Yes strToVote "Nay" = No strToVote "Not Voting" = NotVoting strToVote "Present" = Present strToVote _ = Unknown voteToStr :: Vote -> String voteToStr Yes = "Yea" voteToStr No = "Nay" voteToStr NotVoting = "Not Voting" voteToStr Present = "Present" voteToStr Unknown = "Unknown" -- thanks to http://therning.org/magnus/archives/228 voteYears' :: IO [FilePath] voteYears' = getDirectoryContents parsedVotesDir voteYears :: IO [Int] voteYears = do years <- voteYears' realYears <- (filterM (return . isDODD) years) return $ sort $ map toYear realYears availableYears :: IO [Int] availableYears = do years <- voteYears filterM (\x -> fileExist $ interestFileNameFromYear x) years numVotesPerYear :: Int -> IO Int numVotesPerYear year = do allFiles <- getDirectoryContents (parsedVotesDir ++ "/" ++ (show year)) realFiles <- (filterM (return . isDODD) allFiles) -- return 200 return (div (length realFiles) 2) yearsAndVotes :: IO [(Int, Int)] yearsAndVotes = do years <- voteYears yearsLen <- mapM numVotesPerYear years return (zip years yearsLen) isDODD :: FilePath -> Bool isDODD f = not $ (f == ".") || (f == "..") toYear :: FilePath -> Int toYear = read