A translation of Norvig's solution to the Cheryl's Birthday problem from Python to Haskell. Original: http://nbviewer.ipython.org/url/norvig.com/ipython/Cheryl.ipynb

Cheryl.hs

-- A list of possible dates Cheryl's birthday might be on.
possibilities = [(May, 15),    (May, 16),    (May, 19),
                 (June, 17),   (June, 18),
                 (July, 14),   (July, 16),
                 (August, 14), (August, 15), (August, 17)]

-- We say we know the actual date when the list of possibilities is singular.
know ps = length ps == 1

-- Telling someone the month or day will reduce the possibilities.
tell f date = filter (\date' -> f date' == f date)

-- List of statements made about the birthday. Each is a function that takes
-- a single date, and checks if all statements hold for that date.
statements = [statement3, statement4, statement5]

-- Albert: I don't know when Cheryl's birthday is, and I know that Bernard
-- also does not know.
statement3 date = iDon'tKnow && bernardDoesn'tKnow where
    told = (tell month date) possibilities
    iDon'tKnow = (not . know) told
    bernardDoesn'tKnow = all (not . know) [(tell day d) possibilities | d <- told]

-- Bernard: At first I didn't know when Cheryl's birthday is, but I know now.
statement4 date = iDidn'tKnow && iNowKnow where
    told = (tell day date) possibilities
    iDidn'tKnow = (not . know) told
    iNowKnow = know (filter statement3 told)

-- Albert: Then I also know when Cheryl's birthday is.
statement5 date = iNowKnow where
    told = (tell month date) possibilities
    iNowKnow = know (filter statement4 told)

-- Solver. We find birthdays which are consistent with all the statements given.
-- The arguments are uncurried because it makes no sense to provide only one of
-- the possibilities and statements.
birthdays (possibilities, statements) = filter consistent possibilities where
    consistent possibility = allTrue statements possibility
    allTrue fs x = and $ map ($ x) fs

-- Solve the problem - find the list of possible birthdays, and check if we've
-- successfully narrowed it down to one!
cheryl'sBirthday = case birthdays (possibilities, statements) of
    [b] -> Just b
    _   -> Nothing

-- That's all, folks!
main = print cheryl'sBirthday

-- Months we used.
data Month = May | June | July | August
    deriving (Show, Eq)

-- Nicer named accessors for the tuples.
month = fst
day   = snd