手动计算 set mapped 5 [1,2,3]
set l b = runIdentity . l (\_ -> Identity b)
mapped = sets fmap
sets f g = taintedDot (f (untaintedDot g))
instance Settable Identity where
untainted = runIdentity
untaintedDot = (runIdentity #.)
taintedDot = (Identity #.)
set mapped 5 [1,2,3]
= runIdentity . (sets fmap) (\_ -> Identity 5) $ [1,2,3]
= runIdentity $ sets fmap (\_ -> Identity 5) $ [1,2,3]
= runIdentity $ taintedDot (fmap (untaintedDot (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ (Identity .) (fmap ((runIdentity .) (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ (Identity .) (fmap (fmap runIdentity (\_ -> Identity 5))) $ [1,2,3]
= runIdentity $ Identity . (fmap (\_ -> 5)) $ [1,2,3]
= runIdentity $ Identity $ fmap (\_ -> 5) [1,2,3]
= runIdentity $ Identity $ [5,5,5]
= [5,5,5]
手动计算 toListOf both (1,2)
toListOf :: Getting (Endo [a]) s a -> s -> [a]
toListOf l = foldrOf l (:) []
foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f)
foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf l f = getConst #. l (Const #. f)
both :: Bitraversable r => Traversal (r a a) (r b b) a b
both f = bitraverse f f
instance Bitraversable (,) where
bitraverse f g ~(a, b) = (,) <$> f a <*> g b
instance Functor (Const m) where
fmap _ (Const v) = Const v
instance Monoid m => Applicative (Const m) where
pure _ = Const mempty
liftA2 _ (Const x) (Const y) = Const (x `mappend` y)
(<*>) = coerce (mappend :: m -> m -> m)
toListOf both (1,2)
= foldrOf both (:) [] (1,2)
= flip appEndo [] . foldMapOf both (Endo #. (:)) $ (1,2)
= flip appEndo [] . getConst #. both (Const #. (Endo #. (:))) $ (1,2)
= flip appEndo [] . getConst #. bitraverse (Const #. (Endo #. (:))) (Const #. (Endo #. (:))) $ (1,2)
= flip appEndo [] . getConst $ bitraverse (Const #. (Endo #. (:))) (Const #. (Endo #. (:))) (1,2)
= flip appEndo [] . getConst $ (,) <$> (Const #. (Endo #. (:))) 1 <*> (Const #. (Endo #. (:))) 2
= flip appEndo [] . getConst $ (,) <$> (Const . Endo . (:)) 1 <*> (Const . Endo . (:)) 2
= flip appEndo [] . getConst $ (,) <$> (Const . Endo $ (:) 1) <*> (Const . Endo $ (:) 2)
= flip appEndo [] . getConst $ (,) <$> (Const . Endo $ (1:)) <*> (Const . Endo $ (2:))
= flip appEndo [] . getConst $ (,) <$> (Const (Endo (1:))) <*> (Const (Endo (2:)))
= flip appEndo [] . getConst $ (Const (Endo (1:))) <*> (Const (Endo (2:)))
= flip appEndo [] . getConst $ (Const (Endo (1:) <> Endo (2:)))
= flip appEndo [] $ getConst (Const (Endo ((1:) . (2:))))
= flip appEndo [] (Endo ((1:) . (2:)))
= appEndo (Endo ((1:) . (2:))) []
= [1,2]