{-# LANGUAGE TupleSections #-} module Proarrow.Promonad.Writer where import Prelude (Monoid(..), (<>), fmap) import Proarrow.Core (Promonad(..), Profunctor(..)) import Proarrow.Category.Monoidal (MonoidalProfunctor (..)) import Proarrow.Object.BinaryProduct () newtype Writer m a b = Writer { forall m a b. Writer m a b -> a -> (m, b) getWriter :: a -> (m, b) } instance Profunctor (Writer m) where dimap :: forall c a b d. (c ~> a) -> (b ~> d) -> Writer m a b -> Writer m c d dimap c ~> a l b ~> d r (Writer a -> (m, b) f) = (c -> (m, d)) -> Writer m c d forall m a b. (a -> (m, b)) -> Writer m a b Writer ((b -> d) -> (m, b) -> (m, d) forall a b. (a -> b) -> (m, a) -> (m, b) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap b ~> d b -> d r ((m, b) -> (m, d)) -> (c -> (m, b)) -> c -> (m, d) forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k). Promonad p => p b c -> p a b -> p a c . a -> (m, b) f (a -> (m, b)) -> (c -> a) -> c -> (m, b) forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k). Promonad p => p b c -> p a b -> p a c . c ~> a c -> a l) instance Monoid m => Promonad (Writer m) where id :: forall a. Ob a => Writer m a a id = (a -> (m, a)) -> Writer m a a forall m a b. (a -> (m, b)) -> Writer m a b Writer (m forall a. Monoid a => a mempty,) Writer b -> (m, c) g . :: forall b c a. Writer m b c -> Writer m a b -> Writer m a c . Writer a -> (m, b) f = (a -> (m, c)) -> Writer m a c forall m a b. (a -> (m, b)) -> Writer m a b Writer \a a -> case a -> (m, b) f a a of (m m1, b b) -> case b -> (m, c) g b b of (m m2, c c) -> (m m1 m -> m -> m forall a. Semigroup a => a -> a -> a <> m m2, c c) instance Monoid m => MonoidalProfunctor (Writer m) where lift0 :: Writer m Unit Unit lift0 = Writer m () () Writer m Unit Unit forall a. Ob a => Writer m a a forall {k} (p :: PRO k k) (a :: k). (Promonad p, Ob a) => p a a id lift2 :: forall x1 x2 y1 y2. Writer m x1 x2 -> Writer m y1 y2 -> Writer m (x1 ** y1) (x2 ** y2) lift2 (Writer x1 -> (m, x2) f) (Writer y1 -> (m, y2) g) = ((x1, y1) -> (m, (x2, y2))) -> Writer m (x1, y1) (x2, y2) forall m a b. (a -> (m, b)) -> Writer m a b Writer \(x1 a1, y1 a2) -> case x1 -> (m, x2) f x1 a1 of (m m1, x2 b1) -> case y1 -> (m, y2) g y1 a2 of (m m2, y2 b2) -> (m m1 m -> m -> m forall a. Semigroup a => a -> a -> a <> m m2, (x2 b1, y2 b2))