[Haskell-cafe] Re: is there a more concise way to generate helper
functions for a datatype built on records?
apfelmus
apfelmus at quantentunnel.de
Mon Nov 26 10:03:13 EST 2007
Benedikt Huber wrote:
> > type Upd a = a -> a
> > data Ref cx t
> > = Ref { select :: cx -> t , update :: Upd t -> Upd cx }
Functional references are also called "lens", I'm going to use that term
from now on.
As a minor note, I somehow prefer a single primitive
data Lens s a = Lens { focus :: s -> (a, a -> s) }
put :: Lens s a -> a -> s -> s
put x = flip $ snd . focus x
get :: Lens s a -> s -> a
get x = fst . focus x
update :: Lens s a -> (a -> a) -> (s -> s)
update x f s = let (a,g) = focus x s in g (f a)
> So, the Ref deriviation is really nice for sequential updates;
> parallel updates on the other hand need some work.
> Furthermore, I don't really know how well Refs work if updates
> need information on other parts of the state without modifying it.
> (e.g. the AI player needs to know where the ball is, but does not modify
> the ball).
It's just a question of the right combinators, I hope? For sequential
composition, lenses are morphisms of a category
class Category c where
id :: c a a
(.) :: c b d -> c a b -> c a d
instance Category Lens where
id = Lens $ \a -> (a, id)
y . x = Lens $ \a ->
let (b,f) = focus x a; (c,g) = focus y b; in (c,g . f)
For parallel composition, we have stuff corresponding to arrow functions
like
fst :: Lens (a,b) a
fst = Lens $ \(a,b) -> (a, \a' -> (a',b))
swap :: Lens (a,b) (b,a)
swap = Lens $ \(a,b) -> ((b,a),\(b',a') -> (a',b'))
snd :: Lens (a,b) b
snd = fst . swap
first :: Lens a b -> Lens (a,c) (b,c)
first x = Lens $ \(a,c) ->
let (b,f) = focus x a in (b,\b' -> (f b',c))
second :: Lens a b -> Lens (c,a) (c,b)
second x = swap . first x . swap
Then, there's also
(***) :: Lens a b -> Lens c d -> Lens (a,c) (b,d)
x *** y = second y . first x
but this is symmetric in x and y, the order matters.
For a class hierarchy proposal, see
http://thread.gmane.org/gmane.comp.lang.haskell.libraries/7663/focus=7777
but I think it needs further research, i.e. concerning whether the
interface is minimal or corresponds to well-known categories.
> To get it *actually* work in parallel we have to create a new reference for both players:
>
>> refPlayers :: Ref Game (Player,Player)
>> refPlayers = Ref { select = select refP1 &&& select refP2,
>> update = \pu g -> let (p1',p2') =
> pu (p1 g, p2 g) in g { p1 = p1', p2 = p2' } }
>
> While the select part of the Ref is expressed using &&&, I don't know how the
> parallel update can be expressed in terms of combinators. Any hints ?
You can't do that, and for good reason! While
players :: Lens Game (Player,Player)
is entirely fine since Game ~ (Player,Player,Object2D), there cannot be
a general parallel combinator
(&&&) :: Lens a b -> Lens a c -> Lens a (b,c)
with for example
players = player1 &&& player2
That's because the two arguments might not be parallel at all. For
instance, consider
dup :: Lens a (a,a)
dup = id &&& id
Which component of the pair should
put dup :: a -> (a,a) -> (a,a)
change? The first, the second, or even both?
Regards,
apfelmus
More information about the Haskell-Cafe
mailing list