Could you please review the following code, and point out how I can make it cleaner, more idiomatic and easier to understand?

module Cabbage (
solve
) where

data Place = Here | There deriving (Eq, Show)

data Pos = Pos { cabb :: Place
, goat :: Place
, wolf :: Place
, farmer :: Place
} deriving (Eq, Show)

opp :: Place -> Place
opp Here = There
opp There = Here

valid :: Pos -> Bool
valid (Pos {cabb = c, goat = g, wolf = w, farmer = f}) = (c /= g && g /= w) || g == f

findMoves :: Pos -> [Pos]
findMoves pos@(Pos {cabb = c, goat = g, wolf = w, farmer = f}) =
filter valid $moveCabb ++ moveGoat ++ moveWolf ++ moveFarmer where moveCabb | c == f = [pos {cabb = opp c, farmer = opp f}] | otherwise = [] moveGoat | g == f = [pos {goat = opp g, farmer = opp f}] | otherwise = [] moveWolf | w == f = [pos {wolf = opp w, farmer = opp f}] | otherwise = [] moveFarmer = [pos {farmer = opp f}] findSolution :: Pos -> Pos -> [Pos] findSolution from to = head$ loop [[from]] where
loop pps = do ps <- pps
let moves = filter (flip notElem ps) $findMoves$ head ps
if to elem moves
then return $reverse$ to:ps
else loop $map (:ps) moves solve :: [Pos] solve = findSolution (setAll Here) (setAll There) where setAll x = Pos{ cabb = x, goat = x, wolf = x, farmer = x }  IMHO the findMoves function seems to be quite verbose, and the findSolutions function looks confusing. Thank you! • Oh, I can write data Pos = Pos {cabb, goat, wolf, farmer :: Place} deriving (Eq, Show). – Landei Jul 30 '11 at 17:19 ## 4 Answers Haskell's record system is not really good at providing you uniform access to record entries. That is the reason your findMoves implementation has to be so verbose: You cannot generalize over the fields. There are a number of ways to get around that. One could be using a library such as fclabels that facilitates this job for you. You set it up like follows: import Data.Record.Label data Pos = ....$( mkLabels [''Pos] )


This will give you "labels" with names such as lCabb that you can use with functions such as getL or modL. Without all this boilerplate, it is possible to write a much more satisfying findMoves function:

findMoves :: Pos -> [Pos]
findMoves pos = filter valid moves
where
moves    = [ foldr (\obj -> modL obj opp) pos objs
| objs <- moveComb, same $map (getL pos) objs ] moveComb = [[lCabb, lFarmer], [lGoat, lFarmer], [lWolf, lFarmer], [lFarmer]] same xs = all (== head xs) xs  I'd be inclined to change your representation. At each step, the farmer moves from his current location to the opposite location. It makes life much simpler if you just represent each state as a pair consisting of the list of things at the farmer's current location and the list of things at the other location. My Haskell is a bit rusty, but under this scheme you get something like this: move (withFmr, awayFromFmr) = [(awayFromFmr, withFmr) | map f withFmr] where f x = (x :: awayFromFmr, filter (== x) withFmr) valid (withFmr, awayFromFmr) = not (elem Goat awayFromFmr && (elem Wolf awayFromFmr || elem Cabbage awayFromFmr))  The location of withFmr for each successive state is the opposite of that for the preceding state. Hope this helps. • I already had this representation, but in order to avoid to go back to a position we already had, the lists must be compared, which means they must be sorted. I also tried Sets instead of lists, which worked somewhat better, but had to be translated back to lists in findSolution. – Landei Jul 8 '11 at 6:20 I kept the record syntax (but it's good to know about the alternatives). This is my last version: import Data.Maybe(catMaybes) data Place = Here | There deriving (Eq, Show) data Pos = Pos {cabb, goat, wolf, farmer :: Place} deriving (Eq, Show) type Path = [Pos] findMoves :: Path -> [Path] findMoves path@(pos@(Pos c g w f) : prev) = catMaybes [ c ??? pos {cabb = opp c} , g ??? pos {goat = opp g} , w ??? pos {wolf = opp w} , f ??? pos ] where opp Here = There opp There = Here valid (Pos c g w f) = (c /= g && g /= w) || g == f x ??? p = let p' = p {farmer = opp f} in if x == f && valid p' && notElem p' prev then Just (p' : path) else Nothing findSol :: Pos -> Path -> [Path] findSol pos path@(p : _) | p == pos = [reverse path] | otherwise = findMoves path >>= findSol pos solve :: [Path] solve = findSol endPos [startPos] where setPos place = Pos place place place place startPos = setPos Here endPos = setPos There  Here's my attempt using arrays and list comprehensions: import Data.Array import Data.List type Pos = Array Obj Place data Place = Here | There deriving (Eq, Show) data Obj = Cabb | Goat | Wolf | Farmer deriving (Ord, Eq, Ix, Show, Enum) objs = [Cabb .. Farmer] allAre a = listArray (Cabb, Farmer)$ map (const a) objs

start = allAre Here
end = allAre There

opp Here = There
opp There = Here

valid arr = (arr ! Cabb /= arr ! Goat && arr ! Goat /= arr ! Wolf) || arr ! Goat == arr ! Farmer

move arr obj = [(o, opp (arr ! o)) | o <- [Farmer, obj]]

nextStates arr = [ nextState | obj <- objs, let nextState = arr // move arr obj, arr ! Farmer == arr ! obj, valid nextState]

nextMove paths = [nextState : path | path <- paths, nextState <- nextStates (head path)]

filterSolutions = filter (\path -> head path == end)

shortestPath = head $concatMap filterSolutions$ iterate nextMove [[start]]

main = print \$ length shortestPath

• That looks very clean. I'll meditate over it :) – Landei Sep 4 '12 at 19:15