<div dir="auto">The ConstraintKinds extension just lets you deal with kinds involving constraints. Turn it on, import the Constraint kind from somewhere (I know it's exported from GHC.Exts and also from Data.Constraint in the constraints package; I don't know if it has a nice home in base). Then you can write things like<div dir="auto"><br></div><div dir="auto">class C f a where</div><div dir="auto">  p :: f a => proxy f -> a -> Int</div><div dir="auto"><br></div><div dir="auto">etc.</div></div><div class="gmail_extra"><br><div class="gmail_quote">On Jan 23, 2017 4:19 PM, "Olaf Klinke" <<a href="mailto:olf@aatal-apotheke.de">olf@aatal-apotheke.de</a>> wrote:<br type="attribution"><blockquote class="quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">On a mostly unrelated note, Dan Doel elaborated [1] that the list monad is not the monad of free monoids either, even though mathematically the free monoid over x is the set of words of finite length with alphabet x. Briefly, the reason is that Haskell types are domains, not sets.<br>
<br>
Below is a proof that the free monad is not the free algebra.<br>
<br>
One approximant to free algebraic structures is to look at the free F-algebra for a functor F. This approach does not take into account any equations between the algebraic operations.<br>
<br>
{-# LANGUAGE Rank2Types,<wbr>MultiParamTypeClasses,<wbr>FlexibleInstances,<wbr>FlexibleContexts #-}<br>
module FreeFAlg where<br>
import Control.Applicative<br>
import Control.Monad<br>
<br>
-- F-algebras (sans laws).<br>
class Functor f => Alg f a where<br>
    alg :: f a -> a<br>
<br>
-- The free F-algebra over x, following Dan Doel's ideas,<br>
-- with the universal property baked in.<br>
newtype FreeAlg f x = FreeAlg (forall a. Alg f a => (x -> a) -> a)<br>
runFree :: Alg f a => FreeAlg f x -> (x -> a) -> a<br>
runFree (FreeAlg f) = f<br>
universal :: Alg f a => (x -> a) -> FreeAlg f x -> a<br>
universal = flip runFree<br>
instance Functor f => Alg f (FreeAlg f x) where<br>
    alg ff = FreeAlg (\f -> alg (fmap (($f).runFree) ff))<br>
instance Functor (FreeAlg f) where<br>
    fmap h (FreeAlg fx) = FreeAlg (\f -> fx (f.h))<br>
instance Monad (FreeAlg f) where<br>
    return x = FreeAlg ($x)<br>
    (FreeAlg fx) >>= k = FreeAlg (\f -> fx (\x -> runFree (k x) f))<br>
instance Applicative (FreeAlg f) where<br>
    pure = return<br>
    (<*>) = ap<br>
<br>
data FreeMonad f x = Pure x | Roll (f (FreeMonad f x))<br>
instance Functor f => Alg f (FreeMonad f x) where<br>
    alg = Roll<br>
<br>
-- This looks like the same universal property...<br>
universal' :: Alg f a => (x -> a) -> FreeMonad f x -> a<br>
universal' f (Pure x) = f x<br>
universal' f (Roll ffree) = alg  (fmap (universal' f) ffree)<br>
<br>
freeAlg2freeMonad :: Functor f => FreeAlg f x -> FreeMonad f x<br>
freeAlg2freeMonad = universal Pure<br>
freeMonad2freeAlg :: Functor f => FreeMonad f x -> FreeAlg f x<br>
freeMonad2freeAlg = universal' return<br>
<br>
The free monad is not the free F-algebra, because uniqueness fails.<br>
Consider the constant functor<br>
<br>
data Point a = Point<br>
instance Functor Point where<br>
    fmap f Point = Point<br>
-- universal' f (Pure x) = f x<br>
-- universal' f (Roll Point) = alg Point<br>
-- but we have another function with the same type as universal':<br>
notUnique :: Alg Point a => (x -> a) -> FreeMonad Point x -> a<br>
notUnique f = const (alg Point)<br>
<br>
For classes like Monoid, which have equations between the algebraic operations (such as mappend mempty = id), we'd need the language extension that allows constraints as type parameters. I'd like to write<br>
<br>
Free Monoid x = Free (forall a. Monid a => (x -> a) -> a)<br>
<br>
but I am not experienced with the ConstraintKinds extension. Anyone help?<br>
<br>
Olaf<br>
<br>
[1] <a href="http://comonad.com/reader/2015/free-monoids-in-haskell/" rel="noreferrer" target="_blank">http://comonad.com/reader/<wbr>2015/free-monoids-in-haskell/</a><br>
<div class="elided-text">______________________________<wbr>_________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</div></blockquote></div><br></div>