[Haskell-cafe] Type families again

[Ganesh Sittampalam]

On Thu, 2 Dec 2010, Robert Greayer wrote:

> On Thu, Dec 2, 2010 at 4:39 PM, Antoine Latter <aslatter at gmail.com> wrote:
>> On Thu, Dec 2, 2010 at 3:29 PM, Andrew Coppin
>> <andrewcoppin at btinternet.com> wrote:
>>>
>>> What we /can't/ do is define a polymorphic map function. One might try to do
>>> something like
>>>
>>>  class Functor f where
>>>    type Element f :: *
>>>    fmap :: (Element f2 ~ y) => (x -> y) -> f -> f2
>>>
>>>  instance Functor [x] where
>>>    type Element [x] = x
>>>    fmap = map
>>>
>>> However, this fails. Put simply, the type for fmap fails to specify that f
>>> and f2 must be /the same type of thing/, just with different element types.
>>>
>>> The trouble is, after spending quite a bit of brainpower, I literally cannot
>>> think of a way of writing such a constraint. Does anybody have any
>>> suggestions?
>>
>> Does this do what you need?
>>
>> http://hackage.haskell.org/packages/archive/rmonad/0.6/doc/html/Control-RMonad.html#t:RFunctor
>>
>> Antoine
>>
>
> I think this doesn't handle the ByteString case (wrong kind).  Here's
> another mostly unsatisfactory (injectivity issues) solution that may
> possibly not even work though it does compile:

I spent a while looking at this a couple of months ago after a similar 
question. What I came up with is below; I haven't got as far as 
deciding whether or how to incorporate this into rmonad. Also, the Const 
type actually already exists in Control.Applicative.

Cheers,

Ganesh

{-# LANGUAGE GADTs, TypeFamilies, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, RankNTypes #-}

module Control.RMonad.Wibble where

import Control.RMonad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Suitable
import GHC.Word (Word8)

-- Part I

-- a little warmup: ByteStrings

-- We have two choices for BSWrapper. Either make
-- it a GADT, which means we can leave out the match on the
-- argument constraints below, or make it a H98 phantom.
-- The second option seems cleaner and more symmetric.
-- It also means we can us newtype to avoid runtime overhead.

-- data BSWrapper a where
--   BSWrapper :: ByteString -> BSWrapper Word8

newtype BSWrapper a = BSWrapper ByteString

data instance Constraints BSWrapper a = (a ~ Word8) => BSConstraints

instance Suitable BSWrapper Word8 where
   constraints = BSConstraints

instance RFunctor BSWrapper where
   -- We could also use withResConstraints by rearranging the arguments to mymap so Constraints is last
   fmap = mymap constraints constraints
     where mymap :: forall x y . Constraints BSWrapper x -> Constraints BSWrapper y -> (x -> y) -> BSWrapper x -> BSWrapper y
           mymap BSConstraints BSConstraints f (BSWrapper x) = BSWrapper (BS.map f x)

-- Part II

-- OK, now let's generalise:

-- Having a class here rather than a plain type family isn't really necessary,
-- but it feels natural
class SingletonContainer c where
    type ContainedType c :: *

-- data SingletonWrapper c a where
--   SingletonWrapper :: SingletonContainer c => c -> SingletonWrapper c (ContainedType c)

-- This is just a generic Const type. Is there a standard one somewhere else?
newtype SingletonWrapper c a = SingletonWrapper c

data instance Constraints (SingletonWrapper c) a = (a ~ ContainedType c) => SingletonConstraints

-- important to use the type equality constraint here instead of inlining it
-- on the RHS, as otherwise instance resolution would get stuck
instance (a ~ ContainedType c) => Suitable (SingletonWrapper c) a where
   constraints = SingletonConstraints

class SingletonContainer c => Mappable c where
    lmap :: (ContainedType c -> ContainedType c) -> c -> c

instance Mappable c => RFunctor (SingletonWrapper c) where
   fmap = mymap constraints constraints
     where mymap :: forall x y
                  . Constraints (SingletonWrapper c) x
                 -> Constraints (SingletonWrapper c) y
                 -> (x -> y)
                 -> SingletonWrapper c x
                 -> SingletonWrapper c y
           mymap SingletonConstraints SingletonConstraints f (SingletonWrapper x) = SingletonWrapper (lmap f x)


-- so, why is Word8 the blessed instance? Why not Char (from Data.ByteString.Char8)?
instance SingletonContainer ByteString where
    type ContainedType ByteString = Word8


-- Part III

-- and finally, let's try to generalise the Singleton concept:

-- using the Const concept again...
newtype Const a b = Const a

instance Show a => Show (Const a b) where
   show (Const x) = show x

data instance Constraints (Const ByteString) a =
    (a ~ Word8) => BSConstraintsWord8
  | (a ~ Char) => BSConstraintsChar

instance Suitable (Const ByteString) Word8 where
    constraints = BSConstraintsWord8

instance Suitable (Const ByteString) Char where
    constraints = BSConstraintsChar

instance RFunctor (Const ByteString) where
   fmap = mymap constraints constraints
     where mymap :: forall x y
                  . Constraints (Const ByteString) x
                 -> Constraints (Const ByteString) y
                 -> (x -> y) -> Const ByteString x -> Const ByteString y

           mymap BSConstraintsWord8 BSConstraintsWord8 f (Const x) = Const (BS.map  f x)
           mymap BSConstraintsChar  BSConstraintsChar  f (Const x) = Const (BSC.map f x)
           -- but what can we do with the "cross-product" cases?