import System.IO (readFile)
import Control.Monad (foldM)
import Data.List (intercalate)
import qualified Data.Set as S

distance :: String -> String -> Int
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2

wordLadders :: [String] -> String -> String -> [[String]]
wordLadders dict start end
  | length start /= length end = []
  | otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end
  where

    wordSpace = S.fromList $ filter ((length start ==) . length) dict

    expandFrom s = go [[s]]
      where
        go (h:t) d
          | S.null d || S.null f = []
          | end `S.member` f = [h:t]
          | otherwise = go (S.elems f:h:t) (d S.\\ f)
          where
            f = foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty h

    shrinkFrom = scanM (filter . oneStepAway)

    oneStepAway x = (1 ==) . distance x

    scanM f x = fmap snd . foldM g (x,[x])
      where g (b, r) a = (\x -> (x, x:r)) <$> f b a

wordLadder :: [String] -> String -> String -> [String]
wordLadder d s e = case wordLadders d s e of
                     [] -> []
                     h:_ -> h

showChain [] = putStrLn "No chain"
showChain ch = putStrLn $ intercalate " -> " ch

main = do
  dict <- lines <$> readFile "unixdict.txt"
  showChain $ wordLadder dict "boy" "man"
  showChain $ wordLadder dict "girl" "lady"
  showChain $ wordLadder dict "john" "jane"
  showChain $ wordLadder dict "alien" "drool"
  showChain $ wordLadder dict "child" "adult"