    {-# LANGUAGE
      GADTs #-}

    -- |
    -- The definition of 'Aps'.
    -- Most of this is reexported by "ApNormalize".

    module ApNormalize.Aps
      ( -- * Normalizing applicative functors
        Aps(..)
      , (<$>^)
      , (<*>^)
      , liftAps
      , lowerAps
      , liftA2Aps
      , apsToApDList
      ) where

    import Control.Applicative (liftA2, liftA3)
    import ApNormalize.DList

    -- | An applicative functor transformer which accumulates @f@-actions (things of type @f x@)
    -- in a normal form.
    --
    -- It constructs a value of type @f a@ with the following syntactic invariant.
    -- It depends on the number of @f@-actions @a1 ... an@ composing it,
    -- which are delimited using 'liftAps':
    --
    -- - Zero action: @pure x@
    -- - One action: @f \<$> a1@
    -- - Two or more actions: @liftA2 f a1 a2 \<*> a3 \<*> ... \<*> an@
    data Aps f a where
      Pure :: a -> Aps f a
      FmapLift :: (x -> a) -> f x -> Aps f a
      LiftA2Aps :: (x -> y -> z -> a) -> f x -> f y -> ApDList f z -> Aps f a

    infixl 4 <$>^, <*>^

    -- | @f \<$>^ u :: Aps f b@ is a delayed representation of @f \<$> u :: f b@,
    -- so that it can be fused with other applicative operations.
    --
    -- @f \<$>^ u@ is a shorthand for @f \<$> 'liftAps' u@.
    (<$>^) :: (a -> b) -> f a -> Aps f b
    <$>^ :: forall a b (f :: * -> *). (a -> b) -> f a -> Aps f b
    (<$>^) = (a -> b) -> f a -> Aps f b
    forall a b (f :: * -> *). (a -> b) -> f a -> Aps f b
    FmapLift
    {-# INLINE (<$>^) #-}

    -- | @u \<*>^ v@ appends an @f@-action @v@ to the right of an @('Aps' f)@-action @u@.
    --
    -- @u \<*>^ v@ is a shorthand for @u \<*> 'liftAps' v@.
    (<*>^) :: Applicative f => Aps f (a -> b) -> f a -> Aps f b
    Aps f (a -> b)
    u <*>^ :: forall (f :: * -> *) a b.
    Applicative f =>
    Aps f (a -> b) -> f a -> Aps f b
    <*>^ f a
    v = Aps f (a -> b)
    u Aps f (a -> b) -> Aps f a -> Aps f b
    forall a b. Aps f (a -> b) -> Aps f a -> Aps f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f a -> Aps f a
    forall (f :: * -> *) a. f a -> Aps f a
    liftAps f a
    v
    {-# INLINE (<*>^) #-}

    -- | Lift an @f@-action into @'Aps' f@.
    liftAps :: f a -> Aps f a
    liftAps :: forall (f :: * -> *) a. f a -> Aps f a
    liftAps = (a -> a) -> f a -> Aps f a
    forall a b (f :: * -> *). (a -> b) -> f a -> Aps f b
    FmapLift a -> a
    forall a. a -> a
    id
    {-# INLINE liftAps #-}

    -- | Lower an @f@-action from @'Aps' f@.
    lowerAps :: Applicative f => Aps f a -> f a
    lowerAps :: forall (f :: * -> *) a. Applicative f => Aps f a -> f a
    lowerAps (Pure a
    x) = a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x
    lowerAps (FmapLift x -> a
    f f x
    u) = (x -> a) -> f x -> f a
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap x -> a
    f f x
    u
    lowerAps (LiftA2Aps x -> y -> z -> a
    f f x
    u f y
    v ApDList f z
    w) =
       Yoneda f (z -> a) -> ApDList f z -> f a
    forall (f :: * -> *) b c. Yoneda f (b -> c) -> ApDList f b -> f c
    lowerApDList ((forall x. ((z -> a) -> x) -> f x) -> Yoneda f (z -> a)
    forall (f :: * -> *) a. (forall x. (a -> x) -> f x) -> Yoneda f a
    Yoneda (\(z -> a) -> x
    k -> (x -> y -> x) -> f x -> f y -> f x
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (\x
    x y
    y -> (z -> a) -> x
    k (x -> y -> z -> a
    f x
    x y
    y)) f x
    u f y
    v)) ApDList f z
    w
    {-# INLINE lowerAps #-}

    instance Functor (Aps f) where
      fmap :: forall a b. (a -> b) -> Aps f a -> Aps f b
    fmap a -> b
    f (Pure a
    x) = b -> Aps f b
    forall a (f :: * -> *). a -> Aps f a
    Pure (a -> b
    f a
    x)
      fmap a -> b
    f (FmapLift x -> a
    g f x
    u) = (x -> b) -> f x -> Aps f b
    forall a b (f :: * -> *). (a -> b) -> f a -> Aps f b
    FmapLift (a -> b
    f (a -> b) -> (x -> a) -> x -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . x -> a
    g) f x
    u
      fmap a -> b
    f (LiftA2Aps x -> y -> z -> a
    g f x
    u f y
    v ApDList f z
    w) = (x -> y -> z -> b) -> f x -> f y -> ApDList f z -> Aps f b
    forall x y z a (f :: * -> *).
    (x -> y -> z -> a) -> f x -> f y -> ApDList f z -> Aps f a
    LiftA2Aps ((((y -> z -> a) -> y -> z -> b)
    -> (x -> y -> z -> a) -> x -> y -> z -> b
    forall a b. (a -> b) -> (x -> a) -> x -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((y -> z -> a) -> y -> z -> b)
     -> (x -> y -> z -> a) -> x -> y -> z -> b)
    -> ((a -> b) -> (y -> z -> a) -> y -> z -> b)
    -> (a -> b)
    -> (x -> y -> z -> a)
    -> x
    -> y
    -> z
    -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((z -> a) -> z -> b) -> (y -> z -> a) -> y -> z -> b
    forall a b. (a -> b) -> (y -> a) -> y -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((z -> a) -> z -> b) -> (y -> z -> a) -> y -> z -> b)
    -> ((a -> b) -> (z -> a) -> z -> b)
    -> (a -> b)
    -> (y -> z -> a)
    -> y
    -> z
    -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> b) -> (z -> a) -> z -> b
    forall a b. (a -> b) -> (z -> a) -> z -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) a -> b
    f x -> y -> z -> a
    g) f x
    u f y
    v ApDList f z
    w
      {-# INLINE fmap #-}

    instance Applicative f => Applicative (Aps f) where
      pure :: forall a. a -> Aps f a
    pure = a -> Aps f a
    forall a (f :: * -> *). a -> Aps f a
    Pure
      Pure a -> b
    f <*> :: forall a b. Aps f (a -> b) -> Aps f a -> Aps f b
    <*> Aps f a
    uy = (a -> b) -> Aps f a -> Aps f b
    forall a b. (a -> b) -> Aps f a -> Aps f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Aps f a
    uy
      FmapLift x -> a -> b
    f f x
    ux <*> Aps f a
    uy = (x -> a -> b) -> f x -> Aps f a -> Aps f b
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> Aps f b -> Aps f c
    liftA2Aps x -> a -> b
    f f x
    ux Aps f a
    uy
      LiftA2Aps x -> y -> z -> a -> b
    f f x
    u f y
    v ApDList f z
    w <*> Aps f a
    ww =
        (x -> y -> (z, a) -> b)
    -> f x -> f y -> ApDList f (z, a) -> Aps f b
    forall x y z a (f :: * -> *).
    (x -> y -> z -> a) -> f x -> f y -> ApDList f z -> Aps f a
    LiftA2Aps (\x
    x y
    y (z
    z, a
    zz) -> x -> y -> z -> a -> b
    f x
    x y
    y z
    z a
    zz) f x
    u f y
    v ((z -> a -> (z, a))
    -> ApDList f z -> ApDList f a -> ApDList f (z, a)
    forall a b c.
    (a -> b -> c) -> ApDList f a -> ApDList f b -> ApDList f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) ApDList f z
    w (Aps f a -> ApDList f a
    forall (f :: * -> *) a. Applicative f => Aps f a -> ApDList f a
    apsToApDList Aps f a
    ww))
      {-# INLINE pure #-}
      {-# INLINE (<*>) #-}

    -- | Append an action to the left of an 'Aps'.
    liftA2Aps :: Applicative f => (a -> b -> c) -> f a -> Aps f b -> Aps f c
    liftA2Aps :: forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> Aps f b -> Aps f c
    liftA2Aps a -> b -> c
    f f a
    ux (Pure b
    y) = (a -> c) -> f a -> Aps f c
    forall a b (f :: * -> *). (a -> b) -> f a -> Aps f b
    FmapLift (\a
    x -> a -> b -> c
    f a
    x b
    y) f a
    ux
    liftA2Aps a -> b -> c
    f f a
    ux (FmapLift x -> b
    g f x
    uy) = (a -> x -> () -> c) -> f a -> f x -> ApDList f () -> Aps f c
    forall x y z a (f :: * -> *).
    (x -> y -> z -> a) -> f x -> f y -> ApDList f z -> Aps f a
    LiftA2Aps (\a
    x x
    y ()
    _ -> a -> b -> c
    f a
    x (x -> b
    g x
    y)) f a
    ux f x
    uy (() -> ApDList f ()
    forall a. a -> ApDList f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
    liftA2Aps a -> b -> c
    f f a
    ux (LiftA2Aps x -> y -> z -> b
    g f x
    u f y
    v ApDList f z
    w) =
      (a -> x -> (y, z) -> c)
    -> f a -> f x -> ApDList f (y, z) -> Aps f c
    forall x y z a (f :: * -> *).
    (x -> y -> z -> a) -> f x -> f y -> ApDList f z -> Aps f a
    LiftA2Aps (\a
    x x
    y (y
    z, z
    zz) -> a -> b -> c
    f a
    x (x -> y -> z -> b
    g x
    y y
    z z
    zz)) f a
    ux f x
    u ((y -> z -> (y, z))
    -> ApDList f y -> ApDList f z -> ApDList f (y, z)
    forall a b c.
    (a -> b -> c) -> ApDList f a -> ApDList f b -> ApDList f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) (f y -> ApDList f y
    forall (f :: * -> *) a. Applicative f => f a -> ApDList f a
    liftApDList f y
    v) ApDList f z
    w)
    {-# INLINE liftA2Aps #-}

    -- | Conversion from 'Aps' to 'ApDList'.
    apsToApDList :: Applicative f => Aps f a -> ApDList f a
    apsToApDList :: forall (f :: * -> *) a. Applicative f => Aps f a -> ApDList f a
    apsToApDList (Pure a
    x) = a -> ApDList f a
    forall a. a -> ApDList f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x
    apsToApDList (FmapLift x -> a
    f f x
    u) = (x -> a) -> ApDList f x -> ApDList f a
    forall a b. (a -> b) -> ApDList f a -> ApDList f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap x -> a
    f (f x -> ApDList f x
    forall (f :: * -> *) a. Applicative f => f a -> ApDList f a
    liftApDList f x
    u)
    apsToApDList (LiftA2Aps x -> y -> z -> a
    f f x
    u f y
    v ApDList f z
    w) = (x -> y -> z -> a)
    -> ApDList f x -> ApDList f y -> ApDList f z -> ApDList f a
    forall (f :: * -> *) a b c d.
    Applicative f =>
    (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    liftA3 x -> y -> z -> a
    f (f x -> ApDList f x
    forall (f :: * -> *) a. Applicative f => f a -> ApDList f a
    liftApDList f x
    u) (f y -> ApDList f y
    forall (f :: * -> *) a. Applicative f => f a -> ApDList f a
    liftApDList f y
    v) ApDList f z
    w
    {-# INLINE apsToApDList #-}