summaryrefslogtreecommitdiff
path: root/old
diff options
context:
space:
mode:
Diffstat (limited to 'old')
-rw-r--r--old/Criteria.hs93
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)
+
+