module Data.Profunctor.Writer where import Data.Profunctor import Control.Category (Category) import qualified Control.Category as C import Data.Bifunctor (first) import Data.Profunctor.Writer.Class newtype WriterT w p a b = WriterT (p a (b, w)) instance Profunctor p => Profunctor (WriterT w p) where dimap :: (a -> b) -> (c -> d) -> WriterT w p b c -> WriterT w p a d dimap f :: a -> b f g :: c -> d g (WriterT w :: p b (c, w) w) = p a (d, w) -> WriterT w p a d forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT ((a -> b) -> ((c, w) -> (d, w)) -> p b (c, w) -> p a (d, w) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap a -> b f ((c -> d) -> (c, w) -> (d, w) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first c -> d g) p b (c, w) w) instance (Monoid w, Category p, Strong p) => Category (WriterT w p) where id :: WriterT w p a a id = p a (a, w) -> WriterT w p a a forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT ((a -> (a, w)) -> p a a -> p a (a, w) forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (\b :: a b -> (a b, w forall a. Monoid a => a mempty)) p a a forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a C.id) WriterT x :: p b (c, w) x . :: WriterT w p b c -> WriterT w p a b -> WriterT w p a c . WriterT y :: p a (b, w) y = p a (c, w) -> WriterT w p a c forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT ((((c, w), w) -> (c, w)) -> p (b, w) ((c, w), w) -> p (b, w) (c, w) forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (\((c :: c c, w :: w w), w' :: w w') -> (c c, w w w -> w -> w forall a. Semigroup a => a -> a -> a <> w w')) (p b (c, w) -> p (b, w) ((c, w), w) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (a, c) (b, c) first' p b (c, w) x) p (b, w) (c, w) -> p a (b, w) -> p a (c, w) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c C.. p a (b, w) y) instance (Profunctor p, Monoid w) => ProfunctorWriter' w (WriterT w p) where tell' :: WriterT w p a (b, w) -> WriterT w p a b tell' (WriterT p :: p a ((b, w), w) p) = p a (b, w) -> WriterT w p a b forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT ((((b, w), w) -> (b, w)) -> p a ((b, w), w) -> p a (b, w) forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (\((b :: b b, w :: w w), w' :: w w') -> (b b, w w w -> w -> w forall a. Semigroup a => a -> a -> a <> w w')) p a ((b, w), w) p) listen' :: WriterT w p a b -> WriterT w p a (b, w) listen' (WriterT p :: p a (b, w) p) = p a ((b, w), w) -> WriterT w p a (b, w) forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT (((b, w) -> ((b, w), w)) -> p a (b, w) -> p a ((b, w), w) forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (\(b :: b b, w :: w w) -> ((b b, w w), w w)) p a (b, w) p) pass' :: WriterT w p a (b, w -> w) -> WriterT w p a b pass' (WriterT p :: p a ((b, w -> w), w) p) = p a (b, w) -> WriterT w p a b forall w (p :: * -> * -> *) a b. p a (b, w) -> WriterT w p a b WriterT ((((b, w -> w), w) -> (b, w)) -> p a ((b, w -> w), w) -> p a (b, w) forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap (\((b :: b b, f :: w -> w f), w :: w w) -> (b b, w -> w f w w)) p a ((b, w -> w), w) p)