{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeFamilyDependencies    #-}
{-# LANGUAGE TypeOperators             #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.VL.Traversal
-- Copyright   :  (C) 2020 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Internal lens helpers. Only exported for Haddock
--
-----------------------------------------------------------------------------
module Data.Generics.Internal.VL.Traversal where

-- | Type alias for traversal
type Traversal' s a
  = forall f. Applicative f => (a -> f a) -> s -> f s

type Traversal s t a b
  = forall f. Applicative f => (a -> f b) -> s -> f t

confusing :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t
confusing :: Traversal s t a b -> (a -> f b) -> s -> f t
confusing Traversal s t a b
t = \a -> f b
f -> Yoneda f t -> f t
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda (Yoneda f t -> f t) -> (s -> Yoneda f t) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curried (Yoneda f) t -> Yoneda f t
forall (f :: * -> *) a. Applicative f => Curried f a -> f a
lowerCurried (Curried (Yoneda f) t -> Yoneda f t)
-> (s -> Curried (Yoneda f) t) -> s -> Yoneda f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Curried (Yoneda f) b) -> s -> Curried (Yoneda f) t
Traversal s t a b
t (f b -> Curried (Yoneda f) b
forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) a
liftCurriedYoneda (f b -> Curried (Yoneda f) b)
-> (a -> f b) -> a -> Curried (Yoneda f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)
{-# INLINE confusing #-}

liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) a
liftCurriedYoneda :: f a -> Curried (Yoneda f) a
liftCurriedYoneda f a
fa = (forall r. Yoneda f (a -> r) -> Yoneda f r) -> Curried (Yoneda f) a
forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (Yoneda f (a -> r) -> f a -> Yoneda f r
forall (f :: * -> *) a b.
Applicative f =>
Yoneda f (a -> b) -> f a -> Yoneda f b
`yap` f a
fa)
{-# INLINE liftCurriedYoneda #-}

yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b
yap :: Yoneda f (a -> b) -> f a -> Yoneda f b
yap (Yoneda forall b. ((a -> b) -> b) -> f b
k) f a
fa = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
ab_r -> ((a -> b) -> a -> b) -> f (a -> b)
forall b. ((a -> b) -> b) -> f b
k (b -> b
ab_r (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
{-# INLINE yap #-}

newtype Curried f a =
  Curried { Curried f a -> forall r. f (a -> r) -> f r
runCurried :: forall r. f (a -> r) -> f r }

instance Functor f => Functor (Curried f) where
  fmap :: (a -> b) -> Curried f a -> Curried f b
fmap a -> b
f (Curried forall r. f (a -> r) -> f r
g) = (forall r. f (b -> r) -> f r) -> Curried f b
forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (f (a -> r) -> f r
forall r. f (a -> r) -> f r
g (f (a -> r) -> f r)
-> (f (b -> r) -> f (a -> r)) -> f (b -> r) -> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> r) -> a -> r) -> f (b -> r) -> f (a -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f))
  {-# INLINE fmap #-}

instance (Functor f) => Applicative (Curried f) where
  pure :: a -> Curried f a
pure a
a = (forall r. f (a -> r) -> f r) -> Curried f a
forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (((a -> r) -> r) -> f (a -> r) -> f r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> r) -> a -> r
forall a b. (a -> b) -> a -> b
$ a
a))
  {-# INLINE pure #-}
  Curried forall r. f ((a -> b) -> r) -> f r
mf <*> :: Curried f (a -> b) -> Curried f a -> Curried f b
<*> Curried forall r. f (a -> r) -> f r
ma = (forall r. f (b -> r) -> f r) -> Curried f b
forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (f (a -> r) -> f r
forall r. f (a -> r) -> f r
ma (f (a -> r) -> f r)
-> (f (b -> r) -> f (a -> r)) -> f (b -> r) -> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ((a -> b) -> a -> r) -> f (a -> r)
forall r. f ((a -> b) -> r) -> f r
mf (f ((a -> b) -> a -> r) -> f (a -> r))
-> (f (b -> r) -> f ((a -> b) -> a -> r))
-> f (b -> r)
-> f (a -> r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> r) -> (a -> b) -> a -> r)
-> f (b -> r) -> f ((a -> b) -> a -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.))
  {-# INLINE (<*>) #-}

liftCurried :: Applicative f => f a -> Curried f a
liftCurried :: f a -> Curried f a
liftCurried f a
fa = (forall r. f (a -> r) -> f r) -> Curried f a
forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (f (a -> r) -> f a -> f r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)

lowerCurried :: Applicative f => Curried f a -> f a
lowerCurried :: Curried f a -> f a
lowerCurried (Curried forall r. f (a -> r) -> f r
f) = f (a -> a) -> f a
forall r. f (a -> r) -> f r
f ((a -> a) -> f (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id)
newtype Yoneda f a = Yoneda { Yoneda f a -> forall b. (a -> b) -> f b
runYoneda :: forall b. (a -> b) -> f b }

liftYoneda :: Functor f => f a -> Yoneda f a
liftYoneda :: f a -> Yoneda f a
liftYoneda f a
a = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
a)

lowerYoneda :: Yoneda f a -> f a
lowerYoneda :: Yoneda f a -> f a
lowerYoneda (Yoneda forall b. (a -> b) -> f b
f) = (a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id

instance Functor (Yoneda f) where
  fmap :: (a -> b) -> Yoneda f a -> Yoneda f b
fmap a -> b
f Yoneda f a
m = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
k -> Yoneda f a -> (a -> b) -> f b
forall (f :: * -> *) a. Yoneda f a -> forall b. (a -> b) -> f b
runYoneda Yoneda f a
m (b -> b
k (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))

instance Applicative f => Applicative (Yoneda f) where
  pure :: a -> Yoneda f a
pure a
a = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a))
  Yoneda forall b. ((a -> b) -> b) -> f b
m <*> :: Yoneda f (a -> b) -> Yoneda f a -> Yoneda f b
<*> Yoneda forall b. (a -> b) -> f b
n = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> ((a -> b) -> a -> b) -> f (a -> b)
forall b. ((a -> b) -> b) -> f b
m (b -> b
f (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> a) -> f a
forall b. (a -> b) -> f b
n a -> a
forall a. a -> a
id)