amb :: [a] -> [a]
amb xs = xs

require :: Bool -> [()]
require True = [()]
require False = []

distinct :: (Eq a) => [a] -> Bool
distinct [] = True
distinct (x:xs) = (and $ map (/=x)xs) && distinct xs

dwellings =
    do baker <- amb [1..5]
       cooper <- amb [1..5]
       fletcher <- amb [1..5]
       miller <- amb [1..5]
       smith <- amb [1..5]
       require $ distinct [baker, cooper, fletcher, miller, smith]
       require $ baker /= 5
       require $ cooper /= 1
       require $ fletcher /= 5
       require $ fletcher /= 1
       require $ miller > cooper
       require $ (abs $ smith - fletcher) /= 1
       require $ (abs $ cooper - fletcher) /= 1
       return $ [("baker", baker),
                 ("cooper", cooper),
                 ("fletcher", fletcher),
                 ("miller", miller),
                 ("smith", smith)]

main :: IO ()
main = putStrLn $ show dwellings