Cool & pretty readable haskell code

great_code.hs

data Cargo = Peasant
    | Cabbage
    | Wolf
    | Goat
    deriving (Eq, Enum, Show)

type ShoreState = [Cargo] 
type Move = [Cargo] 
type State = (ShoreState, ShoreState)


--State, FromState
type StateHist = (State, State)
type QueueStateHist = [StateHist]

constraint :: ShoreState -> Bool
constraint a = not(
    ((not $ elem Peasant a) && (elem Cabbage a) && (elem Goat a))
    || ((not $ elem Peasant a) && (elem Wolf a) && (elem Goat a))
)
stateConstraint s = (constraint $ fst s) && (constraint $ snd s)


genShoreStates :: ShoreState -> [Move]
genShoreStates s = if (elem Peasant s)
    then [[Peasant]] ++ [[Peasant, x] | x <- s, x /= Peasant]
    else [[]]

transformMove move = applyState s move isPeasantAtLeftShore

genStates s = filter stateConstraint $ map transformMove gen
    where leftShore = fst s
          rightShore = snd s
          isPeasantAtLeftShore = elem Peasant leftShore
          gen = genShoreStates (if isPeasantAtLeftShore
              then leftShore
              else rightShore)

applyState :: State -> Move -> Bool -> State
applyState s move leftToRight = if leftToRight
    then (delete (fst s) move, add (snd s) move)
    else (add (fst s) move, delete (snd s) move)
    where delete shore move = [x | x <- shore, not $ elem x move]
          add    shore move = shore ++ move

shoreEq :: ShoreState -> ShoreState -> Bool
shoreEq fst snd = and [elem x snd | x <- fst] && and [elem x fst | x <- snd]

stateEq :: State -> State -> Bool
stateEq fstState sndState = shoreEq (fst fstState) (fst sndState) && shoreEq (snd fstState) (snd sndState)


start :: State
start = ([Peasant, Cabbage, Wolf, Goat], [])

finish :: State
finish = ([], [Peasant, Cabbage, Wolf, Goat])

bfs :: [State] -> QueueStateHist -> QueueStateHist
bfs [] queue       = queue
bfs (x : xs) queue = bfs (xs ++ newStates) newQueue
    where states = genStates x
          newStates = filter (\k -> not $ contains queue k) states
          newQueue = queue ++ (zip newStates (iterate id x))

contains :: QueueStateHist -> State -> Bool
contains q state = or $ map (\x -> stateEq x state) states
    where states = map fst q

task :: [State]
task = if find then ([finish] ++ backTraverse q finish start []) else []
    where q = bfs [start] [(start, start)]
          find = contains q finish

backTraverse :: QueueStateHist -> State -> State -> [State] -> [State]
backTraverse queue curState finishState acc = if (stateEq curState finishState)
    then acc
    else backTraverse queue pred finishState (acc ++ [pred])
    where pred = getPred queue curState

getPred :: QueueStateHist -> State -> State
getPred q state = snd $ head $ filter (\x -> stateEq (fst x) state) q