From 30c8ac408cba49ca4f223252cd1cd3d68ce6ca00 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 28 Jan 2017 21:36:53 +1100 Subject: Moved old but still interesting code --- src/Criteria.hs | 93 --------------------------------------------------------- 1 file changed, 93 deletions(-) delete mode 100644 src/Criteria.hs (limited to 'src') diff --git a/src/Criteria.hs b/src/Criteria.hs deleted file mode 100644 index 8ca19c8..0000000 --- a/src/Criteria.hs +++ /dev/null @@ -1,93 +0,0 @@ -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) - - -- cgit