A dual of Applicative

Comonoid.hs

-- https://github.com/viercc/functor-monad/tree/main/day-comonoid
{-# LANGUAGE GHC2021 #-}
import Data.Functor.Day
import Control.Comonad

data Multi f a where
  MZ :: a -> Multi f a
  MS :: Multi f (b -> a) -> f b -> Multi f a

fromMulti :: Applicative f => Multi f a -> f a
fromMulti (MZ a) = pure a
fromMulti (MS m f) = fromMulti m <*> f

liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 abcd fa fb fc = fromMulti (MS (MS (MS (MZ abcd) fa) fb) fc)

class Comonad f => Comonoid f where
  coapply :: f a -> Day f f a

toMulti :: Comonoid f => Int -> f a -> Multi f a
toMulti 0 f = MZ (extract f)
toMulti n f = case coapply f of Day fb fc bca -> MS (toMulti (n - 1) (bca <$> fb)) fc

unliftC3 :: Comonoid f => f d -> (forall a b c. (a -> b -> c -> d) -> f a -> f b -> f c -> r) -> r
unliftC3 f k = case toMulti 3 f of
  MS (MS (MS (MZ abcd) fa) fb) fc -> k abcd fa fb fc
  _ -> error "unliftC3"