*rwbarton*
2012-11-15 03:34:53.449869 UTC

1 | > {-# LANGUAGE RankNTypes, DeriveFunctor #-} |

2 | |

3 | > import Control.Arrow (left) |

4 | > import Control.Monad.Identity |

5 | |

6 | Colenses are supposed to capture the way a summand sits inside a sum |

7 | type in the same way that lenses capture the way a field sits inside a |

8 | record type. |

9 | |

10 | Canonical lens example: record X x Y with field X, other fields Y |

11 | |

12 | p : X x Y -> X -- projection |

13 | n : X x (X x Y) -> X x Y -- use "new" value (projection onto 1st, 3rd components of input) |

14 | |

15 | Canonical colens example: sum X |_| Y with summand X, other summands Y |

16 | |

17 | p* : X -> X |_| Y |

18 | n* : X |_| Y -> X |_| (X |_| Y) |

19 | |

20 | > type NaiveColens a b = (b -> a, a -> Either b a) |

21 | |

22 | Let's just try dualizing the notion of van Laarhoven lens in an |

23 | obvious way (except perhaps for Costrong', which will arise later) |

24 | |

25 | > type Colens a b = forall f. Costrong' f => (f b -> b) -> (f a -> a) |

26 | |

27 | Suppose a = Either b b' |

28 | |

29 | Recall |

30 | |

31 | _1 k ~(a,b) = (fmap . flip (,)) b (k a) |

32 | = strength' b (k a) |

33 | |

34 | Costrong functors? |

35 | |

36 | > class Functor f => Costrong' f where -- ' because costrength from Control.Functor.Strong applies to the other summand |

37 | > costrength' :: Functor f => f (Either b b') -> Either (f b) b' |

38 | |

39 | > _1_ :: Colens (Either b b') b -- forall f. Functor f => (f b -> b) -> (f (Either b b') -> Either b b') |

40 | > _1_ k v = left k g |

41 | > where -- g :: Either (f b) b' |

42 | > g = costrength' v |

43 | |

44 | Now let's try to work with Colens generally |

45 | |

46 | Can include: |

47 | include is dual to lens's view |

48 | |

49 | > include :: Colens a b -> b -> a |

50 | > include l = l unConst . Const -- set f = Const b |

51 | |

52 | > newtype Const b x = Const { unConst :: b } deriving Functor |

53 | > instance Costrong' (Const b) where |

54 | > costrength' (Const b) = Left (Const b) |

55 | |

56 | select is dual to lens's set |

57 | should satisfy |

58 | |

59 | select _1_ (Left x) = Left x |

60 | select _1_ (Right y) = Right (Right y) -- see "canonical colens example" at the top |

61 | |

62 | > select :: Colens a b -> a -> Either b a -- (forall f. Costrong' f => (f b -> b) -> (f a -> a)) -> a -> Either b a |

63 | > select l = undefined -- ??? looks hopeless. |

64 | |

65 | If "Either b" had a *left* adjoint "d b" then there would also be two |

66 | canonical maps "d b b -> b" corresponding under the adjunction to |

67 | Left/Right. Then we could try to build select's output "a -> Either b |

68 | a" via the adjunction from "d b a -> a" which we could get by applying |

69 | l to one of these canonical maps "d b b -> b". |

70 | |

71 | But of course "Either b" has no left adjoint. It seems that van |

72 | Laarhoven lenses rely on the underlying category being cartesian |

73 | closed, which Hask^op is not. |

74 | |

75 | one thing I can write is |

76 | |

77 | > foo :: Colens a b -> b -> a -> a |

78 | |

79 | as a Colens a b is in particular a Simple Setter (setting f = Identity, then up to newtypes) |

80 | in the "canonical colens example", this just expresses the fact that X |_| Y might contain an X |

81 | which we can try to update |

82 | |

83 | > foo l b a = l (const b . runIdentity) (Identity a) |

84 | |

85 | > instance Costrong' Identity where |

86 | > costrength' (Identity (Left x)) = Left (Identity x) |

87 | > costrength' (Identity (Right y)) = Right y |