Determine children within edge and return a list of tuple pairs

I've been studying hard and asking a lot of questions - I finally came a cross an exercise in LYAH that looked like it was easy enough but a perfect candidate for practicing.

The below program has a bunch of helper funcs in there, but the one of interest is neighbors/3. It takes a Pair type and Edge number, and a BiMorph type. It then determines all of the children within that edge and returns it as a list of tuple pairs.

I would like a more experienced Haskeller to come in and tear it apart or to give me constructive criticism.

import Control.Monad
import Control.Applicative

data Pair a    = Pair a a deriving (Show, Eq)
data BiMorph a = BiMorph Func Func

type Neighbors = [(Int, Int)]
type Matrix    = [[Int]]
type Func      = (Int -> Int -> Int)

instance Functor Pair where
   fmap f (Pair a b) = Pair (f a) (f b)

instance Applicative Pair where
   pure a = Pair a a
   (Pair fa fb)  (Pair a b) = Pair (fa a) (fb b)

matrix :: Int -> Int -> Matrix
matrix xl yl = replicate yl $ [1..xl]

cartesianPairs :: Func -> Pair Int -> [Pair Int]
cartesianPairs f p =
    [(f  (Pair x y)  p) | x  Func -> Pair Int -> [Pair Int]
cartesianDoubles f g (Pair x y) = [Pair (f x 1) (g y 1), Pair (g x 1) (f y 1)]

dropP :: Pair Int -> (Int, Int)
dropP (Pair x y) = (abs x, abs y)

liftP :: (Int, Int) -> Pair Int
liftP (x, y) = Pair x y

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = 
    map dropP $ concat [(cartesianPairs f p), (cartesianPairs g p), (cartesianDoubles f g p)]
        >>= (\(Pair x' y') -> guard (x' > return (Pair x' y'))

Run hlint tool on your source to help you with getting rid of redundant brackets, $ and other minor suggestions.

In neighbors your using of guard in list monad can be changed to filter function:

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = map dropP $ filter ff $ concat [cartesianPairs f p, cartesianPairs g p, cartesianDoubles f g p] where
    ff (Pair x' y') = x' <= e && y' <= e

You can also hardcode the list into cartesianPairs as it's short:

cartesianPairs :: Func -> Pair Int -> [Pair Int]
cartesianPairs f p =
    [f  Pair x y  p | (x, y) <- [(1,0), (0,1), (1,1)]]

You can even use pairs directly:

cartesianPairs :: Func -> Pair Int -> [Pair Int]
cartesianPairs f p =
    [f  pair  p | pair <- [Pair 1 0, Pair 0 1, Pair 1 1]]

I also have an impression that cartesianPairs can be further simplified but I couldn't find anything that has clear meaning. Here are two attempts:

cartesianPairs f p =
     ( p)  (fmap . fmap) f [Pair 1 0, Pair 0 1, Pair 1 1]

cartesianPairs f p =
     ( p) . fmap f  [Pair 1 0, Pair 0 1, Pair 1 1]

cartesianDoubles can be shrinked the same way if you want:

cartesianDoubles f g (Pair x y) = [Pair (ff x) (gg y), Pair (gg x) (ff y)] where
    ff x = f x 1
    gg x = g x 1

cartesianDoubles f g p = [Pair ff gg  p, Pair gg ff  p] where
    ff x = f x 1
    gg x = g x 1

cartesianDoubles f g p = ( p)  [Pair ff gg, Pair gg ff] where
    ff x = f x 1
    gg x = g x 1

Yet another improvement. You can notice that there are versions of cartesianDoubles and cartesianPairs sharing the same ( p) part:

cartesianPairs f p =
    ( p)  (fmap . fmap) f [Pair 1 0, Pair 0 1, Pair 1 1]

cartesianDoubles f g p = ( p)  [Pair ff gg, Pair gg ff] where
    ff x = f x 1
    gg x = g x 1

Then notice that ` in ( p) is for Functor [] instance, so it's just plain map, and map has a property of commuting withconcat:map f . concat == concat . map f.

So you can move the common fragment out:

cartesianPairs f p =
    (fmap . fmap) f [Pair 1 0, Pair 0 1, Pair 1 1]

cartesianDoubles f g p = [Pair ff gg, Pair gg ff] where
    ff x = f x 1
    gg x = g x 1

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = map dropP $ filter ff $ map ( p) $ concat [cartesianPairs f p, cartesianPairs g p, cartesianDoubles f g p] where
    ff (Pair x' y') = x' <= e && y' <= e

Now p argument is not used:

cartesianPairs f =
    (fmap . fmap) f [Pair 1 0, Pair 0 1, Pair 1 1]

cartesianDoubles f g = [Pair ff gg, Pair gg ff] where
    ff x = f x 1
    gg x = g x 1

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = map dropP $ filter ff $ map ( p) $ concat [cartesianPairs f, cartesianPairs g, cartesianDoubles f g] where
    ff (Pair x' y') = x' <= e && y' <= e

If you want, you can convert neighbors to use list comprehensions:

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = 
    [ dropP xx 
    | x  p
    , x' <= e && y' <= e ]

Or even

neighbors :: Pair Int -> Int -> BiMorph Int -> Neighbors
neighbors p e (BiMorph f g) = 
    [ dropP xx 
    | xx @ (Pair x' y')  p)  
        concat [cartesianPairs f, cartesianPairs g, cartesianDoubles f g] 
    , x' <= e && y' <= e ]

But I find it less clear.

StackExchange Code Review Q#16342, answer score: 4