[Haskell-beginners] Could not deduce (Matrix m (Maybe a)) from the context (Matrix m a)

Lyndon Maydwell maydwell at gmail.com
Fri Jan 29 03:52:37 EST 2010


Hi Beginners.

I'm writing a matrix class for a game of life implementation. When I
try to compile it I get the error "Could not deduce (Matrix m (Maybe
a)) from the context (Matrix m a)" for the method vicinityMatrix.

However, when I query the type of an identical implementation to
vicinityMatrix in ghci it is successful:

:t \m x y -> fromRows $ vicinityRows m x y
\m x y -> fromRows $ vicinityRows m x y
  :: forall (m :: * -> *) (m1 :: * -> *) a.
     (Matrix m (Maybe a), Matrix m1 a) =>
     m1 a -> Integer -> Integer -> m (Maybe a)

What might be preventing the class from compiling?

Thanks guys.

---

My Matrix class definition follows below:

module Matrix (Matrix) where

import Data.Array
import Data.Maybe (catMaybes)
import Control.Monad (guard)

class Matrix m a
  where
    fromRows       :: [[a]] -> m a
    toList         :: m a   -> [a]
    rows           :: m a   -> Integer
    columns        :: m a   -> Integer
    row            :: m a   -> Integer -> [a]
    column         :: m a   -> Integer -> [a]
    at             :: m a   -> Integer -> Integer -> a
    (!!!)          :: m a   -> Integer -> Integer -> a
    vicinityRows   :: m a   -> Integer -> Integer -> [[Maybe a]]
    vicinityMatrix :: m a   -> Integer -> Integer -> m (Maybe a)
    neighbours     :: m a   -> Integer -> Integer -> [a]

    toList m = do
      x <- [0 .. columns m - 1]
      y <- [0 .. rows m - 1]
      return $ at m x y

    row    m n = [at m x n | x <- [0 .. columns m - 1]]
    column m n = [at m n y | y <- [0 .. rows    m - 1]]

    at    = (!!!)
    (!!!) = at

    vicinityRows m x y = do
      x' <- [x - 1 .. x + 1]
      return $ do
        y' <- [y - 1 .. y + 1]
        return cell where
          cell
            | x <  0         = Nothing
            | y <  0         = Nothing
            | x >= columns m = Nothing
            | y >= rows m    = Nothing
            | otherwise      = Just $ at m x y

    vicinityMatrix m x y = fromRows $ vicinityRows m x y

    -- neighbours = catMaybes . toListN . vicinityMatrix

toListN :: Matrix m a => m a -> [a]
toListN m = do
  x <- [0 .. columns m - 1]
  y <- [0 .. rows m - 1]
  guard $ x /= 1 && y /= 1
  return $ at m x y


More information about the Beginners mailing list