mpri.hs

-- File under license CC-0

-- How to use:
-- 1) Save all course pages with grades from MPRI pedagogical server
-- 2) The path name to all courses for 3 ECTS must contain Court
-- while others are considered counting for 6 ECTS
-- 3) Call this script passing all the files as arguments. For instance like this:
-- runhaskell mpri.hs Courts/* Longs/*

-- This is program probably has lots of programming flaws
-- but won't be improved as it is good enough for the purpose.

import System.Environment
import System.IO
import Data.List
import Data.Maybe
import Data.Function
import Control.Monad

extractName = takeWhile (/= '&') . drop 1 . dropWhile (/= '>') . dropWhile (/= '?')
extractGrade = takeWhile (/= '<') . drop 1 . dropWhile (/= '>')

nextStudent offset stream = (extractName $ head stream, extractGrade $ head remaining, drop 1 remaining) where
    remaining = drop offset stream

allStudents :: Int -> [String] -> [(String, Float)]
allStudents offset stream =
    case drop 1 $ dropWhile (not . isInfixOf "<tr>") stream of
        [] -> []
        l -> if grade /= "" then (name, read grade) : grades else grades where
            (name, grade, remaining) = nextStudent offset l
            grades = allStudents offset remaining

oneClass filename = do
    file <- openFile filename ReadMode
    hSetEncoding file latin1
    content <- hGetContents file
    let stream1 = dropWhile (not . isInfixOf "<th align=left>Nom, Prenom&nbsp;&nbsp;</th>") $ lines content
    let (before, stream2) = break (isInfixOf "<th>Session 1&nbsp;&nbsp;</th>") stream1
    let offset = length before
    let stream3 = takeWhile (not . isInfixOf "</table>") stream2
    let grades = map (\(name, grade) -> (name, (grade, 1))) $ allStudents offset stream3
    return $ if "Court" `isInfixOf` filename then grades else grades ++ grades

computeAverage :: [(Float, Float)] -> Maybe Float
computeAverage grades = (listToMaybe . reverse) acceptableAverages >>= (\(g, c) -> return $ g/c) where
    acceptableAverages = filter (\(_, c) -> c >= 8 && c <= 10) averages
    averages = map (\x -> let (gs, cs) = unzip x in (sum gs, sum cs)) $ inits grades

mergeStudent ((name, grade1) : grades) = (computeAverage sorted, name) where
    sorted = reverse $ sort unsorted
    unsorted = grade1 : map snd grades

printLine ((Nothing, name), _) = putStrLn $ "Not ranked: " ++ name
printLine ((Just grade, name), rank) = putStrLn $ show rank ++ ".\t" ++ take 18 (name ++ repeat ' ') ++ "\tGrade: " ++ show grade

main = do
    args <- getArgs
    grades <- mapM oneClass args
    let merge = reverse . sort . map mergeStudent . groupBy ((==) `on` fst) . sort $ concat grades
    mapM_ printLine $ zip merge [1..]