@@ -0,0 +1,533 @@
1+{-# LANGUAGE RankNTypes #-}
2+
3+-- | This module implements the 'Boggle' type which exists for its
4+-- 'Applicative' instance that takes advantage of the laws of the
5+-- 'Applicative' class to rearrange the applications of the underlying
6+-- type's 'Applicative' instance. These transformations collect all of
7+-- the pure values using in 'pure' and 'fmap' calls into a single place
8+-- which enables GHC to aggressively optimize them.
9+--
10+-- == Optimization Goals
11+--
12+-- The goal for rewriting values defined in terms of 'Applicative' operations
13+-- will be to normalize them into a form that gives GHC the most opportunity
14+-- to simply the resulting expression as possible without knowing anything
15+-- about the particular 'Applicative' instance that that it satisfies the class
16+-- laws.
17+--
18+-- The following type characterizes our desired normal form.
19+--
20+-- > data Normal :: (* -> *) -> * -> * where
21+-- > Pure :: a -> Normal f a
22+-- > Normal1 :: Normal1 f a -> Normal f a
23+--
24+-- > data Normal1 :: (* -> *) -> * -> * where
25+-- > Ap :: Normal1 f (a -> b) -> f a -> Normal1 f b
26+-- > Normal2 :: Normal2 f a -> Normal1 f a
27+--
28+-- > data Normal2 :: (* -> *) -> * -> * where
29+-- > Fmap :: (a -> b) -> f a -> Normal2 f b -- function ≠ 'id'
30+-- > Lift :: f a -> Normal2 f a
31+--
32+-- While this type on its own is simpler than some of the types that follow,
33+-- implementing '<$>' and '<*>' for this type would require recusion to deal
34+-- with the left-recursion found in this type:
35+--
36+-- > f <$> Ap mg mx = Ap ((f .) <$> mg) mx
37+-- > f <$> Normal2 mx = Normal2 (f <$> x)
38+--
39+-- == Optimization Techniques
40+--
41+-- This transformation uses four primary techniques to achieve optimization.
42+--
43+-- [/avoid recursion/]
44+--
45+-- Recursive functions interfere with GHC's ability to inline and optimize
46+-- function applications. Each of the following transformations will need
47+-- to be written in a way that enables GHC to inline all of the definitions
48+-- and optimize away all of the intermediate structures. If the
49+-- intermediate structures or the operations on them were written
50+-- recursively this would not be possible.
51+--
52+-- [/multiple equivalent representations/]
53+--
54+-- There are cases where we don't know what the optimal representation for
55+-- a value will be until that value is actually used. In the following code
56+-- we see this happen with 'MapK1' and 'ApK1'. Due to inlining and
57+-- optimization the representation that was not needed can be eliminated
58+-- at use time.
59+--
60+-- [/free structures/]
61+--
62+-- In order to optimize values according to laws that they satisfy, we'll
63+-- need the structures that these laws operate over to be explicit. This
64+-- will enable the operations to determine when a transformation is
65+-- appropriate and apply it.
66+--
67+-- 'MapK' tracks the eventual argument to 'fmap'. 'ApK' tracks the eventual
68+-- left-most argument to '<.>'. 'PureK' tracks uses of 'pure'.
69+--
70+-- [/typed tagless final encodings/]
71+--
72+-- The /typed tagless final/ approach for writing a computation involves
73+-- defining the signature of the operations that a compution can be
74+-- constructed from and then defining values completely within that
75+-- signature. This technique will specifically apply to computations
76+-- written generically in terms of the 'Applicative' signature.
77+--
78+-- Because the 'Applicative' signature carries a number of laws that
79+-- any interpretation of it must satisfy, we are able to write our
80+-- own interpretations in terms of existing interpretations but which
81+-- use the laws that these existing interpretations must satisfy.
82+--
83+-- It happens that it is now quite common to define computations in this
84+-- style with classes like 'Functor' and 'Applicative' due to the
85+-- popularlity of the @lens@ package and it's heavy use of this pattern.
86+module Boggle
87+ ( Boggle(..)
88+ , boggling
89+ , test
90+ , liftBoggle, lowerBoggle
91+ -- * Abstractions
92+ , Traversal(..)
93+ , Apply(..)
94+ , ApWrap(..), liftApWrap, lowerApWrap
95+ -- * fmap fusion
96+ , MapK(..), (<<$>), liftMapK, lowerMapK
97+ -- * fmap fusion with fmap id law
98+ , MapK1(..), liftMapK1, lowerMapK1
99+ -- * '<*>' reassociation
100+ , ApK(..), (<<.>), liftApK, lowerApK
101+ -- * '<.>' reassociation
102+ , ApK1(..), liftApK1, lowerApK1
103+ -- * pure elminination
104+ , PureK(..), liftPureK, lowerPureK
105+ -- * '>>=' reassociation
106+ , BindK(..), liftBindK, lowerBindK, liftBindK1, liftBindK2
107+ ) where
108+
109+import Control.Applicative
110+import Control.Monad
111+import GHC.Exts ( inline )
112+
113+infixl 4 <<$>, <<.>, <.>
114+
115+type LensLike f s t a b = (a -> f b) -> (s -> f t)
116+type Traversal s t a b = forall f. Applicative f => LensLike f s t a b
117+type Traversal' s a = Traversal s s a a
118+
119+-- | This class is a mid-point between 'Functor' and 'Applicative'
120+-- for types that support the '<*>' operation but not 'pure'
121+--
122+-- It provides an operation for lifted function application ('<.>')
123+--
124+-- Implementations of this class must follow these laws:
125+--
126+-- [/composition/]
127+--
128+-- * @(\\f g x -> f (g x)) '<$>' mf '<.>' mg '<.>' mx = mf '<.>' (mg '<.>' mx)@
129+--
130+-- [/interchange/]
131+--
132+-- * @(\\g x -> f (g x)) '<$>' mg '<.>' mx = f '<$>' (mg '<.>' mx)@
133+-- * @(\\g x -> g (f x)) '<$>' mg '<.>' mx = mg '<.>' (f '<$>' mx)@
134+--
135+-- If @f@ is an 'Applicative', it should satisfy
136+--
137+-- * @'<.>' = '<*>'@
138+class Functor f => Apply f where
139+ -- | Lifted application
140+ (<.>) :: f (a -> b) -> f a -> f b
141+ {-# MINIMAL (<.>) #-}
142+
143+------------------------------------------------------------------------
144+
145+-- | 'ApWrap' provides an 'Apply' instance in terms of an underlying
146+-- 'Applicative' instance.
147+newtype ApWrap f a = ApWrap (f a)
148+
149+liftApWrap :: f a -> ApWrap f a
150+liftApWrap = ApWrap
151+
152+lowerApWrap :: ApWrap f a -> f a
153+lowerApWrap (ApWrap fa) = fa
154+
155+instance Functor f => Functor (ApWrap f) where
156+ fmap f (ApWrap x) = ApWrap (f <$> x)
157+
158+-- | @('<.>') = ('<*>')@
159+instance Applicative f => Apply (ApWrap f) where
160+ ApWrap f <.> ApWrap x = ApWrap (f <*> x)
161+
162+
163+------------------------------------------------------------------------
164+
165+-- | This type fuses all uses of 'fmap' into a single use of 'fmap' on
166+-- the underlying 'Functor' @f@.
167+--
168+-- There is a natural isomorphism between @f@ and @'MapK' f@ witnessed by
169+-- 'liftMapK' and 'lowerMapK' which is respected by the 'Functor' instance
170+-- of @'MapK' f@.
171+newtype MapK f a = MapK (forall b. (a -> b) -> f b)
172+
173+liftMapK :: Functor f => f a -> MapK f a
174+liftMapK fa = MapK (<$> fa)
175+
176+lowerMapK :: MapK f a -> f a
177+lowerMapK fa = id <<$> fa
178+
179+-- | Like '<$>' but removes the 'MapK'
180+(<<$>) :: (a -> b) -> MapK f a -> f b
181+f <<$> MapK x = x f
182+
183+-- | Note: no underlying 'Functor' required
184+instance Functor (MapK f) where
185+ fmap f x = MapK (\z -> (z . f) <<$> x)
186+
187+------------------------------------------------------------------------
188+
189+-- | 'MapK1' extends 'MapK' to detect when a lift is immediately followed
190+-- by a lower. In this case no 'fmap' will be used at all!
191+--
192+-- There is a natural isomorphism between @f@ and @'MapK1' f@ witnessed by
193+-- 'liftMapK1' and 'lowerMapK1' which is respected by the 'Functor' and
194+-- 'Apply' instance of @'MapK1' f@.
195+data MapK1 f a = MapK1 (f a) (MapK f a)
196+ -- ^ Invariant: @(x :: f a) == 'lowerMapK' (y :: 'MapK' f a)
197+
198+liftMapK1 :: Functor f => f a -> MapK1 f a
199+liftMapK1 fa = MapK1 fa (liftMapK fa)
200+
201+lowerMapK1 :: MapK1 f a -> f a
202+lowerMapK1 (MapK1 fa _) = fa
203+
204+-- | Note: no underlying 'Functor' required
205+instance Functor (MapK1 f) where
206+ fmap f (MapK1 _ g) = MapK1 (f <<$> g) (f <$> g)
207+
208+instance Apply f => Apply (MapK1 f) where
209+ MapK1 f g <.> MapK1 x _ =
210+ MapK1 (f <.> x) (MapK (\k -> (\a b -> k (a b)) <<$> g <.> x))
211+
212+------------------------------------------------------------------------
213+
214+-- | 'ApK' provides an 'Apply' instance in terms of the underlying @f@'s
215+-- 'Apply' instance, but left-associates all '<.>'. Lowering this type
216+-- requires an 'Applicative' instance.
217+--
218+-- There is a natural isomorphism between @f@ and @'ApK' f@ witnessed by
219+-- 'liftApK' and 'lowerApK' which is respected by the 'Functor' and
220+-- 'Apply' instance of @'ApK' f@.
221+newtype ApK f a = ApK (forall b. f (a -> b) -> f b)
222+
223+liftApK :: Apply f => f a -> ApK f a
224+liftApK fa = ApK (<.> fa)
225+
226+lowerApK :: Applicative f => ApK f a -> f a
227+lowerApK fa = pure id <<.> fa
228+
229+-- | Like '<.>' but removes 'ApK'
230+(<<.>) :: f (a -> b) -> ApK f a -> f b
231+fa <<.> ApK k = k fa
232+
233+instance Functor f => Functor (ApK f) where
234+ fmap f x = ApK (\g -> (\a b -> a (f b)) <$> g <<.> x)
235+
236+-- | Note that this 'Apply' instance only uses the underlying 'Functor'
237+instance Functor f => Apply (ApK f) where
238+ f <.> x = ApK (\g -> (.) <$> g <<.> f <<.> x)
239+
240+------------------------------------------------------------------------
241+
242+-- | This type provides an 'Apply' instance in terms of the underlying @f@
243+-- type's 'Apply' instance, but it left-associates all uses of '<.>'
244+--
245+-- There is a natural isomorphism between @f@ and @'ApK1' f@ witnessed by
246+-- 'liftApK1' and 'lowerApK1' which is respected by the 'Functor' and
247+-- 'Apply' instance of @'ApK1' f@.
248+data ApK1 f a = ApK1 (f a) (ApK f a)
249+ -- ^ Invariant: @(x :: f a) == 'lowerApK' (y :: 'ApK' f a)@
250+
251+instance Functor f => Functor (ApK1 f) where
252+ fmap f (ApK1 x y) = ApK1 (f <$> x) (f <$> y)
253+
254+-- | Note that this 'Apply' instance only uses the underlying 'Functor'
255+instance Functor f => Apply (ApK1 f) where
256+ ApK1 fl fr <.> ApK1 _ x = ApK1 (fl <<.> x) (fr <.> x)
257+
258+liftApK1 :: Apply f => f a -> ApK1 f a
259+liftApK1 fa = ApK1 fa (liftApK fa)
260+
261+lowerApK1 :: ApK1 f a -> f a
262+lowerApK1 (ApK1 fa _) = fa
263+
264+------------------------------------------------------------------------
265+
266+-- | 'PureK' lifts a type @f@ having an 'Apply' instance to a type
267+-- having an 'Applicative' instance. The 'Applicative' laws for 'pure'
268+-- are used to rewrite all uses of pure into either a single 'pure' or
269+-- into uses of 'fmap' where possible.
270+--
271+-- There is a natural isomorphism between @f@ and @'PureK' f@ witnessed by
272+-- 'liftPureK' and 'lowerPureK' which is respected by the 'Functor',
273+-- 'Apply', and 'Applicative' instance of @'PureK' f@.
274+data PureK f a = Pure a | Dirty (f a)
275+
276+lowerPureK :: Applicative f => PureK f a -> f a
277+lowerPureK (Pure a) = pure a
278+lowerPureK (Dirty fa) = fa
279+
280+liftPureK :: f a -> PureK f a
281+liftPureK = Dirty
282+
283+instance Functor f => Functor (PureK f) where
284+ fmap f (Pure x) = Pure (f x)
285+ fmap f (Dirty x) = Dirty (f <$> x)
286+
287+instance Apply f => Apply (PureK f) where
288+ Dirty f <.> Dirty x = Dirty (f <.> x)
289+ Pure f <.> x = f <$> x
290+ f <.> Pure x = ($ x) <$> f
291+
292+-- Note that this 'Applicative' instance only uses the underlying 'Apply'
293+instance Apply f => Applicative (PureK f) where
294+ pure = Pure
295+ (<*>) = (<.>)
296+
297+-- | Transform the underlying type.
298+natPureK :: (f a -> g a) -> PureK f a -> PureK g a
299+natPureK f (Dirty fa) = Dirty (f fa)
300+natPureK _ (Pure a) = Pure a
301+
302+------------------------------------------------------------------------
303+
304+-- | @'Boggle' f@ is isomorphic to @f@ up to the 'Applicative' laws.
305+-- Uses of '<$>' on this type are combined into a single use of '<$>'
306+-- on the underlying @f@ type. Uses of 'pure' are combined and transformed
307+-- to '<$>' where possible. Uses of '<*>' are reassociated to the left.
308+--
309+-- 'PureK' is on the outside because any use of 'pure' is immediately
310+-- intercepted and translated into 'fmap' when needed. 'ApK1' doesn't
311+-- even have/need an 'Applicative' instance.
312+--
313+-- 'ApK1' is next because it uses the 'Functor' instance from its underlying
314+-- type and we want the 'MapK' layer to intercept and fuse all of those 'fmap'
315+-- uses.
316+--
317+-- 'MapK1' is down toward the bottom of the stack to be able to fuse the uses
318+-- of 'fmap' from all the previous layers into one single use.
319+--
320+-- 'ApWrap' is at the very bottom. It only exists to provide an 'Apply'
321+-- instance to the underlying type @f@.
322+--
323+-- There is a natural isomorphism between @f@ and @'Boggle' f@ witnessed by
324+-- 'liftBoggle' and 'lowerBoggle' which is respected by the 'Functor',
325+-- 'Apply', and 'Applicative' instance of @'Boggle' f@.
326+newtype Boggle f a = Boggle (PureK (ApK1 (MapK1 (ApWrap f))) a)
327+
328+instance Functor (Boggle f) where
329+ fmap f (Boggle x) = Boggle (f <$> x)
330+ {-# INLINE fmap #-}
331+
332+instance Applicative (Boggle f) where
333+ pure x = Boggle (pure x)
334+ {-# INLINE pure #-}
335+ Boggle x <*> Boggle y = Boggle (x <*> y)
336+ {-# INLINE (<*>) #-}
337+
338+liftBoggle :: Applicative f => f a -> Boggle f a
339+liftBoggle = Boggle . liftPureK . liftApK1 . liftMapK1 . liftApWrap
340+{-# INLINE[1] liftBoggle #-}
341+
342+-- | 'lowerBoggle' lowers the 'ApK1' and 'MapK' layers first before lowering
343+-- the 'PureK' layer. This ensures that any 'fmap' uses in the 'PureK' layer
344+-- are intercepted by the 'MapK' layer, but the final (possible) use of 'pure'
345+-- in the case that 'pure' is going to be used will happen in the underlying
346+-- @f@ type!
347+lowerBoggle :: Applicative f => Boggle f a -> f a
348+lowerBoggle
349+ = lowerPureK . natPureK (lowerApWrap . lowerMapK1 . lowerApK1) . (\(Boggle b) -> b)
350+{-# INLINE lowerBoggle #-}
351+
352+-- | Optimize a 'Traversal' by fusing the '<$>'s and left-associating the '<*>'s
353+--
354+-- This function will only work well on non-recursive traversals. For an example
355+-- of using this technique on recursive cases see "Data.Traversable.Generic".
356+boggling :: Applicative f => LensLike (Boggle f) s t a b -> LensLike f s t a b
357+boggling l = \f x -> lowerBoggle (l (\x -> (liftBoggle (f x))) x)
358+{-# INLINE boggling #-}
359+
360+
361+------------------------------------------------------------------------
362+
363+-- | Local implementation of @Codensity@ type from @kan-extensions@.
364+-- This type captures the concept of a partially applied '>>=' function.
365+newtype BindK f a = BindK { runBindK :: forall b. (a -> f b) -> f b }
366+
367+instance Functor (BindK f) where
368+ fmap = liftM
369+
370+instance Applicative (BindK f) where
371+ pure x = BindK $ \k -> k x
372+ (<*>) = ap
373+
374+instance Alternative f => Alternative (BindK f) where
375+ empty = BindK $ \_ -> empty
376+ (<|>) = liftBindK2 (<|>)
377+ {-# INLINE (<|>) #-}
378+
379+instance Monad (BindK f) where
380+ BindK m >>= f = BindK $ \k -> m $ \a -> runBindK (f a) k
381+
382+instance Alternative f => MonadPlus (BindK f)
383+
384+-- | Run a @'BindK' f@ computation with 'pure' as the final continuation.
385+lowerBindK :: Applicative f => BindK f a -> f a
386+lowerBindK (BindK k) = k pure
387+
388+liftBindK :: Monad f => f a -> BindK f a
389+liftBindK fa = BindK (fa >>=)
390+
391+liftBindK1 :: (forall a. f a -> f a) -> BindK f b -> BindK f b
392+liftBindK1 f (BindK k) = BindK (f . k)
393+
394+liftBindK2 :: (forall a. f a -> f a -> f a) -> BindK f b -> BindK f b -> BindK f b
395+liftBindK2 f (BindK m) (BindK n) = BindK (\k -> f (m k) (n k))
396+
397+traversePair f (a, b) = (,) <$> f a <*> f b
398+
399+test :: Applicative f => (a -> f a) -> (a, a) -> f (a, a)
400+test = boggling traversePair
401+
402+{- example
403+-
404+
405+liftBoggle fa <*> (pure (5+) <*> liftBoggle fb)
406+=
407+((Boggle . liftPureK . liftApK1 . liftMapK1 . liftApWrap) fa)
408+ <*>
409+ (pure (5+) <*> (Boggle . liftPureK . liftApK1 . liftMapK1 . liftApWrap) fb)
410+=
411+ Boggle (
412+ Dirty (
413+ ApK1 (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))) (liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))))))
414+ <*>
415+ ( Boggle (Pure (5+))
416+ <*>
417+ Boggle (
418+ Dirty (
419+ ApK1 (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))) (liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))))
420+= Boggle (
421+ (Dirty (
422+ ApK1 (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))) (liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))))))
423+ <*> (Pure (5+) <*>
424+ (Dirty (
425+ ApK1 (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))) (liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))))
426+= {- PureK <$> -}
427+ Boggle (
428+ (Dirty (
429+ ApK1 (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))) (liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))))))
430+ <.>
431+ (Dirty ((+5) <$>
432+ ApK1 (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))) (liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))))
433+= {- PureK <.> -}
434+ Boggle (
435+ (Dirty
436+ (
437+ ApK1 (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))) (liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))))))
438+ <.>
439+ ((+5) <$>
440+ ApK1 (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))) (liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))
441+= {- ApK1 <$> -}
442+ Boggle (
443+ (Dirty
444+ (
445+ ApK1 (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))) (liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))))))
446+ <.>
447+ (
448+ ApK1 ((+5) <$> MapK1 (ApWrap fb) (liftMapK (ApWrap fb))) ((+5) <$> liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))
449+= {- ApK1 <.> -}
450+
451+ Boggle (
452+ (Dirty
453+ (ApK1
454+
455+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
456+ <<.> ((+5) <$> liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))))
457+ -- This isn't going to be evaluated
458+ ((liftApK (MapK1 (ApWrap fa) (liftMapK (ApWrap fa))))))
459+ <.> ((+5) <$> liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb)))))
460+= {- Remove unevaled term -}
461+ Boggle (
462+ (Dirty
463+ (ApK1
464+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
465+ <<.> ((+5) <$> liftApK (MapK1 (ApWrap fb) (liftMapK (ApWrap fb))))
466+ <uneval>
467+= {- liftMapK defn -}
468+ Boggle (
469+ (Dirty
470+ (ApK1
471+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
472+ <<.> ((+5) <$> liftApK (MapK1 (ApWrap fb) (MapK (<$> (ApWrap fb))))
473+ <uneval>
474+= {- liftApK defn -}
475+ Boggle (
476+ (Dirty
477+ (ApK1
478+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
479+ <<.> ((+5) <$> ApK (<.> (MapK1 (ApWrap fb) (MapK (<$> (ApWrap fb))))
480+= {- <$> ApK -}
481+ Boggle (
482+ (Dirty
483+ (ApK1
484+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
485+ <<.> (ApK (\g -> (\a b -> a (5 + b)) <$> g <<.>
486+ (ApK (<.> (MapK1 (ApWrap fb) (MapK (<$> (ApWrap fb)))))
487+= {- <<.> defn -}
488+ Boggle (
489+ (Dirty
490+ (ApK1
491+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
492+ <<.> (ApK (\g -> (\a b -> a (5 + b)) <$>
493+ (g <.> (MapK1 (ApWrap fb) (MapK (<$> (ApWrap fb))))))
494+= {- <<.> defn -}
495+ Boggle (
496+ (Dirty
497+ (ApK1
498+ (\a b -> a (5 + b)) <$> (
499+ (MapK1 (ApWrap fa) (liftMapK (ApWrap fa)))
500+ <.> (MapK1 (ApWrap fb) (MapK (<$> (ApWrap fb))))))
501+= {- MapK1 <.> -}
502+ Boggle (
503+ (Dirty
504+ (ApK1
505+ (\a b -> a (5 + b)) <$> (
506+ (MapK1 (ApWrap fa <.> ApWrap fb)
507+ (\k -> (\a b -> k (a b)) <<$> (MapK (<$> (ApWrap fa)))))
508+ <.> (ApWrap fb)))))
509+= {- <<$> defn -}
510+ Boggle (
511+ (Dirty
512+ (ApK1
513+ (\a b -> a (5 + b)) <$> (
514+ (MapK1 (ApWrap fa <.> ApWrap fb)
515+ (ApWrap ((\k -> (\a b -> k (a b))) <$> fa <*> fb))))
516+=
517+ {- <$> -}
518+ Boggle (
519+ (Dirty
520+ (ApK1
521+ MapK1 (
522+ (\a b -> a (5 + b)) <$> ApWrap fa <.> ApWrap fb))))
523+-}
524+
525+
526+
527+
528+
529+
530+
531+
532+
533+