ranked

Building ranked: a Session in Test-Driven Haskell

The idea: keep a file of URLs with user-assigned appreciation scores, pick one proportionally to its score, open it, and let the user adjust the score afterwards.

The seed

A skeletal Cabal project with a skeletal data type:

data D = D String Integer
main = putStrLn "Hello, Haskell!"

The counter is an appreciation score — not a visit count, but a weight the user sets and adjusts. Negative scores mean you want to see a link less often.

The core: proportional selection

The heart of the tool is cycle. Given a list of (url, score) pairs, pick one with probability proportional to its score, return the URL and the list with the chosen line moved to the bottom.

We started with tests:

testCycleSingle = TestCase $ do
  let ls = [Line "a.com" 5]
  (url, ls') <- cycle ls
  assertEqual "single line returns its URL" "a.com" url
  assertEqual "single line list unchanged" ls ls'

testCycleSelectedMovedToBottom = TestCase $ do
  let ls = [Line "a.com" 5, Line "b.com" 3, Line "c.com" 1]
  (url, ls') <- cycle ls
  assertBool "selected url is one of the input urls"
    (url `elem` map (\(Line u _) -> u) ls)
  assertEqual "list length preserved" (length ls) (length ls')
  assertEqual "selected line moved to bottom" url (let (Line u _) = last ls' in u)

The first implementation was a stub — return ("", ls). Every test failed. Then the real weighted selection:

cycle :: [Line] -> IO (String, [Line])
cycle ls = do
  if null ls
    then return ("", ls)
    else do
      let raw = map (\(Line _ n) -> n) ls
          shift = if minimum raw < 0 then -(minimum raw) + 1 else 0
          weights = map (\n -> n + shift) raw
          total  = sum weights
      pick <- randomRIO (0, total - 1)
      let idx = select weights pick
          (Line url _) = ls !! idx
          moved = take idx ls ++ drop (idx + 1) ls ++ [ls !! idx]
      return (url, moved)

The weighted selection is a linear scan through cumulative weights:

select :: [Integer] -> Integer -> Int
select (w:ws) n
  | n < w     = 0
  | otherwise = 1 + select ws (n - w)
select []     _ = 0

Negative scores

We explicitly support negative scores. A URL with -5 should still be selectable, just less likely than one with 5. The initial attempt used max 0 to clamp negatives, which made them completely impassable — violating the spec. The fix: shift all weights so the minimum becomes 1.

shift = if minimum raw < 0 then -(minimum raw) + 1 else 0
weights = map (\n -> n + shift) raw

Now even the most downvoted link has a non-zero chance.

up and down: the user adjusts scores

After cycle picks and opens a URL, the user runs the tool again with -u (upvote) or -d (downvote) to adjust that entry’s score. The tool moves it back into rotation at its new weight.

These are pure functions on the last element — the one cycle just placed at the bottom:

up :: [Line] -> [Line]
up []     = []
up ls     = init ls ++ [bump (+1) (last ls)]

down :: [Line] -> [Line]
down []   = []
down ls   = init ls ++ [bump (+(-1)) (last ls)]

bump :: (Integer -> Integer) -> Line -> Line
bump f (Line url n) = Line url (f n)

The workflow: ranked links.txt → picks and opens a URL → ranked -u links.txt to increase its weight → ranked -d links.txt to decrease it.

Parsing, serialisation, CLI flags

We wrote a ReadP parser that splits each line on the last comma (URLs can contain commas), HUnit tests for roundtrip properties, and later migrated from getArgs to optparse-applicative for declarative flags, --help, and mutual exclusion between -u and -d. Those parts are routine — the project structure tells the story:

ranked/
├── app/Main.hs              # CLI entry point
├── src/
│   ├── Ranked.hs            # Line type, parser, serializer
│   └── Ranked/Cycle.hs      # cycle, up, down, weighted selection
├── tests/Test.hs            # 24 HUnit tests
├── manual/
│   ├── cli.sh               # integration tests
│   └── coverage.sh           # HPC coverage report
└── ranked.cabal

24 unit tests, 7 integration tests, ~88% expression coverage under GHC’s HPC. The whole thing is a single afternoon — test-first, documentation-last.