Check the courses remaining in a university degree.

DegreeSolver.hs

-- Copyright (C) 2012 by Maxwell Swadling
-- 
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
-- 
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
-- 
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.

-- Usage: runhaskell DegreeSolver.hs program.data completed.data
-- What this is: A fancy *spreadsheet* for you to check what you haven't done.
-- What this doesn't do: Program changes, exceptions, waivers, etc.

-- Example program.data:
-- This defines a program. To define a program to have:
-- - must completed COMP0001
-- - any 12 units of electives
-- - either MATH101 or MATH102.
-- [Req 6 "COMP101", Either 6 "MATH101" "MATH102", Any 12 "ELECTIVE"]

-- Example completed.data:
-- This defines the courses completed so far.
-- - C is for Core courses (Req or Either)
-- - X is for Elective courses (Any)
-- To say you have done MATH102 and 6 units of electives use:
-- [C "MATH102", X "FUN101" "ELECTIVE"]

-- Output:
-- The program will tell you:
-- - You haven't completed COMP101
-- - You completed the MATH102 option
-- - You have done 6/12 units of your electives
-- - If you have done a course that doesn't count

import qualified Data.Map as M
import Data.List
import Data.Maybe
import System.Environment

type Program = [Requirement]
data Requirement =    Req Int String
                    | Either Int String String
                    | Any Int String
                    deriving (Show, Read, Eq)

data Course = C String | X String String deriving (Show, Read, Eq)

-- courseStatus program completed_so_far
courseStatus p c = mapAccumL (\acc x -> satisfies p (acc, x)) (emptyAcc p) c

emptyAcc c = M.fromList $ map (\(Any i s) -> (s, i)) $ filter multiunit c

-- only Any is multiunit
multiunit (Any _ _) = True
multiunit _ = False

satisfies :: [Requirement] -> ((M.Map String Int), Course) -> ((M.Map String Int), (Course, Maybe Requirement))
satisfies reqs (s, c@(C name))     = (s, (c, find (fits name) reqs))
satisfies reqs (s, c@(X name typ)) = let  t     = fromJust $ M.lookup typ s
                                          new_t = t - course_val
                                          course_val = 6 -- default
                                          req = find (fits typ) reqs -- use typ instead of name
                                          new_s = M.insert typ new_t s
                                      
                                     in (new_s, (c, req))

fits :: String -> Requirement -> Bool
fits s (Req _ n)        = s == n
fits s (Either _ n1 n2) = n1 == s || n2 == s
fits s (Any _ n)        = s == n

nameOf (C n)   = n
nameOf (X n _) = n

main = do
  args <- getArgs
  if length args == 2 then
    checkStatus (args !! 0) (args !! 1)
  else
    putStrLn "Usage: runhaskell DegreeSolver.hs program.data completed.data"

checkStatus f1 f2 = do
  programFile   <- readFile f1
  completedFile <- readFile f2
  let reqs      = read programFile
  let completed = read completedFile
  
  let core = filter (\x -> not (multiunit x)) reqs
  let (elecs, courses) = courseStatus reqs completed
  let completedCourses = map (fromJust . snd) $ filter (\(_, x) -> not (isNothing x)) courses
  let duplicatedCourses = (length completed) - (length (nub completed))
  let uncountedCourses = filter (\(c, s) -> isNothing s) courses
  
  if not (null uncountedCourses) then do
    putStrLn "Warning: Uncounted Courses! A course that is not Core has been marked as so."
    putStrLn $ show $ uncountedCourses
    putStrLn ""
  else
    return ()
  
  if duplicatedCourses /= 0 then do
    putStrLn "Warning: Repeated Courses! Probably an error in the completed file."
    putStrLn $ "Duplicated Courses: " ++ (show duplicatedCourses)
    putStrLn ""
  else
    return ()
  
  putStrLn "Incomplete Core Courses:"
  putStrLn $ show $ filter (\r -> r `notElem` completedCourses) core
  putStrLn ""
  
  putStrLn "Units Remaining in Electives:"
  putStrLn $ unlines $ map (\(k, v) -> k ++ ":  \t" ++ show v) (M.toList elecs)
  
  putStrLn "Completed Courses:"
  putStrLn $ unlines $ map show courses