Is there a generalization of these Free-like constructions? - haskell

I was playing around with free-like ideas, and found this:
{-# LANGUAGE RankNTypes #-}
data Monoid m = Monoid { mempty :: m, mappend :: m -> m -> m }
data Generator a m = Generator { monoid :: Monoid m, singleton :: a -> m }
newtype Free f = Free { getFree :: forall s. f s -> s }
mkMonoid :: (forall s. f s -> Monoid s) -> Monoid (Free f)
mkMonoid f = Monoid {
mempty = Free (mempty . f),
mappend = \a b -> Free $ \s -> mappend (f s) (getFree a s) (getFree b s)
}
freeMonoid :: Monoid (Free Monoid)
freeMonoid = mkMonoid id
mkGenerator :: (forall s. f s -> Generator a s) -> Generator a (Free f)
mkGenerator f = Generator {
monoid = mkMonoid (monoid . f),
singleton = \x -> Free $ \s -> singleton (f s) x
}
freeGenerator :: Generator a (Free (Generator a))
freeGenerator = mkGenerator id
I would like to find the conditions under which I could write a funcion:
mkFree :: (??? f) => f (Free f)
but I have been unable to find a meaningful structure for f (other than the trivial one in which mkFree is a method of ???) which would allow this function to be written. In particular, my aesthetic sense would prefer if this structure did not mention the Free type.
Has anyone seen something like this before? Is this generalization possible? Is there a known generalization in a direction that I have not thought of yet?

The link to universal algebra was a good starting point, and after reading up on it a bit everything fell into place. What we're looking for is an F-algebra:
type Alg f x = f x -> x
for any (endo)functor f. For example, for a Monoid algebra the functor is:
data MonoidF m = MEmpty | MAppend m m deriving Functor
For any Monoid instance there's the obvious monoid algebra:
monoidAlg :: Monoid m => Alg MonoidF m
monoidAlg MEmpty = mempty
monoidAlg (MAppend a b) = mappend a b
Now we can take the free functor definition from the free-functors package, and replace the class constraint with the f-algebra:
newtype Free f a = Free { runFree :: forall b. Alg f b -> (a -> b) -> b }
The free functor is in some sense the best way to turn any set a into an algebra. This is how:
unit :: a -> Free f a
unit a = Free $ \_ k -> k a
It is the best way because for any other way to turn a into an algebra b, we can give a function from the free algebra to b:
rightAdjunct :: Functor f => Alg f b -> (a -> b) -> Free f a -> b
rightAdjunct alg k (Free f) = f alg k
What is left is to actually show that the free functor creates an f-algebra (and this is what you asked for):
freeAlg :: Functor f => Alg f (Free f a)
freeAlg ff = Free $ \alg k -> alg (fmap (rightAdjunct alg k) ff)
To explain a bit: ff is of type f (Free f a) and we need to build a Free f a. We can do that if we can build a b, given alg :: f b -> b and k :: a -> b. So we can apply alg to ff if we can map every Free f a it contains to a b, but that's exactly what rightAdjunct does with alg and k.
As you might have guessed, this Free f is the free monad on the functor f (the church encoded version to be precise.)
instance Functor f => Monad (Free f) where
return = unit
m >>= f = rightAdjunct freeAlg f m

Related

How to define a superclass constraint for free monoids?

Consider the following type class for free monoids.
class FreeMonoid f where
inj :: a -> f a
univ :: Monoid m => (a -> m) -> f a -> m
inj injects a value into the free monoid, and univ is the universal property of free monoids.
Instances of this class should satisfy the following laws.
Identity: univ f . inj = f
Free empty: univ f mempty = mempty
Free append: univ f (m <> n) = univ f m <> univ f n
Note that if f is an instance of FreeMonoid then (f a) must be an instance of Monoid. Otherwise, the last two laws don't make sense. So, how do I specify this constraint? Here's what I tried.
class Monoid (f a) => FreeMonoid f where
inj :: a -> f a
univ :: Monoid m => (a -> m) -> f a -> m
Not having this constraint makes it inconvenient to use this class. For example, consider the following function.
mapFreeMonoid :: (FreeMonoid f, Monoid (f b)) => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)
Since f is an instance of FreeMonoid, we shouldn't have to specify the Monoid (f b) constraint. Ideally, we should be able to define the above function as follows.
mapFreeMonoid :: FreeMonoid f => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)
You can try experimenting with the QuantifiedConstraints extension.
class (forall a. Monoid (f a)) => FreeMonoid f where
...
Your code then compiles without the additional constraint.
mapFreeMonoid :: FreeMonoid f => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)
You may use the QuantifiedConstraints extension as chi’s answer said. Take a look at the analogous definition for free categories, the CFree constraint here.

How can I instantiate Functor for this data type?

How Can I instantiate the following data types to be Functor ?
data LiftItOut f a = LiftItOut (f a)
data Parappa f g a = DaWrappa (f a) (g a)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
data Notorious g o a t = Notorious (g o) (g a) (g t)
There are not very clear for the declaration themselves, inside the parantheses in the right member, is that function application (I ve never seen that, only basic type constructors)? I am new to haskell and I am just trying to understand the basics.
Ask the compiler to show you how. Use the command line flag -ddump-deriv, enable the DeriveFunctor language extension, and put deriving Functor at the end of each type definition, and then the compiler will print Functor instances for each of them:
==================== Derived instances ====================
Derived class instances:
instance GHC.Base.Functor g =>
GHC.Base.Functor (Main.Notorious g o a) where
GHC.Base.fmap f_aK1 (Main.Notorious a1_aK2 a2_aK3 a3_aK4)
= Main.Notorious a1_aK2 a2_aK3 (GHC.Base.fmap f_aK1 a3_aK4)
(GHC.Base.<$) z_aK5 (Main.Notorious a1_aK6 a2_aK7 a3_aK8)
= Main.Notorious a1_aK6 a2_aK7 ((GHC.Base.<$) z_aK5 a3_aK8)
instance forall k (f :: k -> *) (g :: * -> *) (a :: k).
GHC.Base.Functor g =>
GHC.Base.Functor (Main.IgnoreOne f g a) where
GHC.Base.fmap f_aK9 (Main.IgnoringSomething a1_aKa a2_aKb)
= Main.IgnoringSomething a1_aKa (GHC.Base.fmap f_aK9 a2_aKb)
(GHC.Base.<$) z_aKc (Main.IgnoringSomething a1_aKd a2_aKe)
= Main.IgnoringSomething a1_aKd ((GHC.Base.<$) z_aKc a2_aKe)
instance (GHC.Base.Functor f, GHC.Base.Functor g) =>
GHC.Base.Functor (Main.Parappa f g) where
GHC.Base.fmap f_aKf (Main.DaWrappa a1_aKg a2_aKh)
= Main.DaWrappa
(GHC.Base.fmap f_aKf a1_aKg) (GHC.Base.fmap f_aKf a2_aKh)
(GHC.Base.<$) z_aKi (Main.DaWrappa a1_aKj a2_aKk)
= Main.DaWrappa
((GHC.Base.<$) z_aKi a1_aKj) ((GHC.Base.<$) z_aKi a2_aKk)
instance GHC.Base.Functor f =>
GHC.Base.Functor (Main.LiftItOut f) where
GHC.Base.fmap f_aKl (Main.LiftItOut a1_aKm)
= Main.LiftItOut (GHC.Base.fmap f_aKl a1_aKm)
(GHC.Base.<$) z_aKn (Main.LiftItOut a1_aKo)
= Main.LiftItOut ((GHC.Base.<$) z_aKn a1_aKo)
That's kind of messy-looking, but it's rather straightforward to clean up:
data LiftItOut f a = LiftItOut (f a)
instance Functor f => Functor (LiftItOut f) where
fmap f (LiftItOut a) = LiftItOut (fmap f a)
data Parappa f g a = DaWrappa (f a) (g a)
instance (Functor f, Functor g) => Functor (Parappa f g) where
fmap f (DaWrappa a1 a2) = DaWrappa (fmap f a1) (fmap f a2)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
instance Functor g => Functor (IgnoreOne f g a) where
fmap f (IgnoringSomething a1 a2) = IgnoringSomething a1 (fmap f a2)
data Notorious g o a t = Notorious (g o) (g a) (g t)
instance Functor g => Functor (Notorious g o a) where
fmap f (Notorious a1 a2 a3) = Notorious a1 a2 (fmap f a3)
Also worth noting that your LiftItOut is isomorphic to Ap and IdentityT, and your Parappa is isomorphic to Product.
A functor f is a type constructor with an associated function fmap that from a function of type (a -> b) creates a function of type (f a) -> (f b) which applies it "on the inside": (the parentheses are redundant and are used for clarity/emphasis only)
fmap :: (Functor f) => ( a -> b)
-> (f a) -> (f b)
-- i.e. g :: a -> b -- from this
-- --------------------------
-- fmap g :: (f a) -> (f b) -- we get this
(read it "fmap of g from a to b goes from f a to f b").
Put differently, something being a "Functor" means that it can be substituted for f in
fmap id (x :: f a) = x
(fmap g . fmap h) = fmap (g . h)
so that the expressions involved make sense (i.e. are well formed, i.e. have a type), and, importantly, the above equations hold -- they are in fact the two "Functor laws".
You have
data LiftItOut h a = MkLiftItOut (h a) -- "Mk..." for "Make..."
------------- ----------- ------
new type, data type of the data constructor's
defined here constructor one argument (one field)
This means h a is a type of a thing which can serve as an argument to MkLiftItOut. For example, Maybe Int (i.e. h ~ Maybe and a ~ Int), [(Float,String)] (i.e. h ~ [] and a ~ (Float,String)), etc.
h, a are type variables -- meaning, they can be replaced by any specific type so that the whole syntactic expressions make sense.
These syntactic expressions include MkLiftItOut x which is a thing of type LiftItOut h a provided x is a thing of type h a; LiftItOut h a which is a type; h a which is a type of a thing which can appear as an argument to MkLiftItOut. Thus we can have in our programs
v1 = MkLiftItOut ([1,2,3] :: [] Int ) :: LiftItOut [] Int
v2 = MkLiftItOut ((Just "") :: Maybe String) :: LiftItOut Maybe String
v3 = MkLiftItOut (Nothing :: Maybe () ) :: LiftItOut Maybe ()
.....
etc. Then we have
ghci> :i Functor
class Functor (f :: * -> *) where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
..........
This means that Functor f => (f a) is a type of a thing which a variable can reference, e.g.
-- f a
v4 = Just 4 :: Maybe Int
v41 = 4 :: Int
v5 = [4.4, 5.5] :: [] Float
v51 = 4.4 :: Float
v52 = 5.5 :: Float
v6 = (1,"a") :: ((,) Int) String -- or simpler, `(Int, String)`
v61 = "a" :: String
v7 = (\x -> 7) :: ((->) Int) Int -- or simpler, `Int -> Int`
Here a is a type of a thing, f a is a type of a thing, f is a type which, when given a type of a thing, becomes a type of a thing; etc. There's no thing which can be referenced by a variable which would have the type f on its own.
All the above fs are instances of the Functor typeclass. This means that somewhere in the libraries there are definitions of
instance Functor Maybe where ....
instance Functor [] where ....
instance Functor ((,) a) where ....
instance Functor ((->) r) where ....
Notice we always have the f, and the a. f in particular can be made of more than one constituents, but a is always some one type.
Thus in this case we must have
instance Functor (LiftItOut h) where ....
(...why? do convince yourself in this; see how all the above statements apply and are correct)
Then the actual definition must be
-- fmap :: (a -> b) -> f a -> f b
-- fmap :: (a -> b) -> LiftItOut h a -> LiftItOut h b
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
y = ....
In particular, we'll have
-- g :: a -> b -- x :: (h a) -- y :: (h b)
and we don't even know what the h is.
How can we solve this? How can we construct an h b-type of thing from an h a-type of thing when we don't even know anything about h, a, nor b?
We can't.
But what if we knew that h is also a Functor?
instance (Functor h) => Functor (LiftItOut h) where
-- fmap :: (a -> b) -> (f a) -> (f b)
-- fmap :: (a -> b) -> (LiftItOut h a) -> (LiftItOut h b)
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
-- fmap :: (a -> b) -> (h a) -> (h b)
y = ....
Hopefully you can finish this up. And also do the other types in your question as well. If not, post a new question for the one type with which you might have any further problems.

What's a good name for the natural transformation `forall a. m a -> (Identity ⊕ m) a`?

I found myself writing a bunch of functions with the signature
a -> Either longComplicatedType (m longComplicatedType)
So I decided I needed an alias
type SomeAlias m a = Either a (m a)
making it just a natural transformation on the functor m, isomorphic to forall a. m a -> (Identity ⊕ m) a.
At first I was tempted to name it MaybeN or MaybeF, as it either used the functor m or nothing. But Maybe a is isomorphic to 1 ⊕ a, and Identity isn't the terminal object in the category of endofunctors, Proxy is, so MaybeN f a should be Either (Proxy a) (f a).
Is there an existing name for forall a. m a -> (Identity ⊕ m) a I can steal from somewhere else? Failing that, is there a more elegant name than IdentityOr?
This appears to be isomorphic to InR from Data.Functor.Sum with f = Identity and g = m:
data Sum f g a = InL (f a) | InR (g a)
There was quite a bit of bikeshedding when the libraries committee chose those names, however; you may find some other alternatives there.
What you ask for exists under the name Lift
data Lift g a = Pure a | Other (g a)
This could be defined as a type synonym in terms of Sum and Identity
data Sum :: (k -> Type) -> (k -> Type) -> (k -> Type) where
InL :: f a -> (Sum f g) a
InR :: g a -> (Sum f g) a
newtype Identity :: Type -> Type where
Identity :: a -> Identity a
type Lift g a = (Sum Identity g) a
but this will not give you an Applicative or Alternative instance.
Sum f g is only an applicative under very specific circumstances (given a monoidal natural transformation forall xx. (Applicative g, Applicative f) => g xx -> f xx) (more info: Abstracting with Applicatives and Constructing Applicative Functors). This exists for
mnt :: forall xx. Applicative f => Identity xx -> f xx
mnt (Identity x) = pure x
and Lift g is that special case.

How do I give a Functor instance to a datatype built for general recursion schemes?

I have a recursive datatype which has a Functor instance:
data Expr1 a
= Val1 a
| Add1 (Expr1 a) (Expr1 a)
deriving (Eq, Show, Functor)
Now, I'm interested in modifying this datatype to support general recursion schemes, as they are described in this tutorial and this Hackage package. I managed to get the catamorphism to work:
newtype Fix f = Fix {unFix :: f (Fix f)}
data ExprF a r
= Val a
| Add r r
deriving (Eq, Show, Functor)
type Expr2 a = Fix (ExprF a)
cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix
eval :: Expr2 Int -> Int
eval = cata $ \case
Val n -> n
Add x y -> x + y
main :: IO ()
main =
print $ eval
(Fix (Add (Fix (Val 1)) (Fix (Val 2))))
But now I can't figure out how to give Expr2 the same functor instance that the original Expr had. It seems there is a kind mismatch when trying to define the functor instance:
instance Functor (Fix (ExprF a)) where
fmap = undefined
Kind mis-match
The first argument of `Functor' should have kind `* -> *',
but `Fix (ExprF a)' has kind `*'
In the instance declaration for `Functor (Fix (ExprF a))'
How do I write a Functor instance for Expr2?
I thought about wrapping Expr2 in a newtype with newtype Expr2 a = Expr2 (Fix (ExprF a)) but then this newtype needs to be unwrapped to be passed to cata, which I don't like very much. I also don't know if it would be possible to automatically derive the Expr2 functor instance like I did with Expr1.
This is an old sore for me. The crucial point is that your ExprF is functorial in both its parameters. So if we had
class Bifunctor b where
bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2
then you could define (or imagine a machine defining for you)
instance Bifunctor ExprF where
bimap k1 k2 (Val a) = Val (k1 a)
bimap k1 k2 (Add x y) = Add (k2 x) (k2 y)
and now you can have
newtype Fix2 b a = MkFix2 (b a (Fix2 b a))
accompanied by
map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar)
which in turn gives you that when you take a fixpoint in one of the parameters, what's left is still functorial in the other
instance Bifunctor b => Functor (Fix2 b) where
fmap k = map1cata2 k MkFix2
and you sort of get what you wanted. But your Bifunctor instance isn't going to be built by magic. And it's a bit annoying that you need a different fixpoint operator and a whole new kind of functor. The trouble is that you now have two sorts of substructure: "values" and "subexpressions".
And here's the turn. There is a notion of functor which is closed under fixpoints. Turn on the kitchen sink (especially DataKinds) and
type s :-> t = forall x. s x -> t x
class FunctorIx (f :: (i -> *) -> (o -> *)) where
mapIx :: (s :-> t) -> f s :-> f t
Note that "elements" come in a kind indexed over i and "structures" in a kind indexed over some other o. We take i-preserving functions on elements to o preserving functions on structures. Crucially, i and o can be different.
The magic words are "1, 2, 4, 8, time to exponentiate!". A type of kind * can easily be turned into a trivially indexed GADT of kind () -> *. And two types can be rolled together to make a GADT of kind Either () () -> *. That means we can roll both sorts of substructure together. In general, we have a kind of type level either.
data Case :: (a -> *) -> (b -> *) -> Either a b -> * where
CL :: f a -> Case f g (Left a)
CR :: g b -> Case f g (Right b)
equipped with its notion of "map"
mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
mapCase ff gg (CL fx) = CL (ff fx)
mapCase ff gg (CR gx) = CR (gg gx)
So we can refunctor our bifactors as Either-indexed FunctorIx instances.
And now we can take the fixpoint of any node structure f which has places for either elements p or subnodes. It's just the same deal we had above.
newtype FixIx (f :: (Either i o -> *) -> (o -> *))
(p :: i -> *)
(b :: o)
= MkFixIx (f (Case p (FixIx f p)) b)
mapCata :: forall f p q t. FunctorIx f =>
(p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node)
But now, we get the fact that FunctorIx is closed under FixIx.
instance FunctorIx f => FunctorIx (FixIx f) where
mapIx f = mapCata f MkFixIx
Functors on indexed sets (with the extra freedom to vary the index) can be very precise and very powerful. They enjoy many more convenient closure properties than Functors do. I don't suppose they'll catch on.
I wonder if you might be better off using the Free type:
data Free f a
= Pure a
| Wrap (f (Free f a))
deriving Functor
data ExprF r
= Add r r
deriving Functor
This has the added benefit that there are quite a few libraries that work on free monads already, so maybe they'll save you some work.
Nothing wrong with pigworker's answer, but maybe you can use a simpler one as a stepping-stone:
{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}
import Prelude hiding (map)
newtype Fix f = Fix { unFix :: f (Fix f) }
-- This is the catamorphism function you hopefully know and love
-- already. Generalizes 'foldr'.
cata :: Functor f => (f r -> r) -> Fix f -> r
cata phi = phi . fmap (cata phi) . unFix
-- The 'Bifunctor' class. You can find this in Hackage, so if you
-- want to use this just use it from there.
--
-- Minimal definition: either 'bimap' or both 'first' and 'second'.
class Bifunctor f where
bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
bimap f g = first f . second g
first :: (a -> c) -> f a b -> f c b
first f = bimap f id
second :: (b -> d) -> f a b -> f a d
second g = bimap id g
-- The generic map function. I wrote this out with
-- ScopedTypeVariables to make it easier to read...
map :: forall f a b. (Functor (f a), Bifunctor f) =>
(a -> b) -> Fix (f a) -> Fix (f b)
map f = cata phi
where phi :: f a (Fix (f b)) -> Fix (f b)
phi = Fix . first f
Now your expression language works like this:
-- This is the base (bi)functor for your expression type.
data ExprF a r = Val a
| Add r r
deriving (Eq, Show, Functor)
instance Bifunctor ExprF where
bimap f g (Val a) = Val (f a)
bimap f g (Add l r) = Add (g l) (g r)
newtype Expr a = Expr (Fix (ExprF a))
instance Functor Expr where
fmap f (Expr exprF) = Expr (map f exprF)
EDIT: Here's a link to the bifunctors package in Hackage.
The keyword type is used only as a synonymous of an existing type, maybe this is what you are looking for
newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor

Writing a foldMap in Haskell

I am trying to write my own foldMap function as an excersice to learn Haskell
Currently it looks like this
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold (<>) mempty (fmap g a)
However when compiling it it gives the following error
Could not deduce (Monoid ((f m -> m) -> fm -> m)) arising from use of 'fold'
from the context (Foldable f) bound by the class declaration for 'Foldable' at (file location)
or from (Monoid m) bound by the type signature for foldMap :: Monoid m => (a -> m) -> f a -> m at (file location
In the expression fold (<>) mempty (fmap g a)
In an equation for 'foldMap':
foldMap g a = fold (<>) mempty (fmap g a)
I can't figure out what the compiler is trying to tell me with this error, can anyone tell me what goes wrong with my foldMap?
Maybe we should do an answer with the actual solution:
I hope it's now clear, that this is a possible definition:
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
follow the types
Andrew and Lee already gave you a high level explanation but maybe I can give you another view on it:
Let's just follow the types to oget to this answer:
We want a function f a -> m where m is a monoid and f is a functor. In addition we have a function g :: a -> m we can use to get from some a into the monoid - nice.
Now we get some additional functions:
fold :: f m -> m from our own class
fmap :: (a -> b) -> f a -> f b from the Functor f
Ok we need f a -> m now if only the a would be an m then we could use fold ... dang.
But wait: we can make a a into a m using g- but the a is packed into f ... dang.
Oh wait: we can make a f a into a f m using fmap .... ding-ding-ding
So let's do it:
make f a into f m: fmap g a
use fold on it: fold (fmap g a)
or using $:
foldMap g a = fold $ fmap g a
example
Let's get something so we can try:
module Foldable where
import Data.Monoid
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
instance Foldable [] where
fold [] = mempty
fold (x:xs) = mappend x (fold xs)
here is a simple example using this with Sum and [1..4]:
λ> foldMap Sum [1..4]
Sum {getSum = 10}
which seems fine to me.
A Monoid has two functions, mappend and mempty, and you can use (<>) in place of mappend.
Typeclasses work because the compiler inserts the appropriate definition for the function depending on the types of the data, so (happily) there's no need to pass around the function in question.
The mistake you've made is to unnecessarily pass the Monoid functions you're using in.
For example, if I defined a function to test if something was in a list like this:
isin :: Eq a => a -> [a] -> Bool
isin equalityFunction a list = any (equalityFunction a) list
I'd have unnecessarily tried to pass the equalityFunction as an argument, and the type signature doesn't match it.
Instead I should define
isin :: Eq a => a -> [a] -> Bool
isin a list = any (== a) list
using the standard name for the equality function as defined in the Eq typeclass.
Similarly, you neither need nor should pass the (<>) or empty arguments.

Resources