Context in data instances

假如想象 提交于 2019-12-13 21:34:20

问题


I have a datatype which only makes sense if its arguments can be ordered, however I seem to be needing to get deep into some complex and potentially hacky stuff to get it to work (GADTs, mainly). Is what I'm doing (constrained datatypes) considered bad haskell practice, and is there any way around this?

For those interested, here's the relevant code:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
import Data.List (sort)

data OrdTriple a where
    OrdTriple :: (Ord a) => a -> a -> a -> OrdTriple a

instance Functor OrdTriple where
    fmap :: (Ord a, Ord b) => (a -> b) -> OrdTriple a -> OrdTriple b
    fmap f (OrdTriple n d x) = OrdTriple n' d' x'
        where 
            [n', d', x'] = sort [f n, f d, f x]

At first I thought I'd just put a context in the Functor instance (it's the only instance I'm struggling with) but it seems I can't (no mention of the contained type), and even if I could I'd still need the constraint on fmap that its return type be orderable.

As it is, I'm getting the following compile error, which it seems is because I'm overly constraining the Functor instance:

No instance for (Ord a)
Possible fix:
  add (Ord a) to the context of
    the type signature for
      fmap :: (a -> b) -> OrdTriple a -> OrdTriple b
When checking that:
    forall a b.
    (Ord a, Ord b) =>
    (a -> b) -> OrdTriple a -> OrdTriple b
  is more polymorphic than:
    forall a b. (a -> b) -> OrdTriple a -> OrdTriple b
When checking that instance signature for ‘fmap’
  is more general than its signature in the class
  Instance sig: forall a b.
                (Ord a, Ord b) =>
                (a -> b) -> OrdTriple a -> OrdTriple b
     Class sig: forall a b. (a -> b) -> OrdTriple a -> OrdTriple b
In the instance declaration for ‘Functor OrdTriple’

回答1:


You can't do this using the standard Functor class, since its fmap must work on all data types, without constraints.

You could work with a different class. One option is to use an "fine-grained functor" class which lets you use a separate instance for each pairs of types a b. (Probably this already has some standard name, but I can't remember)

class FgFunctor f a b where
   fgmap :: (a->b) -> f a -> f b

-- regular functors are also fine-grained ones, e.g.
instance FgFunctor [] a b where
   fgmap = fmap

instance (Ord a, Ord b) => FgFunctor OrdTriple a b where
   fgmap f (OrdTriple n d x) = OrdTriple n' d' x'
      where [n', d', x'] = sort [f n, f d, f x]

Alternatively, one can parametrize the Functor class with a constraint:

{-# LANGUAGE GADTs, KindSignatures, MultiParamTypeClasses, 
    ConstraintKinds, TypeFamilies, FlexibleInstances #-}
{-# OPTIONS -Wall #-}
module CFunctor where

import Data.List (sort)
import Data.Kind (Constraint)

data OrdTriple a where
    OrdTriple :: (Ord a) => a -> a -> a -> OrdTriple a

class CFunctor (f :: * -> *) where
   type C f a :: Constraint
   cmap :: (C f a, C f b) => (a -> b) -> f a -> f b

-- regular functors are also constrained ones, e.g.
instance CFunctor [] where
   type C [] a = a ~ a
   cmap = fmap

instance CFunctor OrdTriple where
   type C OrdTriple a = Ord a
   cmap f (OrdTriple n d x) = OrdTriple n' d' x'
      where [n', d', x'] = sort [f n, f d, f x]


来源:https://stackoverflow.com/questions/42858898/context-in-data-instances

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!