Add monoid instances for uncurried EffectFns

src/Effect/Uncurried.purs

@@ -132,6 +132,7 @@
 
 module Effect.Uncurried where
 
+import Data.Monoid (class Monoid, class Semigroup, mempty, (<>))
 import Effect (Effect)
 
 foreign import data EffectFn1 :: Type -> Type -> Type
@@ -186,3 +187,71 @@ foreign import runEffectFn9 :: forall a b c d e f g h i r.
   EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r
 foreign import runEffectFn10 :: forall a b c d e f g h i j r.
   EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r
+
+-- The reason these are written eta-expanded instead of as:
+-- ```
+-- append f1 f2 = mkEffectFnN $ runEffectFnN f1 <> runEffectFnN f2
+-- ```
+-- is to help the compiler recognize that it can emit uncurried
+-- JS functions (which are more efficient), when an appended
+-- EffectFn is applied to all its arguments
+
+instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where
+  append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a
+
+instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where
+  append f1 f2 = mkEffectFn2 \a b -> runEffectFn2 f1 a b <> runEffectFn2 f2 a b
+
+instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where
+  append f1 f2 = mkEffectFn3 \a b c -> runEffectFn3 f1 a b c <> runEffectFn3 f2 a b c
+
+instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where
+  append f1 f2 = mkEffectFn4 \a b c d -> runEffectFn4 f1 a b c d <> runEffectFn4 f2 a b c d
+
+instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where
+  append f1 f2 = mkEffectFn5 \a b c d e -> runEffectFn5 f1 a b c d e <> runEffectFn5 f2 a b c d e
+
+instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where
+  append f1 f2 = mkEffectFn6 \a b c d e f -> runEffectFn6 f1 a b c d e f <> runEffectFn6 f2 a b c d e f
+
+instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where
+  append f1 f2 = mkEffectFn7 \a b c d e f g -> runEffectFn7 f1 a b c d e f g <> runEffectFn7 f2 a b c d e f g
+
+instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where
+  append f1 f2 = mkEffectFn8 \a b c d e f g h -> runEffectFn8 f1 a b c d e f g h <> runEffectFn8 f2 a b c d e f g h
+
+instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where
+  append f1 f2 = mkEffectFn9 \a b c d e f g h i -> runEffectFn9 f1 a b c d e f g h i <> runEffectFn9 f2 a b c d e f g h i
+
+instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where
+  append f1 f2 = mkEffectFn10 \a b c d e f g h i j -> runEffectFn10 f1 a b c d e f g h i j <> runEffectFn10 f2 a b c d e f g h i j
+
+instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where
+  mempty = mkEffectFn1 \_ -> mempty
+
+instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where
+  mempty = mkEffectFn2 \_ _ -> mempty
+
+instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where
+  mempty = mkEffectFn3 \_ _ _ -> mempty
+
+instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where
+  mempty = mkEffectFn4 \_ _ _ _ -> mempty
+
+instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where
+  mempty = mkEffectFn5 \_ _ _ _ _ -> mempty
+
+instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where
+  mempty = mkEffectFn6 \_ _ _ _ _ _ -> mempty
+
+instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where
+  mempty = mkEffectFn7 \_ _ _ _ _ _ _ -> mempty
+
+instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where
+  mempty = mkEffectFn8 \_ _ _ _ _ _ _ _ -> mempty
+
+instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where
+  mempty = mkEffectFn9 \_ _ _ _ _ _ _ _ _ -> mempty
+
+instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where
+  mempty = mkEffectFn10 \_ _ _ _ _ _ _ _ _ _ -> mempty