blob: 7f46970cb856d538828176a96ebc8b32c25c15ae (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
module Criteria(
Criteria,
CTest,
evaluate,
matchID,
matchFromList,
many
) where
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)
|
