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