Keyboard.hs

import Data.Maybe
import Data.Char
import Data.List

layout :: [(Char, String)]
layout = [ ('Q', "WAS"), ('W', "QASE"), ('E', "WSDR"), ('R', "EDFT"), ('T', "RFGY"), ('Y', "TGHU") 
          ,('U', "YHJI"), ('I', "UJKO"), ('O', "IKLP"), ('P', "OL"), ('A', "QWSZ"), ('S', "AZWEDCX")
          ,('D', "ERFCXS"), ('F', "RTGVCD"), ('G', "TYHBVF"), ('H', "YUJNBG"), ('J', "HUIKMN")
          ,('K', "JIOL"), ('L', "KOP"), ('Z', "ASX"), ('X', "ZSDC"), ('C', "XDFV"), ('V', "CFGB")
          ,('B', "VGHN"), ('N', "BHJM"), ('M', "NJK")]

adjacent :: Char -> Char -> Bool
adjacent x y = x == y || (fromMaybeBool . fmap (x `elem`) $ lookup y layout) 
   where fromMaybeBool = fromMaybe False

canMake :: String -> Bool
canMake s = and $ zipWith adjacent s' (drop 1 s')
   where s' = map toUpper s

findLongest :: Int -> [String] -> [String]
findLongest n = take n . sortBy cmpLength . filter canMake
   where cmpLength x y = compare (length y) (length x)

main :: IO ()
main = do
   longestWords <- fmap (findLongest 10 . lines) $ readFile "/usr/share/dict/words"
   putStr (unlines longestWords)