Prism is like Iso except one of the two conversions is partial. Is there an optic where both conversions are partial?
Of course one can create a type (s -> Maybe a, b -> Maybe t) but I'm wondering if such a thing could be expressed an as Optic _ _?
You can generalize Isos (i.e., (s -> a, b -> t)) into (s -> m a, b -> m t) by replacing profunctors over Hask (i.e., Profunctor, that's the constraint in the definition of Iso as an Optic) with profunctors over Kleisli categories (here for the Maybe monad).
class Monad m => KProfunctor m p where
dimapM :: (s -> m a) -> (b -> m t) -> p a b -> p s t
-- dimapM pure pure = id
-- dimapM f g . dimapM h i = dimapM (h >=> f) (g >=> i)
type Optic p s t a b = p a b -> p s t
type KIso m s t a b = forall p. KProfunctor m p => Optic p s t a b
To construct one example of such profunctor, take the type of pseudo-isos (s -> m a, b -> m t) that we are trying to work with in the first place, and put s and t as the main indices:
data PseudoIso m a b s t = MkPseudoIso
{ toM :: s -> m a
, fromM :: b -> m t
}
instance Monad m => KProfunctor m (PseudoIso m) where
-- exercise for the reader
To go from PseudoIso to KIso, use dimapM (the fields of PseudoIso are exactly the right type for the arguments of dimapM)
To go from KIso to PseudoIso, partially apply to the identity PseudoIso a b a b
Actually, it doesn't have to be a Kleisli category. A profunctor over any category (:->) :: k -> k -> Type will give you a class of optics of the form (s :-> a, b :-> t).
Note: you can define an instance of Choice with KProfunctor Maybe, so maybe everything should really be specialized to Maybe so Choice could reasonably be added as a superclass of KProfunctor, then KIso would be a subtype of Prism.
Let us look at profunctor encoding. It's simpler.
Choice is a class for Prisms, we are making subclass of Prisms, so Choice is natural choice for a superclass:
class Choice p => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
If we try to write an instance for p = (->), it won't work.
So our new kind of optics is not a superclass of Setter.
The hierarchy would probably look something like: at best probably something like
(Can a Traversal and thus Lens be turned into the new Weird optic, maybe?)
Lens
/ \
Iso Traversal -> Setter
\ /
Prism
\
Weird
Let's try with another concrete Profunctors.
I'll use types as defined in my blog post: Glassery
ForgetM is used to implement preview
type Optic' p s a = p a a -> p s s
preview :: Optic' (ForgetM a) s a -> s -> Maybe a
preview o = runForgetM (o (ForgetM Just))
newtype ForgetM r a b = ForgetM { runForgetM :: a -> Maybe r }
instance Profunctor (ForgetM r) where
dimap f _ (ForgetM p) = ForgetM (p . f)
instance Choice (ForgetM r) where
right' (ForgetM p) = ForgetM (either (const Nothing) p)
instance Weird (ForgetM r) where
weird sa _bt (ForgetM ab) = ForgetM $ \s -> sa s >>= ab
TaggedM can be used to define something in oppisite direction (not in Glassery):
repreview :: Optic' TaggedM s a -> a -> Maybe s
repreview o a = unTaggedM (o (TaggedM (Just a)))
newtype TaggedM a b = TaggedM { unTaggedM :: Maybe b }
instance Profunctor TaggedM where
dimap _sa bt (TaggedM b) = TaggedM (fmap bt b)
instance Choice TaggedM where
right' (TaggedM b) = TaggedM (fmap Right b)
instance Weird TaggedM where
weird _sa bt (TaggedM b) = TaggedM (b >>= bt)
We can now try this.
Simple case works:
*Main> preview (weird Just Just) 'x'
Just 'x'
*Main> repreview (weird Just Just) 'x'
Just 'x'
Prisms can be used as new thing (thing right' = _Right):
*Main> preview right' (Left 'x')
Nothing
*Main> preview right' (Right 'x')
Just 'x'
There's also a nice symmetric Profunctor:
newtype Re p s t a b = Re { runRe :: p b a -> p t s }
instance Profunctor p => Profunctor (Re p s t) where
dimap f g (Re p) = Re (p . dimap g f)
instance Cochoice p => Choice (Re p s t) where
right' (Re p) = Re (p . unright)
instance Choice p => Cochoice (Re p s t) where
unright (Re p) = Re (p . right')
and we can write Weird instance for it:
instance Weird p => Weird (Re p s t) where
weird sa bt (Re p) = Re (p . weird bt sa)
And we notice that, we need to add Cochoice to be the superclass of Weird:
class (Choice p, Cochoice p) => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
That starts to look promising.
van-Laarhoven. That's tricky.
Compare Prism in profunctor and VL encodings:
type PrismVL s t a b = forall f p. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type PrismP s t a b = forall p. (Choice p) => p a b -> p s t
The good start is to assume that this Weird thing would look like
type WeirdOptic s t a b = forall p f. (Weird p, Applicative f) => Optic p f s t a b
Maybe we would need to strengten the f constraint too, a bit.
But I leave something for you to experiment with.
Also an open question is what's the intuition behind this new Weird optic;
and what laws it should have (to be an optic, and not just two functions
smashed together). It feels than trying to do similar Monad / Kleisli optic
with anything fancier than Maybe is difficult, but maybe it would work out too.
Here's a solution in lens-style optics (rather than profunctor optics as in the other answers) using the Filterable type-class:
-- A partial variant of (#) for partial reviews
infixr 8 #?
(#?) :: Optic Tagged Maybe s t a b -> b -> Maybe t
f #? b = Just b & Tagged & f & unTagged
-- A Prism "turned around", i.e a getter but a partial review
type InvPrism s t a b =
forall p f. (Profunctor p, Filterable f) => Optic p f s t a b
-- A partial iso-morphism, i.e a partial getter and partial review
type PartialIso s t a b =
forall p f. (Choice p, Applicative f, Filterable f) => Optic p f s t a b
-- Turn APrism around
invPrism :: APrism b a t s -> InvPrism s t a b
invPrism p =
dimap
(review (reviewing (clonePrism p)))
(mapMaybe (^? getting (clonePrism p)))
-- Create a PartialIso from two partial conversions
partialIso :: (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso sma ams =
dimap
(maybe (Left ()) Right . sma)
(catMaybes . either (const (pure Nothing)) (fmap ams)) .
right'
-- Coerce APrism to an Optic'
reviewing ::
(Choice p, Bifunctor p, Functor f, Settable f) =>
APrism s t a b -> Optic' p f t b
reviewing p =
bimap f (fmap f)
where
f = runIdentity . unTagged . clonePrism p . Tagged . Identity
Related
I'm learning Haskell by taking fp-course exercise. There is a question block my way. I don't know how Haskell infer lift2 (<$>) (,)'s type, and turn out Functor k => (a1 -> k a2) -> a1 -> k (a1, a2).
I have tried out lift2 (<$>)'s type, and verified by GHCI's command :t lift2 (<$>). step as follow.
I know lift2 :: Applicative k => (a -> b -> c) -> k a -> k b -> k c
I also know (<$>) :: Functor f => (m -> n) -> (f m) -> (f n)
Then by lambda calculus's Beta conversion, I can figure out lift2 (<$>)'s type is
(Applicative k, Functor f) => k (m -> n) -> k (f m) -> k (f n) by replacing a with (m -> n), b with (f m), c with (f n)
When I going to figure out lift2 (<$>) (,)'s type, It block me.
I know (,) :: a -> b -> (a,b)
And lift2 (<$>) :: (Applicative k, Functor f) => k (m -> n) -> k (f m) -> k (f n).
How does Haskell apply lift2 (<$>) to (,)?
The first variable of lift2 (<$>) is Applicative k => k (m -> n).
The to be applied value is (,) :: a -> b -> (a, b)
How the k, m, n replace by a, b?
GHCI's answer is lift2 (<$>) (,) :: Functor k => (a1 -> k a2) -> a1 -> k (a1, a2) by typing :t lift2 (<$>) (,). I cannot infer out this answer by myself.
So I have 2 questions.
1.Could someone show me the inference step by step?
2.In this case the conversion seems not be Beta conversion in lambda calculus (May be I am wrong). What the conversion is?
Type derivation is a mechanical affair.(*) The key is that the function arrow -> is actually a binary operator here, associating on the right (while the application / juxtaposition associates on the left).
Thus A -> B -> C is actually A -> (B -> C) is actually (->) A ((->) B C) is actually ((->) A) (((->) B) C). In this form it is clear that it consists of two parts so can match up with e.g. f t, noting the equivalences f ~ ((->) A) and t ~ (((->) B) C) (or in pseudocode f ~ (A ->), and also t ~ (B -> C) in normal notation).
When "applying" two type terms a structural unification is performed. The structures of two terms are matched up, their sub-parts are matched up, and the resulting equivalences are noted as "substitutions" (... ~ ...) available to be performed and ensured in further simplifications of the resulting type terms (and if some incompatibility were to be thus discovered, the type would be then rejected).
This follows a general structure / type derivation rule rooted in the logical rule of Modus Ponens:
A -> B C
--------------
B , where A ~ C
And thus,
liftA2 :: A f => ( a -> b -> c ) -> f a -> f b -> f c
(<$>) :: F h => (d -> e) -> h d -> h e
(,) :: s -> (t -> (s, t))
---------------------------------------------------------------------------------
liftA2 (<$>) (,) :: f b -> f c
---------------------------------------------------------------------------------
b ~ h d f ~ (s->)
a ~ d->e c ~ h e a ~ t->(s,t)
\_ _ _ _ _ _ _ _ _ _ _ _ _ _ a ~ d->e
----------------------------------------------------
d ~ t e ~ (s,t)
liftA2 (<$>) (,) :: f b -> f c
~ (s -> b ) -> (s -> c )
~ F h => (s -> h d) -> (s -> h e )
~ F h => (s -> h t) -> (s -> h (s,t))
(writing A for Applicative and F for Functor, as an abbreviation). The substitutions stop when there are no more type variables to substitute.
There's some freedom as to which type variables are chosen to be substituted on each step, but the resulting terms will be equivalent up to consistent renaming of the type variables, anyway. For example we could choose
~ F h => (s -> h d) -> (s -> h e )
~ F h => (s -> h d) -> (s -> h (s,t))
~ F h => (s -> h d) -> (s -> h (s,d))
The Applicative ((->) s) constraint was discovered in the process. It checks out since this instance exists for all s. We can see it by typing :i Applicative at the prompt in GHCi. Looking through the list of instances it prints, we find instance Applicative ((->) a) -- Defined in `Control.Applicative'.
If there were no such instance the type derivation would stop and report the error, it wouldn't just skip over it. But since the constraint holds, it just disappears as it does not constrain the derived type, Functor h => (s -> h t) -> (s -> h (s,t)). It's already "baked in".
The instance defines (f <*> g) x = f x $ g x but the definition itself is not needed in type derivations, only the fact that it exists. As for the liftA2, it is defined as
liftA2 h f g x = (h <$> f <*> g) x -- for any Applicative (sans the `x`)
= (h . f <*> g) x -- for functions
= (h . f) x (g x)
= f x `h` g x -- just another combinator
(yes, (<*>) = liftA2 ($) ), so
liftA2 (<$>) (,) g s = (,) s <$> g s
= do { r <- g s -- in pseudocode, with
; return (s, r) -- "Functorial" Do
}
Or in other words, liftA2 (<$>) (,) = \ g s -> (s ,) <$> g s.
With the type Functor m => (s -> m t) -> s -> m (s,t). Which is what we have derived.
(*) See also:
Haskell: how to infer the type of an expression manually
Could someone please provide me an example of
invmap :: (a -> b) -> (b -> a) -> f a -> f b
and for what is Invariant good for?
Mostly, people don't use Invariant. The reason you'd want to is if you're working with a type in which a variable appears in both covariant and contravariant positions.
newtype Endo a = Endo {appEndo :: a -> a}
newtype Foo a = Foo (Maybe a -> IO a)
data Bar a = Bar [a] (a -> Bool)
None of these are instances of Functor or Contravariant, but they can all be instances of Invariant.
The reason people rarely bother is that if you need to do a lot of mapping over such a type, you're typically better off factoring it out into covariant and contravariant parts. Each invariant functor can be expressed in terms of a Profunctor:
newtype FooP x y = FooP (Maybe x -> IO y)
data BarP x y = Bar [y] (x -> Bool)
Now
Endo a ~= (->) a a
Foo a ~= FooP a a
Bar a ~= BarP a a
-- So we'd likely write newtype Bar a = Bar (BarP a a)
It's generally easier to see what's going on if you unwrap the newtype, dimap over the underlying Profunctor, and then wrap it up again rather than messing around with invmap.
How can we transform an Invariant functor into a Profunctor? First, let's dispose of sums and products. If we can turn f and g into profunctors fp and gp, then we can surely turn f :+: g and f :*: g into equivalent profunctor sums and products.
What about compositions? It's slightly trickier, but not much. Suppose that we can turn f and g into profunctors fp and gp. Now define
-- Compose f g a ~= ComposeP fp gp a a
newtype ComposeP p q a b = ComposeP (p (q b a) (q a b))
instance (Profunctor p, Profunctor q) => Profunctor (ComposeP p q) where
dimap f g (ComposeP p) = ComposeP $ dimap (dimap g f) (dimap f g) p
Now suppose you have a function type; f a -> g a. This looks like fp b a -> gp a b.
I think that should cover most of the interesting cases.
Let's say I want to have a very generic ListF data type:
{-# LANGUAGE GADTs, DataKinds #-}
data ListF :: * -> * -> * where
Nil :: List a b
Cons :: a -> b -> List a b
Now I can use this data type with Data.Fix to build an f-algebra
import qualified Data.Fix as Fx
instance Functor (ListF a :: * -> *) where
fmap f (Cons x y) = Cons x (f y)
fmap _ Nil = Nil
sumOfNums = Fx.cata f (Fx.Fix $ Cons 2 (Fx.Fix $ Cons 3 (Fx.Fix $ Cons 5 (Fx.Fix Nil))))
where
f (Cons x y) = x + y
f Nil = 0
But how I can use this very generic data type ListF to create what I consider the default Functor instance for recursive lists (mapping over each value in the list)
I guess I could use a Bifunctor (mapping over the first value, traversing the second), but I don't know how that could ever work with Data.Fix.Fix?
Quite right to construct a recursive functor by taking the fixpoint of a bifunctor, because 1 + 1 = 2. The list node structure is given as a container with 2 sorts of substructure: "elements" and "sublists".
It can be troubling that we need a whole other notion of Functor (which captures a rather specific variety of functor, despite its rather general name), to construct a Functor as a fixpoint. We can, however (as a bit of a stunt), shift to a slightly more general notion of functor which is closed under fixpoints.
type p -:> q = forall i. p i -> q i
class FunctorIx (f :: (i -> *) -> (o -> *)) where
mapIx :: (p -:> q) -> f p -:> f q
These are the functors on indexed sets, so the names are not just gratuitous homages to Goscinny and Uderzo. You can think of o as "sorts of structure" and i as "sorts of substructure". Here's an example, based on the fact that 1 + 1 = 2.
data ListF :: (Either () () -> *) -> (() -> *) where
Nil :: ListF p '()
Cons :: p (Left '()) -> p (Right '()) -> ListF p '()
instance FunctorIx ListF where
mapIx f Nil = Nil
mapIx f (Cons a b) = Cons (f a) (f b)
To exploit the choice of substructure sort, we'll need a kind of type-level case analysis. We can't get away with a type function, as
we need it to be partially applied, and that's not allowed;
we need a bit at run time to tell us which sort is present.
data Case :: (i -> *) -> (j -> *) -> (Either i j -> *) where
CaseL :: p i -> Case p q (Left i)
CaseR :: q j -> Case p q (Right j)
caseMap :: (p -:> p') -> (q -:> q') -> Case p q -:> Case p' q'
caseMap f g (CaseL p) = CaseL (f p)
caseMap f g (CaseR q) = CaseR (g q)
And now we can take the fixpoint:
data Mu :: ((Either i j -> *) -> (j -> *)) ->
((i -> *) -> (j -> *)) where
In :: f (Case p (Mu f p)) j -> Mu f p j
In each substructure position, we do a case split to see whether we should have a p-element or a Mu f p substructure. And we get its functoriality.
instance FunctorIx f => FunctorIx (Mu f) where
mapIx f (In fpr) = In (mapIx (caseMap f (mapIx f)) fpr)
To build lists from these things, we need to juggle between * and () -> *.
newtype K a i = K {unK :: a}
type List a = Mu ListF (K a) '()
pattern NilP :: List a
pattern NilP = In Nil
pattern ConsP :: a -> List a -> List a
pattern ConsP a as = In (Cons (CaseL (K a)) (CaseR as))
Now, for lists, we get
map' :: (a -> b) -> List a -> List b
map' f = mapIx (K . f . unK)
I guess I could use a Bifunctor (mapping over the first value, traversing the second), but I don't know how that could ever work with Data.Fix.Fix?
You hit the nail on the head.
The bifunctors package contains a "Fix-for-bifunctors" type which looks like this:
newtype Fix f a = In { out :: f (Fix f a) a }
Fix f is a Functor whenever f is a Bifunctor. fmap recursively fmaps f's first parameter and maps the second.
instance Bifunctor f => Functor (Fix f) where
fmap f = In . bimap (fmap f) f . out
So your List example would look like this:
data ListF r a = Nil | Cons r a
type List = Fix ListF
map :: (a -> b) -> List a -> List b
map = fmap
Here is how we can define KleisliFunctor:
class (Monad m, Functor f) => KleisliFunctor m f where
kmap :: (a -> m b) -> f a -> f b
kmap f = kjoin . fmap f
kjoin :: f (m a) -> f a
kjoin = kmap id
Does this type class
class (Functor f, Monad m) => Absorb f m where
(>>~) :: f a -> (a -> m b) -> m b
a >>~ f = ajoin $ fmap f a
ajoin :: f (m a) -> m a
ajoin a = a >>~ id
fit somewhere into category theory? What are the laws? Are they
a >>~ g . f === fmap f a >>~ g
a >>~ (f >=> g) === a >>~ f >>= g
?
This is a speculative answer. Proceed with caution.
Let's first consider KleisliFunctor, focusing on the bind-like arrow mapping:
class (Monad m, Functor f) => KleisliFunctor m f where
kmap :: (a -> m b) -> f a -> f b
For this to actually be a functor from the Kleisli category of m to Hask, kmap has to follow the relevant functor laws:
-- Mapping the identity gives identity (in the other category).
kmap return = id
-- Mapping a composed arrow gives a composed arrow (in the other category).
kmap (g <=< f) = kmap g . kmap f
The fact that there are two Functors involved makes things a little unusual, but not unreasonable -- for instance, the laws do hold for mapMaybe, which is the first concrete example the KleisliFunctor post alludes to.
As for Absorb, I will flip the bind-like method for the sake of clarity:
class (Functor f, Monad m) => Absorb f m where
(~<<) :: (a -> m b) -> f a -> m b
If we are looking for something analogous to KleisliFunctor, a question that immediately arises is which category would have functions of type f a -> m b as arrows. It certainly cannot be Hask, as its identity (of type f a -> m a) cannot be id. We would have to figure out not only identity but also composition. For something that is not entirely unlike Monad...
idAbsorb :: f a -> m a
compAbsorb :: (f b -> m c) -> (f a -> m b) -> (f a -> m c)
... the only plausible thing I can think of right now is having a monad morphism as idAbsorb and using a second monad morphism in the opposite direction (that is, from m to f) so that compAbsorb can be implemented by applying the first function, then going back to f and finally applying the second function. We would need to work that out in order to see if my assumptions are appropriate, if this approach works, and if it leads to something useful for your purposes.
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