{-# LANGUAGE CPP        #-}
{-# LANGUAGE PolyKinds  #-}
{-# LANGUAGE RankNTypes #-}
-- |
-- Csongor Kiss, Matthew Pickering, and Nicolas Wu. 2018. Generic deriving of generic traversals.
-- Proc. ACM Program. Lang. 2, ICFP, Article 85 (July 2018), 30 pages. DOI: https://doi.org/10.1145/3236780
--
-- https://arxiv.org/abs/1805.06798
--
-- This is modified version of part of @generic-lens@ library
--
-- Copyright (c) 2018, Csongor Kiss
-- 
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
-- 
--     * Redistributions in binary form must reproduce the above
--       copyright notice, this list of conditions and the following
--       disclaimer in the documentation and/or other materials provided
--       with the distribution.
-- 
--     * Neither the name of Csongor Kiss nor the names of other
--       contributors may be used to endorse or promote products derived
--       from this software without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- 
module Data.Functor.Confusing (
    confusing, LensLike,
    iconfusing, IxLensLike,
    fconfusing, FLensLike,
    liftCurriedYoneda, yap,
    Curried (..), liftCurried, lowerCurried,
    Yoneda (..), liftYoneda, lowerYoneda,
  ) where

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 0
#endif

#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif

-------------------------------------------------------------------------------
-- Confusing
-------------------------------------------------------------------------------

type LensLike f s t a b = (a -> f b) -> s -> f t

confusing :: Applicative f => LensLike (Curried (Yoneda f)) s t a b -> LensLike f s t a b
confusing :: forall (f :: * -> *) s t a b.
Applicative f =>
LensLike (Curried (Yoneda f)) s t a b -> LensLike f s t a b
confusing LensLike (Curried (Yoneda f)) s t a b
t = \a -> f b
f -> forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => Curried f a -> f a
lowerCurried forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike (Curried (Yoneda f)) s t a b
t (forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) a
liftCurriedYoneda 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 :: forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) a
liftCurriedYoneda f a
fa = forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (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 :: forall (f :: * -> *) a b.
Applicative f =>
Yoneda f (a -> b) -> f a -> Yoneda f b
yap (Yoneda forall b. ((a -> b) -> b) -> f b
k) f a
fa = forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
ab_r -> forall b. ((a -> b) -> b) -> f b
k (b -> b
ab_r forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
{-# INLINE yap #-}

type IxLensLike f i s t a b = (i -> a -> f b) -> s -> f t

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

type FLensLike f s t a b = (forall x. a x -> f (b x)) -> s -> f t

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

-------------------------------------------------------------------------------
-- Curried
-------------------------------------------------------------------------------

newtype Curried f a = Curried { forall (f :: * -> *) a. 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 :: forall a b. (a -> b) -> Curried f a -> Curried f b
fmap a -> b
f (Curried forall r. f (a -> r) -> f r
g) = forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (forall r. f (a -> r) -> f r
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f))
    {-# INLINE fmap #-}

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

liftCurried :: Applicative f => f a -> Curried f a
liftCurried :: forall (f :: * -> *) a. Applicative f => f a -> Curried f a
liftCurried f a
fa = forall (f :: * -> *) a.
(forall r. f (a -> r) -> f r) -> Curried f a
Curried (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 :: forall (f :: * -> *) a. Applicative f => Curried f a -> f a
lowerCurried (Curried forall r. f (a -> r) -> f r
f) = forall r. f (a -> r) -> f r
f (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id)

-------------------------------------------------------------------------------
-- Yoneda
-------------------------------------------------------------------------------

newtype Yoneda f a = Yoneda { forall (f :: * -> *) a. 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 :: forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda f a
a = forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> 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 :: forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda (Yoneda forall b. (a -> b) -> f b
f) = forall b. (a -> b) -> f b
f forall a. a -> a
id

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

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