{-|
Module      : Data.Profunctor.Monadic
Description : monadic profunctors
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See Li-yao Xia, [Monadic profunctors for bidirectional programming]
(https://blog.poisson.chat/posts/2017-01-01-monadic-profunctors.html)

This module can provide qualified do-notation for `Monadic` profunctors.

>>> :set -XQualifiedDo
>>> import qualified Data.Profunctor.Monadic as P

See "Control.Lens.Grammar#t:CtxGrammar" for
an example of how to use "bonding" notation.
-}

module Data.Profunctor.Monadic
  ( -- * Monadic
    Monadic
  , (>>=)
  , (>>)
  , return
  , fail
  ) where

import Data.Profunctor
import Prelude hiding ((>>=), (>>))

{- | A `Profunctor` which is also a `Monad`. -}
type Monadic p = (Profunctor p, forall x. Monad (p x))

{- | The pair bonding operator @P.@`>>=` is a context-sensitive
version of `Data.Profunctor.Monoidal.>*<`.

prop> x >*< y = x P.>>= (\_ -> y)
-}
(>>=) :: Monadic p => p a b -> (b -> p c d) -> p (a,c) (b,d)
infixl 1 >>=
p a b
p >>= :: forall (p :: * -> * -> *) a b c d.
Monadic p =>
p a b -> (b -> p c d) -> p (a, c) (b, d)
>>= b -> p c d
f = do
  b
b <- ((a, c) -> a) -> p a b -> p (a, c) b
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, c) -> a
forall a b. (a, b) -> a
fst p a b
p
  d
d <- ((a, c) -> c) -> p c d -> p (a, c) d
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, c) -> c
forall a b. (a, b) -> b
snd (b -> p c d
f b
b)
  (b, d) -> p (a, c) (b, d)
forall a. a -> p (a, c) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b,d
d)

{- | @P.@`>>` sequences actions. -}
(>>) :: Monadic p => p () c -> p a b -> p a b
infixl 1 >>
p () c
x >> :: forall (p :: * -> * -> *) c a b.
Monadic p =>
p () c -> p a b -> p a b
>> p a b
y = do c
_ <- (a -> ()) -> p () c -> p a c
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (() -> a -> ()
forall a b. a -> b -> a
const ()) p () c
x; p a b
y