Created
March 10, 2015 01:20
-
-
Save pjrt/8bc6b1bf413dafc92a9c to your computer and use it in GitHub Desktop.
Turns out, you can represent a typeclass box as a simple constrained function returning a Coyoneda
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE GADTs #-} | |
import Data.Functor | |
import Control.Monad | |
import Control.Monad.Identity | |
-- Taken from Edward Kmett's definition | |
-- https://hackage.haskell.org/package/kan-extensions-3.7/docs/src/Data-Functor-Coyoneda.html#Coyoneda | |
data Coyoneda f a where | |
Coyoneda :: (b -> a) -> f b -> Coyoneda f a | |
instance Functor (Coyoneda f) where | |
fmap f (Coyoneda g v) = Coyoneda (f . g) v | |
liftCoyoneda :: f a -> Coyoneda f a | |
liftCoyoneda = Coyoneda id | |
lowerCoyoneda :: Functor f => Coyoneda f a -> f a | |
lowerCoyoneda (Coyoneda f m) = fmap f m | |
lowerM :: Monad m => Coyoneda m a -> m a | |
lowerM (Coyoneda m a) = liftM m a | |
-- An `Eraser a` is a coyoneda on Identity of `a` | |
type Eraser a = Coyoneda Identity a | |
runEraser :: Eraser a -> a | |
runEraser = runIdentity . lowerCoyoneda | |
-- Our typeclass | |
class Foo a where | |
foo :: a -> String | |
-- Data types | |
data Bar = Bar { bar :: Int } | |
data Baz = Baz { baz :: String } | |
instance Foo Bar where | |
foo (Bar a) = show a | |
instance Foo Baz where | |
foo (Baz a) = a | |
fooCoyo :: Foo a => a -> Eraser String | |
fooCoyo a = Coyoneda foo (Identity a) | |
main = do | |
let list = [fooCoyo (Bar 1), fooCoyo (Baz "Hello")] | |
print $ fmap runEraser list -- Prints ["1", "Hello"] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
As Chris pointed out, this isn't actually the same as the TypeclassBox. This assumes knowledge of the functions you will be calling before creating your list, while TypeclassBox does not (you decide which functions to call after the fact, on the fmap).