1{-# OPTIONS_HADDOCK hide #-} 2{-# LANGUAGE AllowAmbiguousTypes #-} 3{-# LANGUAGE ConstraintKinds #-} 4{-# LANGUAGE GADTs #-} 5{-# LANGUAGE NoMonomorphismRestriction #-} 6{-# LANGUAGE Rank2Types #-} 7{-# LANGUAGE ScopedTypeVariables #-} 8{-# LANGUAGE TypeFamilies #-} 9{-# LANGUAGE TypeFamilyDependencies #-} 10{-# LANGUAGE TypeOperators #-} 11 12----------------------------------------------------------------------------- 13-- | 14-- Module : Data.Generics.Internal.VL.Traversal 15-- Copyright : (C) 2020 Csongor Kiss 16-- License : BSD3 17-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com> 18-- Stability : experimental 19-- Portability : non-portable 20-- 21-- Internal lens helpers. Only exported for Haddock 22-- 23----------------------------------------------------------------------------- 24module Data.Generics.Internal.VL.Traversal where 25 26-- | Type alias for traversal 27type Traversal' s a 28 = forall f. Applicative f => (a -> f a) -> s -> f s 29 30type Traversal s t a b 31 = forall f. Applicative f => (a -> f b) -> s -> f t 32 33confusing :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t 34confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f) 35{-# INLINE confusing #-} 36 37liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) a 38liftCurriedYoneda fa = Curried (`yap` fa) 39{-# INLINE liftCurriedYoneda #-} 40 41yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b 42yap (Yoneda k) fa = Yoneda (\ab_r -> k (ab_r .) <*> fa) 43{-# INLINE yap #-} 44 45newtype Curried f a = 46 Curried { runCurried :: forall r. f (a -> r) -> f r } 47 48instance Functor f => Functor (Curried f) where 49 fmap f (Curried g) = Curried (g . fmap (.f)) 50 {-# INLINE fmap #-} 51 52instance (Functor f) => Applicative (Curried f) where 53 pure a = Curried (fmap ($ a)) 54 {-# INLINE pure #-} 55 Curried mf <*> Curried ma = Curried (ma . mf . fmap (.)) 56 {-# INLINE (<*>) #-} 57 58liftCurried :: Applicative f => f a -> Curried f a 59liftCurried fa = Curried (<*> fa) 60 61lowerCurried :: Applicative f => Curried f a -> f a 62lowerCurried (Curried f) = f (pure id) 63newtype Yoneda f a = Yoneda { runYoneda :: forall b. (a -> b) -> f b } 64 65liftYoneda :: Functor f => f a -> Yoneda f a 66liftYoneda a = Yoneda (\f -> fmap f a) 67 68lowerYoneda :: Yoneda f a -> f a 69lowerYoneda (Yoneda f) = f id 70 71instance Functor (Yoneda f) where 72 fmap f m = Yoneda (\k -> runYoneda m (k . f)) 73 74instance Applicative f => Applicative (Yoneda f) where 75 pure a = Yoneda (\f -> pure (f a)) 76 Yoneda m <*> Yoneda n = Yoneda (\f -> m (f .) <*> n id) 77