split cost out into its own module
Added a function to insert a new cost into a list, which could be used to asjust costs after a drag and drop.
This commit is contained in:
parent
672fb29b06
commit
19c0a0d5b1
18 changed files with 103 additions and 37 deletions
79
Config/Cost.hs
Normal file
79
Config/Cost.hs
Normal file
|
@ -0,0 +1,79 @@
|
|||
{- Remote costs.
|
||||
-
|
||||
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Config.Cost where
|
||||
|
||||
{- We use a float for a cost to ensure that there is a cost in
|
||||
- between any two other costs. -}
|
||||
type Cost = Float
|
||||
|
||||
{- Some predefined default costs.
|
||||
- Users setting costs in config files can be aware of these,
|
||||
- and pick values relative to them. So don't change. -}
|
||||
cheapRemoteCost :: Cost
|
||||
cheapRemoteCost = 100
|
||||
nearlyCheapRemoteCost :: Cost
|
||||
nearlyCheapRemoteCost = 110
|
||||
semiExpensiveRemoteCost :: Cost
|
||||
semiExpensiveRemoteCost = 175
|
||||
expensiveRemoteCost :: Cost
|
||||
expensiveRemoteCost = 200
|
||||
veryExpensiveRemoteCost :: Cost
|
||||
veryExpensiveRemoteCost = 1000
|
||||
|
||||
{- Adjusts a remote's cost to reflect it being encrypted. -}
|
||||
encryptedRemoteCostAdj :: Cost
|
||||
encryptedRemoteCostAdj = 50
|
||||
|
||||
{- Given an ordered list of costs, and the position of one of the items
|
||||
- the list, inserts a new cost into the list, in between the item
|
||||
- and the item after it.
|
||||
-
|
||||
- If both items have the same cost, one of them will have its cost
|
||||
- adjusted to make room. The costs of other items in the list are left
|
||||
- unchanged.
|
||||
-
|
||||
- To insert the new cost before any other in the list, specify a negative
|
||||
- position. To insert the new cost at the end of the list, specify a
|
||||
- position longer than the list.
|
||||
-}
|
||||
insertCostAfter :: [Cost] -> Int -> [Cost]
|
||||
insertCostAfter [] _ = error "insertCostAfter: empty list"
|
||||
insertCostAfter l pos
|
||||
| pos < 0 = costBetween 0 (l !! 0) : l
|
||||
| nextpos > maxpos = l ++ [1 + l !! maxpos]
|
||||
| item == nextitem =
|
||||
let (_dup:new:l') = insertCostAfter lastsegment 0
|
||||
in firstsegment ++ [costBetween item new, new] ++ l'
|
||||
| otherwise =
|
||||
firstsegment ++ [costBetween item nextitem ] ++ lastsegment
|
||||
where
|
||||
nextpos = pos + 1
|
||||
maxpos = length l - 1
|
||||
|
||||
item = l !! pos
|
||||
nextitem = l !! nextpos
|
||||
|
||||
(firstsegment, lastsegment) = splitAt (pos + 1) l
|
||||
|
||||
costBetween :: Cost -> Cost -> Cost
|
||||
costBetween x y
|
||||
| x == y = x
|
||||
| x > y = y + (x - y) / 2
|
||||
| otherwise = costBetween y x
|
||||
|
||||
{- Make sure the remote cost numbers work out. -}
|
||||
prop_cost_sane :: Bool
|
||||
prop_cost_sane = False `notElem`
|
||||
[ expensiveRemoteCost > 0
|
||||
, cheapRemoteCost < nearlyCheapRemoteCost
|
||||
, nearlyCheapRemoteCost < semiExpensiveRemoteCost
|
||||
, semiExpensiveRemoteCost < expensiveRemoteCost
|
||||
, cheapRemoteCost + encryptedRemoteCostAdj > nearlyCheapRemoteCost
|
||||
, nearlyCheapRemoteCost + encryptedRemoteCostAdj < semiExpensiveRemoteCost
|
||||
, nearlyCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
|
||||
]
|
Loading…
Add table
Add a link
Reference in a new issue