Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 69 lines (54 sloc) 1.969 kB
9322e51 @batterseapower Generalised applicative functor for hetrogenous zipping (and more?)
authored
1 {-# LANGUAGE Rank2Types #-}
2 module GeneralisedApplicative where
3
4 -- What if I have two Records and I want to zip them together?
5 -- We want to zip each field in a distinctive way.
6 --
7 -- This module shows a possible solution using I concocted that
8 -- appears to be a generalisation of Applicative
9 data Record f = Record {
10 foo :: f Int,
11 bar :: f Bool,
12 baz :: f Double
13 }
14
15 naturality :: (forall a. f a -> g a)
16 -> Record f -> Record g
17 naturality f r = Record {
18 foo = f (foo r),
19 bar = f (bar r),
20 baz = f (baz r)
21 }
22
23
24 -- NB: (/\f g -> forall a. Mapper f g a) seems to be a Category in a certain sense,
25 -- though the lack of kind polymorphism would prevent us from making it a Category instance
26 newtype Mapper f g a = Mapper { unMapper :: f a -> g a }
27
28 -- Analgous to pure :: a -> r a
29 pureRecord :: (forall a. f a) -> Record f
30 pureRecord x = Record {
31 foo = x,
32 bar = x,
33 baz = x
34 }
35
36 -- Analogous to <*> :: r (a -> b) -> r a -> r b
37 mapRecord :: Record (Mapper f g) -> Record f -> Record g
38 mapRecord r1 r2 = Record {
39 foo = unMapper (foo r1) (foo r2),
40 bar = unMapper (bar r1) (bar r2),
41 baz = unMapper (baz r1) (baz r2)
42 }
43
44
45 -- We can use that machinery to implement the zipping operation we were
46 -- originally after:
47
48 newtype Zipper f g h a = Zipper { unZipper :: f a -> g a -> h a }
49
50 zipRecord :: Record (Zipper f g h) -> Record f -> Record g -> Record h
51 zipRecord r1 r2 r3 = Record {
52 foo = unZipper (foo r1) (foo r2) (foo r3),
53 bar = unZipper (bar r1) (bar r2) (bar r3),
54 baz = unZipper (baz r1) (baz r2) (baz r3)
55 }
56
57 zipRecord' :: Record (Zipper f g h) -> Record f -> Record g -> Record h
58 zipRecord' r1 r2 r3 = mapRecord (doit1 r1 r2) r3
59 where
60 doit1 :: Record (Zipper f g h) -> Record f -> Record (Mapper g h)
61 doit1 r1 r2 = mapRecord (naturality doit2 r1) r2
62
63 doit2 :: Zipper f g h a -> Mapper f (Mapper g h) a
64 doit2 z = Mapper (Mapper . unZipper z)
65
66
67 main :: IO ()
68 main = return ()
Something went wrong with that request. Please try again.