Can I implement this newtype as a composition of other types?

Question

I've written a newtype Const3 that's very similar to Const, but contains the first of three given type arguments:

newtype Const3 a b c = Const3 { getConst3 :: a }

I can define very many useful instances for this newtype, but I'd have to do it all myself.

However, the function I'm applying on the type level resembles the function

\a b c -> a

which @pl tells me is equivalent to const . const.

Both (.) and const have matching newtype wrappers: Compose and Const. So I figured I'd be able to write:

type Const3 = Compose Const Const

And inherit useful instances automatically, such as:

instance Functor (Const m)
instance (Functor f, Functor g) => Functor (Compose f g)
-- a free Functor instance for Const3!

But GHC disagrees:

const3.hs:5:23:
    Expecting one more argument to ‘Const’
    The first argument of ‘Compose’ should have kind ‘* -> *’,
      but ‘Const’ has kind ‘* -> * -> *’
    In the type ‘Compose Const Const’
    In the type declaration for ‘Const3’

This seems to be related to the kinds of Compose and Const:

*Main> :k Compose
Compose :: (* -> *) -> (* -> *) -> * -> *
*Main> :k Const
Const :: * -> * -> *

So after a little bit of searching, I found that there's a GHC extension called PolyKinds that allows me to do something like:

{-# LANGUAGE PolyKinds #-}
newtype Compose f g a = Compose { getCompose :: f (g a) }
newtype Const a b = Const { getConst :: a }

And as if by magic the kinds are right:

 *Main> :k Compose
 Compose :: (k -> *) -> (k1 -> k) -> k1 -> *
 *Main> :k Const
 Const :: * -> k -> *

But I still can't compose them to write Const3 = Compose Const Const.

const3.hs:12:23:
    Expecting one more argument to ‘Const’
    The first argument of ‘Compose’ should have kind ‘* -> *’,
      but ‘Const’ has kind ‘* -> k0 -> *’
    In the type ‘Compose Const Const’
    In the type declaration for ‘Const3’

What gives? Is there some clever way to do this, so I can reap the benefits of inheriting the Functor etc. instances from Const and Compose?

(As a side note, the original thought that led me to Const3 was writing:

newtype Const3 a b c = Const3 { getConst3 :: a }

instance Monoid m => Category (Const3 m) where
  id = Const3 mempty
  Const3 x . Const3 y = Const3 (mappend x y)

capturing the idea that a monoid is a single-object category. It would be nice if there's a solution that still allows me to write the above instance somehow.)

Answer 1

The thing that's confusing—or, at least, the thing that confused me—is that * acts like a concrete type, not a type variable. So without PolyKinds, Compose has a type that's more like:

compose :: (A -> A) -> (A -> A) -> A -> A

Crucially, we can't replace an A with A -> A because they'd be different types, so, by the same logic, we can't replace * with * -> * either.

Even with PolyKinds, the kinds still aren't right. In particular, Compose expects (k -> *) as its first argument and you're trying to give it (k -> (k2 -> *)).

The reason you're forced to return a * kind is because you're using newtypes, and newtypes have to return a concrete type (ie of kind *). I tried to overcome this by turning Compose into a type synonym which finally had exactly the kind we want (with PolyKinds):

type Compose f g a = (f (g a))

λ> :k Compose
Compose :: (k1 -> k) -> (k2 -> k1) -> k2 -> k

However, using this still gave me a similar error, and I'm not certain if we can get it to work properly. The problem arose because applying Compose to the first Const gives us a kind with a * in it, probably because on limitations of type aliases like this:

λ> :k Compose Const
Compose Const :: (k -> *) -> k -> k1 -> *

Answer 2

From the other answers, it seems like it's not that easy, however if the only thing you want to have are the "free" instances, one quick way is using a newtype over the regular Const with the GeneralizedNewtypeDeriving extension:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE PatternSynonyms #-}
module ConstThree (Const3,pattern Const3,getConst3) where
import Data.Foldable
import Data.Traversable
import Control.Applicative
import Data.Monoid

newtype Const3 a b c = MkConst3 (Const a c) deriving (Functor,Applicative,Foldable,Traversable,Eq,Ord,Show,Monoid)

pattern Const3 :: a -> Const3 a b c
pattern Const3 x = MkConst3 (Const x)

getConst3 :: Const3 a b c -> a
getConst3 (Const3 x) = x

In the above, I'm also using PatternSynonyms to hide the internal use of Const from clients.

This is what you get:

λ> :t Const3
Const3 :: a -> Const3 a b c
λ> :t getConst3
getConst3 :: Const3 a b c -> a
λ> :i Const3
pattern Const3 :: a -> Const3 a b c
        -- Defined at /tmp/alpha-dbcdf.hs:13:5

type role Const3 representational phantom phantom
newtype Const3 a b c = MkConst3 (Const a c)
        -- Defined at /tmp/alpha-dbcdf.hs:10:5
instance Eq a => Eq (Const3 a b c)
  -- Defined at /tmp/alpha-dbcdf.hs:10:100
instance Functor (Const3 a b)
  -- Defined at /tmp/alpha-dbcdf.hs:10:59
instance Ord a => Ord (Const3 a b c)
  -- Defined at /tmp/alpha-dbcdf.hs:10:103
instance Show a => Show (Const3 a b c)
  -- Defined at /tmp/alpha-dbcdf.hs:10:107
instance Monoid a => Applicative (Const3 a b)
  -- Defined at /tmp/alpha-dbcdf.hs:10:67
instance Foldable (Const3 a b)
  -- Defined at /tmp/alpha-dbcdf.hs:10:79
instance Traversable (Const3 a b)
  -- Defined at /tmp/alpha-dbcdf.hs:10:88
instance Monoid a => Monoid (Const3 a b c)
  -- Defined at /tmp/alpha-dbcdf.hs:10:112

And as expected you can do:

instance Monoid m => Category (Const3 m) where
  id = Const3 mempty
  Const3 x . Const3 y = Const3 (mappend x y)