Merge pull request #4 from purescript/rows

Add effect row equality

Author: garyb

src/Type/Row/Effect/Equality.purs

@@ -0,0 +1,35 @@
+module Type.Row.Effect.Equality
+  ( class EffectRowEquals
+  , to
+  , from
+  , effTo
+  , effFrom
+  ) where
+
+-- | This type class asserts that effect rows `a` and `b` are equal.
+-- |
+-- | The functional dependencies and the single instance below will force the
+-- | two type arguments to unify when either one is known.
+-- |
+-- | Note: any instance will necessarily ovelap with `refl` below, so instances
+-- | of this class should not be defined in libraries.
+class EffectRowEquals (a :: # Effect) (b :: # Effect) | a -> b, b -> a where
+  to :: forall r. r a -> r b
+  from :: forall r. r b -> r a
+
+instance refl :: EffectRowEquals a a where
+  to a = a
+  from a = a
+
+newtype Flipmode e a eff = Flipmode (e eff a)
+
+unflip :: forall e a eff. Flipmode e a eff -> e eff a
+unflip (Flipmode e) = e
+
+-- | A version of `to` that can be applied to types like `Eff`, `Aff`, etc.
+effTo :: forall e a b x. EffectRowEquals a b => e a x -> e b x
+effTo e = unflip (to (Flipmode e))
+
+-- | A version of `from` that can be applied to types like `Eff`, `Aff`, etc.
+effFrom :: forall e a b x. EffectRowEquals a b => e b x -> e a x
+effFrom e = unflip (from (Flipmode e))

test/Main.purs

@@ -5,6 +5,7 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
 import Data.Newtype (class Newtype, unwrap)
 import Type.Equality (class TypeEquals, to, from)
+import Type.Row.Effect.Equality as REE
 
 newtype RecordNewtype = RecordNewtype
   { message :: String }
@@ -15,5 +16,11 @@ instance newtypeRecordNewtype ::
   wrap = RecordNewtype <<< to
   unwrap (RecordNewtype rec) = from rec
 
+class Foo f where
+  foo :: String -> f Unit
+
+instance fooEff :: REE.EffectRowEquals eff (console :: CONSOLE | e) => Foo (Eff eff) where
+  foo = REE.effFrom <<< log
+
 main :: Eff (console :: CONSOLE) Unit
-main = log (unwrap (RecordNewtype { message: "Done" })).message
+main = foo (unwrap (RecordNewtype { message: "Done" })).message