Another update from ingydotnet^djgoku

Task/State-name-puzzle/Haskell/state-name-puzzle.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE TupleSections #-}
+
+import Data.Char (toLower, isLetter)
+import Data.List (sort, sortBy, nub, groupBy)
+import Data.Function (on)
+
+stateNames :: [String]
+stateNames=
+    ["Alabama",
+     "Alaska",
+     "Arizona",
+     "Arkansas",
+     "California",
+     "Colorado",
+     "Connecticut",
+     "Delaware",
+     "Florida",
+     "Georgia",
+     "Hawaii",
+     "Idaho",
+     "Illinois",
+     "Indiana",
+     "Iowa",
+     "Kansas",
+     "Kentucky",
+     "Louisiana",
+     "Maine",
+     "Maryland",
+     "Massachusetts",
+     "Michigan",
+     "Minnesota",
+     "Mississippi",
+     "Missouri",
+     "Montana",
+     "Nebraska",
+     "Nevada",
+     "New Hampshire",
+     "New Jersey",
+     "New Mexico",
+     "New York",
+     "North Carolina",
+     "North Dakota",
+     "Ohio",
+     "Oklahoma",
+     "Oregon",
+     "Pennsylvania",
+     "Rhode Island",
+     "South Carolina",
+     "South Dakota",
+     "Tennessee",
+     "Texas",
+     "Utah",
+     "Vermont",
+     "Virginia",
+     "Washington",
+     "West Virginia",
+     "Wisconsin",
+     "Wyoming"]
+
+fakeStateNames :: [String]
+fakeStateNames =
+    ["New Kory",
+     "Wen Kory",
+     "York New",
+     "Kory New",
+     "New Kory"]
+
+pairs :: [a] -> [(a,a)]
+pairs [] = []
+pairs (y:ys) = map (y,) ys ++ pairs ys
+
+puzzle :: [String] -> [((String,String), (String, String))]
+puzzle states =
+    concatMap (filter isValid.pairs) $
+    map (map snd) $
+    filter ((>1) . length ) $
+    groupBy ((==) `on` fst) $
+    sortBy (compare `on` fst) [(pkey (a++b), (a,b)) | (a,b) <- pairs (nub $ sort states)] where
+        pkey = sort . filter isLetter . map toLower
+        isValid ((a0, a1),(b0, b1)) = (a0 /= b0) && (a0 /= b1) && (a1 /= b0) && (a1 /= b1)
+
+main :: IO ()
+main = do
+    putStrLn $ "Matching pairs generated from "
+               ++ show (length stateNames) ++ " state names and "
+               ++ show (length fakeStateNames) ++ " fake state names:"
+    mapM_ print $ puzzle $ stateNames ++ fakeStateNames