CoyonedaInSpirit.hs

#!/usr/bin/env stack
-- stack --resolver lts-16.3 --install-ghc exec ghci

{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

import Data.Set (Set)
import qualified Data.Set as Set

data Coyoneda f a where
  MkCoyoneda :: (b -> a) -> f b -> Coyoneda f a

instance Functor (Coyoneda f) where
  fmap g (MkCoyoneda f thing) = MkCoyoneda (g . f) thing

toCoyoneda :: f a -> Coyoneda f a
toCoyoneda thing = MkCoyoneda id thing

fromCoyoneda :: Functor f => Coyoneda f a -> f a
fromCoyoneda (MkCoyoneda f thing) = fmap f thing

-- No dice because fromCoyoneda requires Set to be a Functor to get the Set out.
-- foo :: Set Int -> Set Int
-- foo set =
--   fromCoyoneda
--     $ fmap (+ 1)
--     $ fmap (* 3)
--     $ toCoyoneda set

------------------------------------------------------------------------------

data CoyonedaInSpirit f a where
  MkCoyonedaInSpirit :: (b -> a) -> f b -> CoyonedaInSpirit f a

instance Functor (CoyonedaInSpirit f) where
  fmap g (MkCoyonedaInSpirit f thing) = MkCoyonedaInSpirit (g . f) thing

toCoyonedaInSpirit :: f a -> CoyonedaInSpirit f a
toCoyonedaInSpirit thing = MkCoyonedaInSpirit id thing

fromCoyonedaInSpirit
  :: (forall b. (b -> a) -> f b -> f a)
  -> CoyonedaInSpirit f a
  -> f a
fromCoyonedaInSpirit mapper (MkCoyonedaInSpirit f thing) = mapper f thing

bar :: Set Int -> Set Int
bar set =
  fromCoyonedaInSpirit Set.map
    $ fmap (+ 1)
    $ fmap (* 3)
    $ toCoyonedaInSpirit set