Choosing a secret santa with "discouraged" pairings

secret_santa.hs

import Data.List (delete, permutations, intercalate)
import System.Random

type Person = String
type SantaSuggestion = [(Person, Person)]

people :: [Person]
people = ["Chris", "Sarah", "Matt", "Jimmy", "Colin", "Kelsey", "Peter"]

-- main function chooses from the lowest-scoring (least bad)
-- SantaSuggestions and prints it out
main = do
    let choiceSantas = bestSantas 0
    selected <- randomSelect choiceSantas
    putStrLn $ showSanta selected

-- Various lists of SantaSuggestions...
-- ...everything, allowed or not
allSantas :: [SantaSuggestion]
allSantas = map (zip people) (permutations people)

-- All the SantaSuggestions but with explicitly disallowed pairings
-- eliminated
allowedSantas :: [SantaSuggestion]
allowedSantas = filter goodSuggestion allSantas

-- All allowed SantaSuggestions but with a numeric score of "badness"
rankedSantas :: [(Int, SantaSuggestion)]
rankedSantas = map (\sugg -> (score sugg, sugg)) allowedSantas

-- Limit the ranked SantaSuggestions to those with <= given limit
bestSantas :: Int -> [SantaSuggestion]
bestSantas limit = map snd $ filter (\(score, _) -> score <= limit) rankedSantas

-- a good suggestion is when nothing in the pairings is explicitly
-- disallowed
goodSuggestion :: SantaSuggestion -> Bool
goodSuggestion = not . any disallowed

-- A list of pairings that are not allowed
disallowedPairs = [("Chris", "Sarah"),  -- spouses
                   ("Matt", "Jimmy"),   -- siblings
                   ("Colin", "Kelsey"), -- siblings
                   ("Peter", "Sarah")]  -- siblings

-- These pairings are discouraged, a SantaSuggestion containing these
-- gets points of 'badness' for each one found
discouragedPairs = [("Chris", "Matt"),  -- cousin in-law?
                    ("Sarah", "Matt"),  -- close cousins
                    ("Chris", "Peter")] -- brother in-law

-- can't have yourself, or one of the disallowed pairings
disallowed :: (Person, Person) -> Bool
disallowed p@(x, y) = x == y || any (pairMatch p) disallowedPairs

score :: SantaSuggestion -> Int
score = foldl (\total pair -> total + discouragedPoints pair) 0

discouragedPoints :: (Person, Person) -> Int
discouragedPoints p@(x, y) = if any (pairMatch p) discouragedPairs 
                             then 1 else 0

-- utility stuff
showSanta :: SantaSuggestion -> String
showSanta s = intercalate "\n" $ map (\(p1, p2) -> p1 ++ " gives to " ++ p2) s

pairMatch (u, v) (x, y) = (u, v) == (x, y) || (v, u) == (x, y)

-- adapted from http://www.haskell.org/haskellwiki/99_questions/Solutions/23
randomSelect :: [a] -> IO a
randomSelect lst = do
    pos <- getStdRandom $ randomR (0, (length lst) - 1)
    return $ lst !! pos