Replace explicit wrapping and unwrapping of newtypes by coercions

bower.json

@@ -17,6 +17,7 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-prelude": "master"
+    "purescript-prelude": "master",
+    "purescript-safe-coerce": "master"
   }
 }

src/Data/Newtype.purs

@@ -1,8 +1,5 @@
 module Data.Newtype where
 
-import Prelude
-
-import Data.Function (on)
 import Data.Monoid.Additive (Additive(..))
 import Data.Monoid.Conj (Conj(..))
 import Data.Monoid.Disj (Disj(..))
@@ -11,6 +8,7 @@ import Data.Monoid.Endo (Endo(..))
 import Data.Monoid.Multiplicative (Multiplicative(..))
 import Data.Semigroup.First (First(..))
 import Data.Semigroup.Last (Last(..))
+import Safe.Coerce (class Coercible, coerce)
 
 -- | A type class for `newtype`s to enable convenient wrapping and unwrapping,
 -- | and the use of the other functions in this module.
@@ -27,48 +25,31 @@ import Data.Semigroup.Last (Last(..))
 -- | defined as `newtype` rather than `data` declaration (even if the `data`
 -- | structurally fits the rules of a `newtype`), and the use of a wildcard for
 -- | the wrapped type.
--- |
--- | Instances must obey the following laws:
--- | ``` purescript
--- | unwrap <<< wrap = id
--- | wrap <<< unwrap = id
 -- | ```
 class Newtype :: Type -> Type -> Constraint
-class Newtype t a | t -> a where
-  wrap :: a -> t
-  unwrap :: t -> a
+class Coercible t a <= Newtype t a | t -> a
+
+wrap :: forall t a. Newtype t a => a -> t
+wrap = coerce
+
+unwrap :: forall t a. Newtype t a => t -> a
+unwrap = coerce
 
-instance newtypeAdditive :: Newtype (Additive a) a where
-  wrap = Additive
-  unwrap (Additive a) = a
+instance newtypeAdditive :: Newtype (Additive a) a
 
-instance newtypeMultiplicative :: Newtype (Multiplicative a) a where
-  wrap = Multiplicative
-  unwrap (Multiplicative a) = a
+instance newtypeMultiplicative :: Newtype (Multiplicative a) a
 
-instance newtypeConj :: Newtype (Conj a) a where
-  wrap = Conj
-  unwrap (Conj a) = a
+instance newtypeConj :: Newtype (Conj a) a
 
-instance newtypeDisj :: Newtype (Disj a) a where
-  wrap = Disj
-  unwrap (Disj a) = a
+instance newtypeDisj :: Newtype (Disj a) a
 
-instance newtypeDual :: Newtype (Dual a) a where
-  wrap = Dual
-  unwrap (Dual a) = a
+instance newtypeDual :: Newtype (Dual a) a
 
-instance newtypeEndo :: Newtype (Endo c a) (c a a) where
-  wrap = Endo
-  unwrap (Endo a) = a
+instance newtypeEndo :: Newtype (Endo c a) (c a a)
 
-instance newtypeFirst :: Newtype (First a) a where
-  wrap = First
-  unwrap (First a) = a
+instance newtypeFirst :: Newtype (First a) a
 
-instance newtypeLast :: Newtype (Last a) a where
-  wrap = Last
-  unwrap (Last a) = a
+instance newtypeLast :: Newtype (Last a) a
 
 -- | Given a constructor for a `Newtype`, this returns the appropriate `unwrap`
 -- | function.
@@ -86,13 +67,13 @@ un _ = unwrap
 -- | ```
 ala
   :: forall f t a s b
-   . Functor f
+   . Coercible (f t) (f a)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> ((b -> s) -> f t)
   -> f a
-ala _ f = map unwrap (f wrap)
+ala _ f = coerce (f wrap)
 
 -- | Similar to `ala` but useful for cases where you want to use an additional
 -- | projection with the higher order function:
@@ -107,15 +88,15 @@ ala _ f = map unwrap (f wrap)
 -- | `Functor`.
 alaF
   :: forall f g t a s b
-   . Functor f
-  => Functor g
+   . Coercible (f t) (f a)
+  => Coercible (g s) (g b)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> (f t -> g s)
   -> f a
   -> g b
-alaF _ f = map unwrap <<< f <<< map wrap
+alaF _ = coerce
 
 -- | Lifts a function operate over newtypes. This can be used to lift a
 -- | function to manipulate the contents of a single newtype, somewhat like
@@ -147,7 +128,7 @@ over
   -> (a -> b)
   -> t
   -> s
-over _ f = wrap <<< f <<< unwrap
+over _ = coerce
 
 -- | Much like `over`, but where the lifted function operates on values in a
 -- | `Functor`:
@@ -161,15 +142,15 @@ over _ f = wrap <<< f <<< unwrap
 -- | here too, the input is an `Array` but the result is a `Maybe`.
 overF
   :: forall f g t a s b
-   . Functor f
-  => Functor g
+   . Coercible (f a) (f t)
+  => Coercible (g b) (g s)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> (f a -> g b)
   -> f t
   -> g s
-overF _ f = map wrap <<< f <<< map unwrap
+overF _ = coerce
 
 -- | The opposite of `over`: lowers a function that operates on `Newtype`d
 -- | values to operate on the wrapped value instead.
@@ -200,7 +181,7 @@ under
   -> (t -> s)
   -> a
   -> b
-under _ f = unwrap <<< f <<< wrap
+under _ = coerce
 
 -- | Much like `under`, but where the lifted function operates on values in a
 -- | `Functor`:
@@ -220,15 +201,15 @@ under _ f = unwrap <<< f <<< wrap
 -- | here too, the input is an `Array` but the result is a `Maybe`.
 underF
   :: forall f g t a s b
-   . Functor f
-  => Functor g
+   . Coercible (f t) (f a)
+  => Coercible (g s) (g b)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> (f t -> g s)
   -> f a
   -> g b
-underF _ f = map unwrap <<< f <<< map wrap
+underF _ = coerce
 
 -- | Lifts a binary function to operate over newtypes.
 -- |
@@ -253,22 +234,22 @@ over2
   -> t
   -> t
   -> s
-over2 _ f = compose wrap <<< f `on` unwrap
+over2 _ = coerce
 
 -- | Much like `over2`, but where the lifted binary function operates on
 -- | values in a `Functor`.
 overF2
   :: forall f g t a s b
-   . Functor f
-  => Functor g
+   . Coercible (f a) (f t)
+  => Coercible (g b) (g s)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> (f a -> f a -> g b)
   -> f t
   -> f t
   -> g s
-overF2 _ f = compose (map wrap) <<< f `on` map unwrap
+overF2 _ = coerce
 
 -- | The opposite of `over2`: lowers a binary function that operates on `Newtype`d
 -- | values to operate on the wrapped value instead.
@@ -281,43 +262,43 @@ under2
   -> a
   -> a
   -> b
-under2 _ f = compose unwrap <<< f `on` wrap
+under2 _ = coerce
 
 -- | Much like `under2`, but where the lifted binary function operates on
 -- | values in a `Functor`.
 underF2
   :: forall f g t a s b
-   . Functor f
-  => Functor g
+   . Coercible (f t) (f a)
+  => Coercible (g s) (g b)
   => Newtype t a
   => Newtype s b
   => (a -> t)
   -> (f t -> f t -> g s)
   -> f a
   -> f a
   -> g b
-underF2 _ f = compose (map unwrap) <<< f `on` map wrap
+underF2 _ = coerce
 
 -- | Similar to the function from the `Traversable` class, but operating within
 -- | a newtype instead.
 traverse
   :: forall f t a
-   . Functor f
+   . Coercible (f a) (f t)
   => Newtype t a
   => (a -> t)
   -> (a -> f a)
   -> t
   -> f t
-traverse _ f = map wrap <<< f <<< unwrap
+traverse _ = coerce
 
 -- | Similar to the function from the `Distributive` class, but operating within
 -- | a newtype instead.
 collect
   :: forall f t a
-   . Functor f
+   . Coercible (f a) (f t)
   => Newtype t a
   => (a -> t)
   -> (f a -> a)
   -> f t
   -> t
-collect _ f = wrap <<< f <<< map unwrap
+collect _ = coerce