лесенка

import System.IO
import Data.List as List
import qualified Data.Map as Map
main = do
    x <- readFile "test.txt"
    let words_ = words x
    x <- readFile "letters.txt"
    let letters = words x
    let xs = bfs "ffff" "ffbb" ["ffff"] ["ffff"] [] letters words_
    print xs
    where
        bfs start dest acc queue father letters words_
            | (elem dest acc) = father--get_path father start [dest]
            | otherwise = do
                let new_words = [x | x <- get_neigbours (head queue) words_ letters, notElem x queue, x /= (head queue), notElem x acc]
                let new_queue = (tail queue) ++ new_words
                let new_father = father ++ [(w, (head queue)) | w <- new_words, length queue > 0]
                let new_acc = [head queue] ++ acc
                bfs start dest new_acc new_queue new_father letters words_

get_path father start acc
    | (elem start acc) = acc
    | otherwise = do
        if (elemIndex (head acc, _) father) != Nothing
            then let ind = elemIndex (head acc, _) father
            else throw SomeException
        let e = father!!ind
        let new_acc = (snd e) ++ acc
        get_path father start new_acc

check_for_neigbour word ans words_
    | elem word ans = False
    | elem word words_ = True
    | otherwise = False

change_letter word letters = do
    [ch ind word letters i | i <- [0..3], ind <- [1..length word]]
        where
            ch ind word letters ind_let =  do
                let new_ind = ind - 1
                (take new_ind word) ++ (letters!!ind_let) ++ (drop ind word)


get_neigbours word words_ letters = filter (\x -> elem x words_) (change_letter word letters)