blob: 2c0504d5d3603ddcccfa73828dc01504e477957c (
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
|
module Storage(
Store,
createStore,
setPref,
setPrefs,
getPrefs,
checkPref
) where
-- This source is licensed under Creative Commons CC0 v1.0.
-- To read the full text, see license.txt in the main directory of this repository
-- or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt
-- For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/
import Data.Int ( Int8 )
import Preferences ( Preference )
import qualified Data.Vector.Unboxed.Mutable as Vec
data Store = Store
{ getPointer :: Vec.IOVector Int8
, getBallotSize :: Int }
createStore :: Int -> Int -> IO Store
createStore maxCapacity ballotSize = do
v <- Vec.replicate (maxCapacity * ballotSize) 0
return (Store
{ getPointer = v
, getBallotSize = ballotSize })
setPref :: Store -> Int -> Preference -> IO ()
setPref prefStore ballot (position,rank) = do
let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1)
Vec.write (getPointer prefStore) place (fromIntegral rank)
setPrefs :: Store -> Int -> [Preference] -> IO ()
setPrefs prefStore ballot prefList = do
let blank = take (getBallotSize prefStore) (zip [1..] (cycle [0]))
mapM_ (setPref prefStore ballot) blank
mapM_ (setPref prefStore ballot) prefList
getPrefs :: Store -> Int -> IO [Preference]
getPrefs prefStore ballot = do
let startPlace = (ballot - 1) * (getBallotSize prefStore)
endPlace = startPlace + (getBallotSize prefStore) - 1
base = [startPlace .. endPlace]
r0 <- mapM (Vec.read (getPointer prefStore)) base
let r1 = zip [1..] (map fromIntegral r0)
return (filter ((/= 0) . snd) r1)
checkPref :: Store -> Int -> Preference -> IO Bool
checkPref prefStore ballot (position,rank) = do
let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1)
value <- Vec.read (getPointer prefStore) place
return (value == fromIntegral rank)
|
