{-# LANGUAGE
  RankNTypes #-}

-- | This structure is part of the definition of 'ApNormalize.Aps'.

module ApNormalize.DList
  ( -- * Applicative difference lists
    ApDList(..)
  , liftApDList
  , lowerApDList
  , Yoneda(..)
  ) where

-- | Type of applicative difference lists.
--
-- An applicative transformer which accumulates @f@-actions in
-- a left-nested composition using @('<*>')@.
--
-- 'ApDList' represents a sequence of @f@-actions
-- @u1 :: f x1@, ... @un :: f xn@ as "term with a hole"
-- @(_ \<*> u1 \<*> ... \<*> un) :: f r@.
--
-- That hole must have type  @_ :: f (x1 -> ... -> un -> r)@;
-- the variable number of arrows is hidden by existential quantification
-- and continuation passing.
--
-- To help ensure that syntactic invariant,
-- the 'Functor' and 'Applicative' instances for 'ApDList' have no constraints.
-- 'liftApDList' is the only function whose signature requires an
-- @'Applicative' f@ constraint, wrapping each action @u@ inside one @('<*>')@.
newtype ApDList f a = ApDList (forall r. Yoneda f (a -> r) -> f r)

-- | A difference list with one element @u@, denoted @_ \<*> u@.
liftApDList :: Applicative f => f a -> ApDList f a
liftApDList :: f a -> ApDList f a
liftApDList f a
u = (forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
forall (f :: * -> *) a.
(forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
ApDList (\(Yoneda forall x. ((a -> r) -> x) -> f x
t) -> ((a -> r) -> a -> r) -> f (a -> r)
forall x. ((a -> r) -> x) -> f x
t (a -> r) -> a -> r
forall a. a -> a
id f (a -> r) -> f a -> f r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
u)
{-# INLINE liftApDList #-}

-- | Complete a difference list, filling the hole with the first argument.
lowerApDList :: Yoneda f (b -> c) -> ApDList f b -> f c
lowerApDList :: Yoneda f (b -> c) -> ApDList f b -> f c
lowerApDList Yoneda f (b -> c)
u (ApDList forall r. Yoneda f (b -> r) -> f r
v) = Yoneda f (b -> c) -> f c
forall r. Yoneda f (b -> r) -> f r
v Yoneda f (b -> c)
u
{-# INLINE lowerApDList #-}

instance Functor (ApDList f) where
  fmap :: (a -> b) -> ApDList f a -> ApDList f b
fmap a -> b
f (ApDList forall r. Yoneda f (a -> r) -> f r
u) = (forall r. Yoneda f (b -> r) -> f r) -> ApDList f b
forall (f :: * -> *) a.
(forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
ApDList (\Yoneda f (b -> r)
t -> Yoneda f (a -> r) -> f r
forall r. Yoneda f (a -> r) -> f r
u (((b -> r) -> a -> r) -> Yoneda f (b -> r) -> Yoneda 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) Yoneda f (b -> r)
t))
  {-# INLINE fmap #-}

instance Applicative (ApDList f) where
  pure :: a -> ApDList f a
pure a
x = (forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
forall (f :: * -> *) a.
(forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
ApDList (\(Yoneda forall x. ((a -> r) -> x) -> f x
t) -> ((a -> r) -> r) -> f r
forall x. ((a -> r) -> x) -> f x
t (\a -> r
k -> a -> r
k a
x))
  ApDList forall r. Yoneda f ((a -> b) -> r) -> f r
uf <*> :: ApDList f (a -> b) -> ApDList f a -> ApDList f b
<*> ApDList forall r. Yoneda f (a -> r) -> f r
ux = (forall r. Yoneda f (b -> r) -> f r) -> ApDList f b
forall (f :: * -> *) a.
(forall r. Yoneda f (a -> r) -> f r) -> ApDList f a
ApDList (\Yoneda f (b -> r)
t -> Yoneda f (a -> r) -> f r
forall r. Yoneda f (a -> r) -> f r
ux ((forall x. ((a -> r) -> x) -> f x) -> Yoneda f (a -> r)
forall (f :: * -> *) a. (forall x. (a -> x) -> f x) -> Yoneda f a
Yoneda (\(a -> r) -> x
c -> Yoneda f ((a -> b) -> x) -> f x
forall r. Yoneda f ((a -> b) -> r) -> f r
uf (((b -> r) -> (a -> b) -> x)
-> Yoneda f (b -> r) -> Yoneda f ((a -> b) -> x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b -> r
d a -> b
e -> (a -> r) -> x
c (b -> r
d (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
e)) Yoneda f (b -> r)
t))))
  {-# INLINE pure #-}
  {-# INLINE (<*>) #-}

-- | A delayed application of 'fmap' which can be fused with an inner 'fmap' or
-- 'Control.Applicative.liftA2'.
--
-- This is the same definition as in the kan-extensions library, but we
-- redefine it to not pay for all the dependencies.
newtype Yoneda f a = Yoneda (forall x. (a -> x) -> f x)

instance Functor (Yoneda f) where
  fmap :: (a -> b) -> Yoneda f a -> Yoneda f b
fmap a -> b
f (Yoneda forall x. (a -> x) -> f x
u) = (forall x. (b -> x) -> f x) -> Yoneda f b
forall (f :: * -> *) a. (forall x. (a -> x) -> f x) -> Yoneda f a
Yoneda (\b -> x
g -> (a -> x) -> f x
forall x. (a -> x) -> f x
u (b -> x
g (b -> x) -> (a -> b) -> a -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))