diff --git a/.travis.yml b/.travis.yml index 7399e47..b44040b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,7 +5,8 @@ node_js: stable env: - PATH=$HOME/purescript:$PATH install: - - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) + # - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) + - TAG=v0.14.0-rc2 - curl --location --output $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - chmod a+x $HOME/purescript diff --git a/bower.json b/bower.json index a6ed0e8..3180c1f 100644 --- a/bower.json +++ b/bower.json @@ -17,6 +17,7 @@ "package.json" ], "dependencies": { - "purescript-prelude": "^4.0.0" + "purescript-prelude": "master", + "purescript-safe-coerce": "master" } } diff --git a/package.json b/package.json index d34ea78..b8d0c47 100644 --- a/package.json +++ b/package.json @@ -6,7 +6,7 @@ }, "devDependencies": { "pulp": "^15.0.0", - "purescript-psa": "^0.6.0", + "purescript-psa": "^0.8.0", "rimraf": "^2.6.2" } } diff --git a/src/Data/Newtype.purs b/src/Data/Newtype.purs index 5f7c15d..b1d6db5 100644 --- a/src/Data/Newtype.purs +++ b/src/Data/Newtype.purs @@ -2,7 +2,6 @@ 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 +10,8 @@ import Data.Monoid.Endo (Endo(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Semigroup.First (First(..)) import Data.Semigroup.Last (Last(..)) +import Prim.Coerce (class Coercible) +import Safe.Coerce (coerce) -- | A type class for `newtype`s to enable convenient wrapping and unwrapping, -- | and the use of the other functions in this module. @@ -33,6 +34,7 @@ import Data.Semigroup.Last (Last(..)) -- | unwrap <<< wrap = id -- | wrap <<< unwrap = id -- | ``` +class Newtype :: Type -> Type -> Constraint class Newtype t a | t -> a where wrap :: a -> t unwrap :: t -> a @@ -74,10 +76,6 @@ instance newtypeLast :: Newtype (Last a) a where un :: forall t a. Newtype t a => (a -> t) -> t -> a un _ = unwrap --- | Deprecated previous name of `un`. -op :: forall t a. Newtype t a => (a -> t) -> t -> a -op = un - -- | This combinator is for when you have a higher order function that you want -- | to use in the context of some newtype - `foldMap` being a common example: -- | @@ -90,12 +88,13 @@ op = un 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: @@ -111,14 +110,16 @@ ala _ f = map unwrap (f wrap) alaF :: forall f g t a s b . Functor f + => Coercible (f t) (f a) => Functor g + => 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 @@ -144,13 +145,15 @@ alaF _ f = map unwrap <<< f <<< map wrap -- | ``` over :: forall t a s b - . Newtype t a + . Coercible a t + => Coercible b s + => Newtype t a => Newtype s b => (a -> t) -> (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`: @@ -165,14 +168,16 @@ over _ f = wrap <<< f <<< unwrap overF :: forall f g t a s b . Functor f + => Coercible (f a) (f t) => Functor g + => 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. @@ -197,13 +202,15 @@ overF _ f = map wrap <<< f <<< map unwrap -- | a `Number` in and get a `Number` out via `under`. under :: forall t a s b - . Newtype t a + . Coercible t a + => Coercible s b + => Newtype t a => Newtype s b => (a -> t) -> (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`: @@ -224,14 +231,16 @@ under _ f = unwrap <<< f <<< wrap underF :: forall f g t a s b . Functor f + => Coercible (f t) (f a) => Functor g + => 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. -- | @@ -249,21 +258,25 @@ underF _ f = map unwrap <<< f <<< map wrap -- | here too. over2 :: forall t a s b - . Newtype t a + . Coercible a t + => Coercible b s + => Newtype t a => Newtype s b => (a -> t) -> (a -> a -> b) -> 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 + => Coercible (f a) (f t) => Functor g + => Coercible (g b) (g s) => Newtype t a => Newtype s b => (a -> t) @@ -271,27 +284,31 @@ overF2 -> 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. under2 :: forall t a s b - . Newtype t a + . Coercible t a + => Coercible s b + => Newtype t a => Newtype s b => (a -> t) -> (t -> t -> s) -> 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 + => Coercible (f t) (f a) => Functor g + => Coercible (g s) (g b) => Newtype t a => Newtype s b => (a -> t) @@ -299,28 +316,33 @@ underF2 -> 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) + => Coercible t a + => Coercible a 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 a t + => Coercible (f a) (f t) => Newtype t a => (a -> t) -> (f a -> a) -> f t -> t -collect _ f = wrap <<< f <<< map unwrap +collect _ = coerce