diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2017-01-28 21:36:53 +1100 |
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2017-01-28 21:36:53 +1100 |
| commit | 30c8ac408cba49ca4f223252cd1cd3d68ce6ca00 (patch) | |
| tree | d41120fb2f45507b1253b62188b7b8b719ae4c49 /src/Criteria.hs | |
| parent | 1f62e6f242eb4e9c08793e33b80c64475b3917ec (diff) | |
Moved old but still interesting code
Diffstat (limited to 'src/Criteria.hs')
| -rw-r--r-- | src/Criteria.hs | 93 |
1 files changed, 0 insertions, 93 deletions
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) - - |