{-|
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 qualified do-notation
with pattern bonding.
-}

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

import Control.Lens
import Control.Monad hiding ((>>=), (>>), return)
import Control.Monad.Fail.Try
import Data.Profunctor.Monoidal
import Prelude hiding ((>>=), (>>), return)

{- | 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 `>*<`.

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 (f :: * -> *) a. Applicative f => a -> f a
pure (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

{- | @P.@`return` is a `Monadic`-restricted
version of `pureP`.

prop> pureP = P.return
-}
return :: (Monadic p, Choice p) => Prism a b () () -> p a b
return :: forall (p :: * -> * -> *) a b.
(Monadic p, Choice p) =>
Prism a b () () -> p a b
return = APrism a b () () -> p a b
Prism a b () () -> p a b
forall (p :: * -> * -> *) a b.
(Monoidal p, Choice p) =>
APrism a b () () -> p a b
pureP

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