module Criteria( Criteria, CTest, evaluate, matchID, matchFromList, many ) where -- this is a preference criteria checking method modeled after parsec -- it looks nice, and it *does* work, but unfortunately it's far too slow import qualified Control.Monad as Con import qualified Data.List as List import qualified Data.Either.Unwrap as Either import qualified Candidate as Typ import qualified Preferences as Pref type Criteria = [CTest] type CTest = CList -> Either CError CList type CList = [Typ.CandidateID] type CError = String evaluate :: Typ.BelowLineBallot -> [Pref.Preference] -> Criteria -> Bool evaluate ballot preferences criteria = let clist = prefsToCList ballot preferences parsed = Con.foldM (flip id) clist criteria result = Either.isRight parsed in if (isValidInput ballot preferences) then result else False isValidInput :: Typ.BelowLineBallot -> [Pref.Preference] -> Bool isValidInput ballot preferences = all (\(x,y) -> x > 0 && x <= length ballot && y > 0 && y <= length ballot) preferences prefsToCList :: Typ.BelowLineBallot -> [Pref.Preference] -> CList prefsToCList ballot preferences = let t0 = map (\(x,y) -> (ballot !! (x - 1), y)) preferences t1 = List.sortBy (\x y -> compare (snd x) (snd y)) t0 in map fst t1 matchID :: Typ.CandidateID -> CTest matchID candID = (\x -> let r = (head x == candID) in if (length x == 0 || not r) then Left "Couldn't match candidate" else Right (tail x)) matchFromList :: [Typ.CandidateID] -> CTest matchFromList candList = (\x -> let r = (head x) `elem` candList in if (length x == 0 || not r) then Left "Couldn't match candidate" else Right (tail x)) many :: CTest -> CTest many ct = (\x -> let r = ct x in if (Either.isRight r) then many ct (Either.fromRight r) else Right x)