summaryrefslogtreecommitdiff
path: root/old/Criteria.hs
blob: 8ca19c8c3e724578dad54d52f7ac34932ea5e8aa (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
88
89
90
91
92
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)