{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- | A carrier for 'Choose' effects (nondeterminism without failure).

Under the hood, it uses a Church-encoded binary tree to avoid the problems associated with a naïve list-based implementation (see ["ListT done right"](http://wiki.haskell.org/ListT_done_right)).

@since 1.0.0.0
-}

module Control.Carrier.Choose.Church
( -- * Choose carrier
  runChoose
, runChooseS
, ChooseC(..)
  -- * Choose effect
, module Control.Effect.Choose
) where

import Control.Algebra
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Effect.Choose
import Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Coerce (coerce)
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty(..), head, tail)
import Data.Semigroup as S
import Prelude hiding (head, tail)

-- | Run a 'Choose' effect with continuations respectively interpreting '<|>' and 'pure'.
--
-- @
-- runChoose fork leaf ('pure' a '<|>' b) = leaf a \`fork\` 'runChoose' fork leaf b
-- @
--
-- @since 1.0.0.0
runChoose :: (m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose :: forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose m b -> m b -> m b
fork a -> m b
leaf (ChooseC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
runChooseC) = (m b -> m b -> m b) -> (a -> m b) -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
runChooseC m b -> m b -> m b
fork a -> m b
leaf
{-# INLINE runChoose #-}

-- | Run a 'Choose' effect, mapping results into a 'S.Semigroup'.
--
-- @since 1.0.0.0
runChooseS :: (S.Semigroup b, Applicative m) => (a -> m b) -> ChooseC m a -> m b
runChooseS :: forall b (m :: * -> *) a.
(Semigroup b, Applicative m) =>
(a -> m b) -> ChooseC m a -> m b
runChooseS = (m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose ((b -> b -> b) -> m b -> m b -> m b
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(S.<>))
{-# INLINE runChooseS #-}

-- | A carrier for 'Choose' effects based on Ralf Hinze’s design described in [Deriving Backtracking Monad Transformers](https://www.cs.ox.ac.uk/ralf.hinze/publications/#P12).
--
-- @since 1.0.0.0
newtype ChooseC m a = ChooseC (forall b . (m b -> m b -> m b) -> (a -> m b) -> m b)
  deriving ((forall a b. (a -> b) -> ChooseC m a -> ChooseC m b)
-> (forall a b. a -> ChooseC m b -> ChooseC m a)
-> Functor (ChooseC m)
forall a b. a -> ChooseC m b -> ChooseC m a
forall a b. (a -> b) -> ChooseC m a -> ChooseC m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> ChooseC m b -> ChooseC m a
forall (m :: * -> *) a b. (a -> b) -> ChooseC m a -> ChooseC m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> ChooseC m a -> ChooseC m b
fmap :: forall a b. (a -> b) -> ChooseC m a -> ChooseC m b
$c<$ :: forall (m :: * -> *) a b. a -> ChooseC m b -> ChooseC m a
<$ :: forall a b. a -> ChooseC m b -> ChooseC m a
Functor)

instance Applicative (ChooseC m) where
  pure :: forall a. a -> ChooseC m a
pure a
a = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC (\ m b -> m b -> m b
_ a -> m b
leaf -> a -> m b
leaf a
a)
  {-# INLINE pure #-}

  ChooseC forall b. (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b
f <*> :: forall a b. ChooseC m (a -> b) -> ChooseC m a -> ChooseC m b
<*> ChooseC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
a = (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b) -> ChooseC m b
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC ((forall b. (m b -> m b -> m b) -> (b -> m b) -> m b)
 -> ChooseC m b)
-> (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b)
-> ChooseC m b
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork b -> m b
leaf ->
    (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b
forall b. (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b
f m b -> m b -> m b
fork (\ a -> b
f' -> (m b -> m b -> m b) -> (a -> m b) -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
a m b -> m b -> m b
fork (b -> m b
leaf (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f'))
  {-# INLINE (<*>) #-}

instance Monad (ChooseC m) where
  ChooseC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
a >>= :: forall a b. ChooseC m a -> (a -> ChooseC m b) -> ChooseC m b
>>= a -> ChooseC m b
f = (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b) -> ChooseC m b
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC ((forall b. (m b -> m b -> m b) -> (b -> m b) -> m b)
 -> ChooseC m b)
-> (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b)
-> ChooseC m b
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork b -> m b
leaf ->
    (m b -> m b -> m b) -> (a -> m b) -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b
a m b -> m b -> m b
fork ((m b -> m b -> m b) -> (b -> m b) -> ChooseC m b -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose m b -> m b -> m b
fork b -> m b
leaf (ChooseC m b -> m b) -> (a -> ChooseC m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ChooseC m b
f)
  {-# INLINE (>>=) #-}

instance Fail.MonadFail m => Fail.MonadFail (ChooseC m) where
  fail :: forall a. String -> ChooseC m a
fail String
s = m a -> ChooseC m a
forall (m :: * -> *) a. Monad m => m a -> ChooseC m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s)
  {-# INLINE fail #-}

-- | Separate fixpoints are computed for each branch.
instance MonadFix m => MonadFix (ChooseC m) where
  mfix :: forall a. (a -> ChooseC m a) -> ChooseC m a
mfix a -> ChooseC m a
f = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC ((forall b. (m b -> m b -> m b) -> (a -> m b) -> m b)
 -> ChooseC m a)
-> (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b)
-> ChooseC m a
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork a -> m b
leaf ->
    (NonEmpty a -> m (NonEmpty a)) -> m (NonEmpty a)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> m (NonEmpty a)) -> ChooseC m a -> m (NonEmpty a)
forall b (m :: * -> *) a.
(Semigroup b, Applicative m) =>
(a -> m b) -> ChooseC m a -> m b
runChooseS (NonEmpty a -> m (NonEmpty a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty a -> m (NonEmpty a))
-> (a -> NonEmpty a) -> a -> m (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ChooseC m a -> m (NonEmpty a))
-> (NonEmpty a -> ChooseC m a) -> NonEmpty a -> m (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ChooseC m a
f (a -> ChooseC m a)
-> (NonEmpty a -> a) -> NonEmpty a -> ChooseC m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall a. NonEmpty a -> a
head)
    m (NonEmpty a) -> (NonEmpty a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      a
a :| [] -> a -> m b
leaf a
a
      a
a :| [a]
_  -> a -> m b
leaf a
a m b -> m b -> m b
`fork` (m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose m b -> m b -> m b
fork a -> m b
leaf ((a -> ChooseC m a) -> ChooseC m a
forall a. (a -> ChooseC m a) -> ChooseC m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (m [a] -> ChooseC m a
forall {m :: * -> *} {t :: * -> *} {a}.
(Monad m, Foldable t, Functor t) =>
m (t a) -> ChooseC m a
liftAll (m [a] -> ChooseC m a) -> (a -> m [a]) -> a -> ChooseC m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> [a]) -> m (NonEmpty a) -> m [a]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
tail (m (NonEmpty a) -> m [a]) -> (a -> m (NonEmpty a)) -> a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (NonEmpty a)) -> ChooseC m a -> m (NonEmpty a)
forall b (m :: * -> *) a.
(Semigroup b, Applicative m) =>
(a -> m b) -> ChooseC m a -> m b
runChooseS (NonEmpty a -> m (NonEmpty a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty a -> m (NonEmpty a))
-> (a -> NonEmpty a) -> a -> m (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ChooseC m a -> m (NonEmpty a))
-> (a -> ChooseC m a) -> a -> m (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ChooseC m a
f))
      where
    liftAll :: m (t a) -> ChooseC m a
liftAll m (t a)
m = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC ((forall b. (m b -> m b -> m b) -> (a -> m b) -> m b)
 -> ChooseC m a)
-> (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b)
-> ChooseC m a
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork a -> m b
leaf -> m (t a)
m m (t a) -> (t a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m b -> m b -> m b) -> t (m b) -> m b
forall a. (a -> a -> a) -> t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 m b -> m b -> m b
fork (t (m b) -> m b) -> (t a -> t (m b)) -> t a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> t a -> t (m b)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m b
leaf
  {-# INLINE mfix #-}

instance MonadIO m => MonadIO (ChooseC m) where
  liftIO :: forall a. IO a -> ChooseC m a
liftIO IO a
io = m a -> ChooseC m a
forall (m :: * -> *) a. Monad m => m a -> ChooseC m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)
  {-# INLINE liftIO #-}

instance MonadTrans ChooseC where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ChooseC m a
lift m a
m = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC (\ m b -> m b -> m b
_ a -> m b
leaf -> m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
leaf)
  {-# INLINE lift #-}

instance Algebra sig m => Algebra (Choose :+: sig) (ChooseC m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (ChooseC m)
-> (:+:) Choose sig n a -> ctx () -> ChooseC m (ctx a)
alg Handler ctx n (ChooseC m)
hdl (:+:) Choose sig n a
sig ctx ()
ctx = (forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b)
-> ChooseC m (ctx a)
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b) -> ChooseC m a
ChooseC ((forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b)
 -> ChooseC m (ctx a))
-> (forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b)
-> ChooseC m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork ctx a -> m b
leaf -> case (:+:) Choose sig n a
sig of
    L Choose n a
Choose -> ctx a -> m b
leaf (a
Bool
True a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) m b -> m b -> m b
`fork` ctx a -> m b
leaf (a
Bool
False a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R sig n a
other  -> Handler (Compose (ChooseC Identity) ctx) n m
-> sig n a
-> ChooseC Identity (ctx ())
-> m (ChooseC Identity (ctx a))
forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (ChooseC Identity (ChooseC m x) -> m (ChooseC Identity x)
forall {x}.
ChooseC Identity (ChooseC m x) -> m (ChooseC Identity x)
forall (m :: * -> *) a.
Applicative m =>
ChooseC Identity (ChooseC m a) -> m (ChooseC Identity a)
dst (forall {x}.
 ChooseC Identity (ChooseC m x) -> m (ChooseC Identity x))
-> Handler ctx n (ChooseC m)
-> Handler (Compose (ChooseC Identity) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> ChooseC m (ctx x)
Handler ctx n (ChooseC m)
hdl) sig n a
other (ctx () -> ChooseC Identity (ctx ())
forall a. a -> ChooseC Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ctx ()
ctx) m (ChooseC Identity (ctx a))
-> (ChooseC Identity (ctx a) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identity (m b) -> m b
forall a. Identity a -> a
run (Identity (m b) -> m b)
-> (ChooseC Identity (ctx a) -> Identity (m b))
-> ChooseC Identity (ctx a)
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (m b) -> Identity (m b) -> Identity (m b))
-> (ctx a -> Identity (m b))
-> ChooseC Identity (ctx a)
-> Identity (m b)
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose ((m b -> m b -> m b)
-> Identity (m b) -> Identity (m b) -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce m b -> m b -> m b
fork) ((ctx a -> m b) -> ctx a -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce ctx a -> m b
leaf)
    where
    dst :: Applicative m => ChooseC Identity (ChooseC m a) -> m (ChooseC Identity a)
    dst :: forall (m :: * -> *) a.
Applicative m =>
ChooseC Identity (ChooseC m a) -> m (ChooseC Identity a)
dst = Identity (m (ChooseC Identity a)) -> m (ChooseC Identity a)
forall a. Identity a -> a
run (Identity (m (ChooseC Identity a)) -> m (ChooseC Identity a))
-> (ChooseC Identity (ChooseC m a)
    -> Identity (m (ChooseC Identity a)))
-> ChooseC Identity (ChooseC m a)
-> m (ChooseC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (m (ChooseC Identity a))
 -> Identity (m (ChooseC Identity a))
 -> Identity (m (ChooseC Identity a)))
-> (ChooseC m a -> Identity (m (ChooseC Identity a)))
-> ChooseC Identity (ChooseC m a)
-> Identity (m (ChooseC Identity a))
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose ((m (ChooseC Identity a)
 -> m (ChooseC Identity a) -> m (ChooseC Identity a))
-> Identity (m (ChooseC Identity a))
-> Identity (m (ChooseC Identity a))
-> Identity (m (ChooseC Identity a))
forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((ChooseC Identity a -> ChooseC Identity a -> ChooseC Identity a)
-> m (ChooseC Identity a)
-> m (ChooseC Identity a)
-> m (ChooseC Identity a)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChooseC Identity a -> ChooseC Identity a -> ChooseC Identity a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
(<|>))) (m (ChooseC Identity a) -> Identity (m (ChooseC Identity a))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (ChooseC Identity a) -> Identity (m (ChooseC Identity a)))
-> (ChooseC m a -> m (ChooseC Identity a))
-> ChooseC m a
-> Identity (m (ChooseC Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (ChooseC Identity a)
 -> m (ChooseC Identity a) -> m (ChooseC Identity a))
-> (a -> m (ChooseC Identity a))
-> ChooseC m a
-> m (ChooseC Identity a)
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b
runChoose ((ChooseC Identity a -> ChooseC Identity a -> ChooseC Identity a)
-> m (ChooseC Identity a)
-> m (ChooseC Identity a)
-> m (ChooseC Identity a)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChooseC Identity a -> ChooseC Identity a -> ChooseC Identity a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
(<|>)) (ChooseC Identity a -> m (ChooseC Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChooseC Identity a -> m (ChooseC Identity a))
-> (a -> ChooseC Identity a) -> a -> m (ChooseC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ChooseC Identity a
forall a. a -> ChooseC Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure))
  {-# INLINE alg #-}