2
votes

I'm rewriting some of my libraries to use type families instead of functional dependencies. However, it seems like some of the constraints that I have to add to functions in order to get them to compile shouldn't be necessary. That makes me suspect that I'm not doing things in the best way.

In the example below, is there a way to improve the definitions of Grid and GridMap so that the signatures for diff and classify are simpler? In particular, the constraints BaseGrid (Container gm k) ~ BaseGrid gm, Container (Container gm k) ~ Container gm, and GridMap (Container gm k) on classify seem inelegant.

{-# LANGUAGE TypeFamilies, FlexibleContexts #-}

import Prelude hiding (map)
import Data.List (minimumBy)
import qualified Data.Map as M
import Data.Ord (comparing)

class Grid g where
  type Index g
  indices :: g -> [Index g]
  -- plus other functions

class (Grid (BaseGrid gm)) => GridMap gm where
  type BaseGrid gm
  type Value gm
  type Container gm :: * -> *

  toMap :: gm -> M.Map (Index (BaseGrid gm)) (Value gm)
  toList :: gm -> [(Index (BaseGrid gm), Value gm)]
  toList = M.toList . toMap

  map
    :: (GridMap gm2, gm2 ~ Container gm (Value gm2)) => 
      (Value gm -> Value gm2) -> gm -> gm2

  mapWithKey 
    :: (GridMap gm2, gm2 ~ Container gm (Value gm2)) => 
      (Index gm -> Value gm -> Value gm2) -> gm -> gm2
  -- plus other functions

class Pattern p where
  type Metric p
  difference :: p -> p -> Metric p
  makeSimilar :: p -> Metric p -> p -> p

diff 
  :: (GridMap gm1, p ~ Value gm1, GridMap gm2, Pattern p, 
      Metric p ~ Value gm2, Container gm1 ~ Container gm2, 
      BaseGrid gm1 ~ BaseGrid gm2,
      gm2 ~ Container gm2 (Value gm2)) => 
    gm1 -> p -> gm2
diff c pattern = map (pattern `difference`) c

classify
  :: (GridMap gm, p ~ Value gm, Pattern p, Ord k, k ~ Metric p, 
      k ~ Index (BaseGrid gm), k ~ Value (Container gm k),
      BaseGrid (Container gm k) ~ BaseGrid gm,
      Container (Container gm k) ~ Container gm,
      GridMap (Container gm k)) =>
    gm -> p -> k
classify c pattern = 
  fst $ minimumBy (comparing snd) $ toList $ diff c pattern

EDIT: I like leventov's solution, but when I try to implement it, I get a compile error that I don't understand.

{-# LANGUAGE TypeFamilies, FlexibleContexts #-}

import Prelude hiding (map)
import Data.List (minimumBy)
import qualified Data.Map as M
import Data.Ord (comparing)

class Grid g where
  type Index g
  indices :: g -> [Index g]
  -- plus other functions

class (Grid (BaseGrid gm a)) => GridMap gm a where
  type BaseGrid gm a

  toMap :: gm -> M.Map (Index (BaseGrid gm a)) a
  toList :: gm -> [(Index (BaseGrid gm a), a)]
  toList = M.toList . toMap

  map :: GridMap gm b => (a -> b) -> gm a -> gm b -- <<<<<LINE 20>>>>>

  mapWithKey 
    :: GridMap gm b => 
      (Index (BaseGrid gm a) -> a -> b) -> gm a -> gm b
  -- plus other functions

class Pattern p where
  type Metric p
  difference :: p -> p -> Metric p
  makeSimilar :: p -> Metric p -> p -> p

diff 
  :: (GridMap gm p, Pattern p, GridMap gm m,
      Metric p ~ m, BaseGrid gm p ~ BaseGrid gm m) => 
    gm p -> p -> gm m
diff c pattern = map (pattern `difference`) c

classify
  :: (GridMap gm p, Pattern p, Ord k, k ~ Metric p, 
      k ~ Index (BaseGrid gm p),
      BaseGrid gm k ~ BaseGrid gm p) =>
    gm p -> p -> k
classify c pattern = 
  fst $ minimumBy (comparing snd) $ toList $ diff c pattern

The error I get is:

../Amy5.hs:20:42:
    `gm' is applied to too many type arguments
    In the type `GridMap gm b => (a -> b) -> gm a -> gm b'
    In the class declaration for `GridMap'
Failed, modules loaded: none.

I also get this error if I leave off the constraint GridMap gm b =>.

1

1 Answers

2
votes

I would make GridMap with 2 parameters: Container itself and value types.

Something like

{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-}

import Prelude hiding (map)
import Data.List (minimumBy)
import qualified Data.Map as M
import Data.Ord (comparing)

class Grid g where
  type Index g
  indices :: g -> [Index g]
  -- plus other functions

class (Grid (BaseGrid gm a)) => GridMap (gm :: * -> *) a where
  type BaseGrid gm a

  toMap :: gm a -> M.Map (Index (BaseGrid gm a)) a
  toList :: gm a -> [(Index (BaseGrid gm a), a)]
  toList = M.toList . toMap

  map :: GridMap gm b => (a -> b) -> gm a -> gm b -- <<<<<LINE 20>>>>>

  mapWithKey 
    :: GridMap gm b => 
      (Index (BaseGrid gm a) -> a -> b) -> gm a -> gm b
  -- plus other functions

class Pattern p where
  type Metric p
  difference :: p -> p -> Metric p
  makeSimilar :: p -> Metric p -> p -> p

diff 
  :: (GridMap gm p, Pattern p, GridMap gm m,
      Metric p ~ m, BaseGrid gm p ~ BaseGrid gm m) => 
    gm p -> p -> gm m
diff c pattern = map (pattern `difference`) c

classify
  :: (GridMap gm p, Pattern p, Ord k, k ~ Metric p, 
      k ~ Index (BaseGrid gm p),
      GridMap gm k,
      BaseGrid gm k ~ BaseGrid gm p) =>
    gm p -> p -> k
classify c pattern = 
  fst $ minimumBy (comparing snd) $ toList $ diff c pattern