git.iko.soy/generic-lens
on master help sign in
Add (nearly complete) example of how boggle works
ab8fdb3Matthew Pickering
src/Boggle.hs+136−2
compare with master
unifiedsplit
@@ -108,6 +108,7 @@ module Boggle
108
108
109import Control.Applicative
109import Control.Applicative
110import Control.Monad
110import Control.Monad
111+import GHC.Exts ( inline )
111
112
112infixl 4 <<$>, <<.>, <.>
113infixl 4 <<$>, <<.>, <.>
113
114
@@ -336,7 +337,7 @@ instance Applicative (Boggle f) where
336
337
337liftBoggle :: Applicative f => f a -> Boggle f a
338liftBoggle :: Applicative f => f a -> Boggle f a
338liftBoggle = Boggle . liftPureK . liftApK1 . liftMapK1 . liftApWrap
339liftBoggle = Boggle . liftPureK . liftApK1 . liftMapK1 . liftApWrap
339−{-# INLINE liftBoggle #-}
340+{-# INLINE[1] liftBoggle #-}
340
341
341-- | 'lowerBoggle' lowers the 'ApK1' and 'MapK' layers first before lowering
342-- | 'lowerBoggle' lowers the 'ApK1' and 'MapK' layers first before lowering
342-- the 'PureK' layer. This ensures that any 'fmap' uses in the 'PureK' layer
343-- the 'PureK' layer. This ensures that any 'fmap' uses in the 'PureK' layer
@@ -353,7 +354,7 @@ lowerBoggle
353-- This function will only work well on non-recursive traversals. For an example
354-- This function will only work well on non-recursive traversals. For an example
354-- of using this technique on recursive cases see "Data.Traversable.Generic".
355-- of using this technique on recursive cases see "Data.Traversable.Generic".
355boggling :: Applicative f => LensLike (Boggle f) s t a b -> LensLike f s t a b
356boggling :: Applicative f => LensLike (Boggle f) s t a b -> LensLike f s t a b
356−boggling l = \f x -> lowerBoggle (l (liftBoggle . f) x)
357+boggling l = \f x -> lowerBoggle (l (\x -> (liftBoggle (f x))) x)
357{-# INLINE boggling #-}
358{-# INLINE boggling #-}
358
359
359
360
@@ -397,3 +398,136 @@ traversePair f (a, b) = (,) <$> f a <*> f b
397
398
398test :: Applicative f => (a -> f a) -> (a, a) -> f (a, a)
399test :: Applicative f => (a -> f a) -> (a, a) -> f (a, a)
399test = boggling traversePair
400test = 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+