Implement initial BindLeft and MonadLeft

src/Control/ApplicativeLeft.purs

@@ -0,0 +1,18 @@
+module Control.ApplicativeLeft where
+
+import Prelude
+import Control.ApplyLeft (class ApplyLeft, lapply)
+
+-- | Same as `Applicative` but works on the left parameter in a Bifunctor.
+class ApplyLeft w <= ApplicativeLeft w where
+  lpure :: forall a b. a -> w a b
+
+-- | Perform an applicative action when a condition is true.
+lwhen :: forall m c. ApplicativeLeft m => Boolean -> m Unit c -> m Unit c
+lwhen true m = m
+lwhen false _ = lpure unit
+
+-- | Perform an applicative action unless a condition is true.
+lunless :: forall m c. ApplicativeLeft m => Boolean -> m Unit c -> m Unit c
+lunless false m = m
+lunless true _ = lpure unit

src/Control/ApplyLeft.purs

@@ -0,0 +1,36 @@
+module Control.ApplyLeft where
+
+import Prelude
+import Data.Bifunctor (class Bifunctor, lmap)
+
+-- | Same as `Apply` but works on the left parameter in a Bifunctor.
+class Bifunctor w <= ApplyLeft w where
+  lapply :: forall a b c. w (a -> b) c -> w a c -> w b c
+
+-- | Combine two effectful actions, keeping only the result of the first.
+lapplyFirst :: forall a b c w. ApplyLeft w => w a c -> w b c -> w a c
+lapplyFirst a b = lapply (lmap const a) b
+
+-- | Combine two effectful actions, keeping only the result of the second.
+lapplySecond :: forall w a b c. ApplyLeft w => w a c -> w b c -> w b c
+lapplySecond a b = lapply (lmap (const identity) a) b
+
+-- | Lift a function of two arguments to a function which accepts and returns
+-- | values wrapped with the type constructor `f`.
+llift2 :: forall a b c w x. ApplyLeft w => (a -> b -> c) -> w a x -> w b x -> w c x
+llift2 f a b = f `lmap` a `lapply` b
+
+-- | Lift a function of three arguments to a function which accepts and returns
+-- | values wrapped with the type constructor `f`.
+llift3 :: forall a b c d w x. ApplyLeft w => (a -> b -> c -> d) -> w a x -> w b x -> w c x -> w d x
+llift3 f a b c = f `lmap` a `lapply` b `lapply` c
+
+-- | Lift a function of four arguments to a function which accepts and returns
+-- | values wrapped with the type constructor `f`.
+llift4 :: forall a b c d e w x. ApplyLeft w => (a -> b -> c -> d -> e) -> w a x -> w b x -> w c x -> w d x -> w e x
+llift4 f a b c d = f `lmap` a `lapply` b `lapply` c `lapply` d
+
+-- | Lift a function of five arguments to a function which accepts and returns
+-- | values wrapped with the type constructor `f`.
+llift5 :: forall a b c d e g w x. ApplyLeft w => (a -> b -> c -> d -> e -> g) -> w a x -> w b x -> w c x -> w d x -> w e x -> w g x
+llift5 f a b c d e = f `lmap` a `lapply` b `lapply` c `lapply` d `lapply` e

src/Control/BindLeft.purs

@@ -0,0 +1,30 @@
+module Control.BindLeft where
+
+import Data.Unit (Unit)
+import Control.Category (identity)
+
+-- | Same as `Discard` but works on the left parameter of the bifunctor
+-- | rather than the right parameter, which is the default for `Discard`.
+class DiscardLeft a where
+  ldiscard :: forall k (m :: Type -> k -> Type) b r. BindLeft m => m a r -> (a -> m b r) -> m b r
+
+instance discardLeftUnit :: DiscardLeft Unit where
+  ldiscard ma aToMB = lbind ma aToMB
+
+-- | Same as `Bind` but works on the left parameter of the bifunctor
+-- | rather than the right parameter, which is the default for `Bind`.
+class BindLeft :: forall k. (Type -> k -> Type) -> Constraint
+class BindLeft m where
+  lbind :: forall a b r. m a r -> (a -> m b r) -> m b r
+
+ljoin :: forall m a r. BindLeft m => m (m a r) r -> m a r
+ljoin m = lbind m identity
+
+lcomposeKleisli :: forall m a b c r. BindLeft m => (a -> m b r) -> (b -> m c r) -> a -> m c r
+lcomposeKleisli aToMB bToMC a = lbind (aToMB a) bToMC
+
+lcomposeKleisliFlipped :: forall m a b c r. BindLeft m => (b -> m c r) -> (a -> m b r) -> a -> m c r
+lcomposeKleisliFlipped bToMC aToMB a = lbind (aToMB a) bToMC
+
+lifM :: forall m a r. BindLeft m => m Boolean r -> m a r -> m a r -> m a r
+lifM cond truePath falsePath = lbind cond \b -> if b then truePath else falsePath

src/Control/MonadLeft.purs

@@ -0,0 +1,17 @@
+module Control.MonadLeft where
+
+import Control.ApplicativeLeft (class ApplicativeLeft, lwhen, lunless)
+import Control.BindLeft (class BindLeft, lbind)
+import Data.Unit (Unit)
+
+class (ApplicativeLeft m, BindLeft m) <= MonadLeft m
+
+-- | Perform a monadic action when a condition is true, where the conditional
+-- | value is also in a monadic context.
+lwhenM :: forall m c. MonadLeft m => m Boolean c -> m Unit c -> m Unit c
+lwhenM mb m = lbind mb \b -> lwhen b m
+
+-- | Perform a monadic action unless a condition is true, where the conditional
+-- | value is also in a monadic context.
+lunlessM :: forall m c. MonadLeft m => m Boolean c -> m Unit c -> m Unit c
+lunlessM mb m = lbind mb \b -> lunless b m

src/Control/MonadLeft/Qualified.purs

@@ -0,0 +1,40 @@
+-- | Enables one to use `ado notation` and `do notation` on the left parameter
+-- | of a Bifunctor.
+-- |
+-- | `ado notation` example
+-- | ```
+-- | import Control.MonadLeft.Qualified as MonadLeft
+-- |
+-- | foo :: Either Int String -> Either String String
+-- | foo comp = MonadLeft.ado
+-- |   a <- comp
+-- |   b <- comp
+-- |   in show $ a + b
+-- | ```
+-- | `do notation` example
+-- | ```
+-- | import Control.MonadLeft.Qualified as MonadLeft
+-- |
+-- | foo :: Either Int String -> Either String String
+-- | foo comp = MonadLeft.do
+-- |   a <- comp
+-- |   b <- comp
+-- |   lpure $ show $ a + b
+-- | ```
+module Control.MonadLeft.Qualified where
+
+import Control.ApplyLeft (class ApplyLeft, lapply)
+import Control.BindLeft (class BindLeft, lbind, class DiscardLeft, ldiscard)
+import Data.Bifunctor (class Bifunctor, lmap)
+
+discard :: forall m a b r. DiscardLeft a => BindLeft m => m a r -> (a -> m b r) -> m b r
+discard = ldiscard
+
+bind :: forall m a b r. BindLeft m => m a r -> (a -> m b r) -> m b r
+bind = lbind
+
+apply :: forall m a b c. ApplyLeft m => m (a -> b) c -> m a c -> m b c
+apply = lapply
+
+map :: forall m a b c. Bifunctor m => (a -> b) -> m a c -> m b c
+map = lmap