diff options
Diffstat (limited to 'old')
-rw-r--r-- | old/Criteria.hs | 93 |
1 files changed, 93 insertions, 0 deletions
diff --git a/old/Criteria.hs b/old/Criteria.hs new file mode 100644 index 0000000..8ca19c8 --- /dev/null +++ b/old/Criteria.hs @@ -0,0 +1,93 @@ +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) + + |