Words game

gistfile1.hs

import Data.List (sort)
import Data.Maybe (isJust, fromJust)

checkWords :: [[String]] -> String
checkWords []          = "Can't match"
checkWords (xs:ys) | length xs == 1  = head xs
                   | otherwise = checkWords ((unfold (trans (head xs)) (tail xs)) ++ ys)
  where trans x y | head x == last y = Just (y ++ x)
                  | head y == last x = Just (x ++ y)
                  | otherwise = Nothing

unfold :: (Show a) => (a -> Maybe a) -> [a] -> [[a]]
unfold _ [] = []
unfold f ys = filter (not . null) $ map (unpair1) [0..(length ys - 1)]
  where unpair1 n | isJust w  = (take n ys) ++ [fromJust w] ++ (tail $ drop n ys)
                  | otherwise = []
          where k = ys !! n
                w = f k

isPossible :: [String] -> Bool
isPossible s = (z < 2)
  where z = length $ filter (not . \e -> (fst e == snd e)) (zip (sort1 head) (sort1 last))
          where sort1 f = sort $ map f s


main = getLine >>= \l -> putStrLn $ let ws = words l
                                    in if isPossible ws
                                       then checkWords[ws]
                                       else "Easy-check failed"

with_native_unfoldr.hs

import Data.List (sort, unfoldr)

checkWords :: [[String]] -> String
checkWords []          = "Can't match"
checkWords (xs:ys) | length xs == 1  = head xs
                   | otherwise = checkWords ((filter (not . null) $ unfoldr (split (tail xs) (head xs)) 0) ++ ys)
  where split words x n | n > (length words - 1) = Nothing
                        | otherwise = Just (match x (words !! n), n+1)
          where match x y | head x == last y = replace_ (y ++ x)
                          | head y == last x = replace_ (x ++ y)
                          | otherwise = []
                  where replace_ sub = (take n words) ++ [sub] ++ (tail $ drop n words)

isPossible :: [String] -> Bool
isPossible s = (z < 2)
  where z = length $ filter (not . \e -> (fst e == snd e)) (zip (sort1 head) (sort1 last))
          where sort1 f = sort $ map f s

main = getLine >>= \l -> putStrLn $ let ws = words l
                                    in if isPossible ws
                                       then checkWords[ws]
                                       else "Easy-check failed"

Ничего не понятно :)

Для истории расскажу о задаче: есть список слов, нужно проверить, можно ли их составить в таком порядке, что каждое слово кроме первого начинается на букву, на которую оканчивается слово перед ним.