Skip to content

Commit

Permalink
Port generics-rep to prelude (purescript#235)
Browse files Browse the repository at this point in the history
* first commit

* Fix instances for record fields

* Break modules up

* Deriving Show (#5)

* Initial work on deriving Show

* Add test for Show

* Remove import

* Travis etc.

* Data.Generic.Rep.Bounded (#6)

* Data.Generic.Rep.Bounded

Generic implementations of Prelude.Bounded class's top and bottom.

* GenericBounded - don't support product types

* GenericBounded - only support NoArguments

* Update for PureScript 0.11

* Add Generic instance for Maybe (purescript#9)

* Add missing Bounded instances for Argument

* Add GenericEnum and GenericBoundedEnum

* Add enum tests, convert existing "tests" into assertions

* Product instances in Bounded and Enum

* Added GenericShowFields instances for NoConstructors and NoArguments (purescript#20)

* Added Eq and Show instances to NoArguments and NoConstructors

* Added GenericShowFields

* Removed Show, Eq

* Cleanup

* Removed NoConstructors Show instance

* Remove Rec and Field & update package & bower symbols

* Bump deps for compiler/0.12

* Remove symbols and fix operator fixity issue

* Update dependencies, license

* Added HeytingAlgebra, Semiring, Ring

* Fix type annotation precedence in tests

* Replace monomorphic proxies by Type.Proxy.Proxy (purescript#44)

* Remove Generic Maybe instance

* Remove Generic Enum from src and test

* Move all files to their correct folders and rename files to Generic.purs

* Update module names to match their file names

* Move test file for Data.Generic.Rep into proper folder and rename

* Update generic-rep test file module to match file path

* Rename generic-rep test name to testGenericRep

* Replace generic Show's  Foldable.intercalate usage with FFI

* Replace Tuple with Pair in Data.Generic.Rep tests

* Remove Maybe import from Data.Generic.Rep test file

* Remove Maybe import from Data.Generic.Rep

* Extract AlmostEff and assert to Test.Utils.purs file

* Update Data.Generic.Rep tests to use AlmostEff; include it in main tests

* Import implies in Data.Generic.Rep tests

Co-authored-by: Phil Freeman <paf31@cantab.net>
Co-authored-by: Matthew Leon <ml@matthewleon.com>
Co-authored-by: Gary Burgess <gary.burgess@gmail.com>
Co-authored-by: Liam Goodacre <goodacre.liam@gmail.com>
Co-authored-by: Jorge Acereda <jacereda@gmail.com>
Co-authored-by: Kristoffer Josefsson <kejace@gmail.com>
Co-authored-by: Denis Stoyanov <stoyanov.gr@gmail.com>
Co-authored-by: Harry Garrood <harry@garrood.me>
Co-authored-by: Cyril <sobierajewicz.cyril@gmail.com>
  • Loading branch information
10 people authored and turlando committed Sep 3, 2021
1 parent 9dd0267 commit f18bbac
Show file tree
Hide file tree
Showing 16 changed files with 643 additions and 13 deletions.
56 changes: 56 additions & 0 deletions src/Data/Bounded/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
module Data.Bounded.Generic
( class GenericBottom
, genericBottom'
, genericBottom
, class GenericTop
, genericTop'
, genericTop
) where

import Data.Generic.Rep

import Data.Bounded (class Bounded, bottom, top)

class GenericBottom a where
genericBottom' :: a

instance genericBottomNoArguments :: GenericBottom NoArguments where
genericBottom' = NoArguments

instance genericBottomArgument :: Bounded a => GenericBottom (Argument a) where
genericBottom' = Argument bottom

instance genericBottomSum :: GenericBottom a => GenericBottom (Sum a b) where
genericBottom' = Inl genericBottom'

instance genericBottomProduct :: (GenericBottom a, GenericBottom b) => GenericBottom (Product a b) where
genericBottom' = Product genericBottom' genericBottom'

instance genericBottomConstructor :: GenericBottom a => GenericBottom (Constructor name a) where
genericBottom' = Constructor genericBottom'

class GenericTop a where
genericTop' :: a

instance genericTopNoArguments :: GenericTop NoArguments where
genericTop' = NoArguments

instance genericTopArgument :: Bounded a => GenericTop (Argument a) where
genericTop' = Argument top

instance genericTopSum :: GenericTop b => GenericTop (Sum a b) where
genericTop' = Inr genericTop'

instance genericTopProduct :: (GenericTop a, GenericTop b) => GenericTop (Product a b) where
genericTop' = Product genericTop' genericTop'

instance genericTopConstructor :: GenericTop a => GenericTop (Constructor name a) where
genericTop' = Constructor genericTop'

-- | A `Generic` implementation of the `bottom` member from the `Bounded` type class.
genericBottom :: forall a rep. Generic a rep => GenericBottom rep => a
genericBottom = to genericBottom'

-- | A `Generic` implementation of the `top` member from the `Bounded` type class.
genericTop :: forall a rep. Generic a rep => GenericTop rep => a
genericTop = to genericTop'
35 changes: 35 additions & 0 deletions src/Data/Eq/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
module Data.Eq.Generic
( class GenericEq
, genericEq'
, genericEq
) where

import Prelude (class Eq, (==), (&&))
import Data.Generic.Rep

class GenericEq a where
genericEq' :: a -> a -> Boolean

instance genericEqNoConstructors :: GenericEq NoConstructors where
genericEq' _ _ = true

instance genericEqNoArguments :: GenericEq NoArguments where
genericEq' _ _ = true

instance genericEqSum :: (GenericEq a, GenericEq b) => GenericEq (Sum a b) where
genericEq' (Inl a1) (Inl a2) = genericEq' a1 a2
genericEq' (Inr b1) (Inr b2) = genericEq' b1 b2
genericEq' _ _ = false

instance genericEqProduct :: (GenericEq a, GenericEq b) => GenericEq (Product a b) where
genericEq' (Product a1 b1) (Product a2 b2) = genericEq' a1 a2 && genericEq' b1 b2

instance genericEqConstructor :: GenericEq a => GenericEq (Constructor name a) where
genericEq' (Constructor a1) (Constructor a2) = genericEq' a1 a2

instance genericEqArgument :: Eq a => GenericEq (Argument a) where
genericEq' (Argument a1) (Argument a2) = a1 == a2

-- | A `Generic` implementation of the `eq` member from the `Eq` type class.
genericEq :: forall a rep. Generic a rep => GenericEq rep => a -> a -> Boolean
genericEq x y = genericEq' (from x) (from y)
36 changes: 36 additions & 0 deletions src/Data/Generic/Rep.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
module Data.Generic.Rep
( class Generic
, to
, from
, NoConstructors
, NoArguments(..)
, Sum(..)
, Product(..)
, Constructor(..)
, Argument(..)
) where

-- | A representation for types with no constructors.
data NoConstructors

-- | A representation for constructors with no arguments.
data NoArguments = NoArguments

-- | A representation for types with multiple constructors.
data Sum a b = Inl a | Inr b

-- | A representation for constructors with multiple fields.
data Product a b = Product a b

-- | A representation for constructors which includes the data constructor name
-- | as a type-level string.
newtype Constructor (name :: Symbol) a = Constructor a

-- | A representation for an argument in a data constructor.
newtype Argument a = Argument a

-- | The `Generic` class asserts the existence of a type function from types
-- | to their representations using the type constructors defined in this module.
class Generic a rep | a -> rep where
to :: rep -> a
from :: a -> rep
70 changes: 70 additions & 0 deletions src/Data/HeytingAlgebra/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,70 @@
module Data.HeytingAlgebra.Generic where

import Prelude

import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
import Data.HeytingAlgebra (ff, implies, tt)

class GenericHeytingAlgebra a where
genericFF' :: a
genericTT' :: a
genericImplies' :: a -> a -> a
genericConj' :: a -> a -> a
genericDisj' :: a -> a -> a
genericNot' :: a -> a

instance genericHeytingAlgebraNoArguments :: GenericHeytingAlgebra NoArguments where
genericFF' = NoArguments
genericTT' = NoArguments
genericImplies' _ _ = NoArguments
genericConj' _ _ = NoArguments
genericDisj' _ _ = NoArguments
genericNot' _ = NoArguments

instance genericHeytingAlgebraArgument :: HeytingAlgebra a => GenericHeytingAlgebra (Argument a) where
genericFF' = Argument ff
genericTT' = Argument tt
genericImplies' (Argument x) (Argument y) = Argument (implies x y)
genericConj' (Argument x) (Argument y) = Argument (conj x y)
genericDisj' (Argument x) (Argument y) = Argument (disj x y)
genericNot' (Argument x) = Argument (not x)

instance genericHeytingAlgebraProduct :: (GenericHeytingAlgebra a, GenericHeytingAlgebra b) => GenericHeytingAlgebra (Product a b) where
genericFF' = Product genericFF' genericFF'
genericTT' = Product genericTT' genericTT'
genericImplies' (Product a1 b1) (Product a2 b2) = Product (genericImplies' a1 a2) (genericImplies' b1 b2)
genericConj' (Product a1 b1) (Product a2 b2) = Product (genericConj' a1 a2) (genericConj' b1 b2)
genericDisj' (Product a1 b1) (Product a2 b2) = Product (genericDisj' a1 a2) (genericDisj' b1 b2)
genericNot' (Product a b) = Product (genericNot' a) (genericNot' b)

instance genericHeytingAlgebraConstructor :: GenericHeytingAlgebra a => GenericHeytingAlgebra (Constructor name a) where
genericFF' = Constructor genericFF'
genericTT' = Constructor genericTT'
genericImplies' (Constructor a1) (Constructor a2) = Constructor (genericImplies' a1 a2)
genericConj' (Constructor a1) (Constructor a2) = Constructor (genericConj' a1 a2)
genericDisj' (Constructor a1) (Constructor a2) = Constructor (genericDisj' a1 a2)
genericNot' (Constructor a) = Constructor (genericNot' a)

-- | A `Generic` implementation of the `ff` member from the `HeytingAlgebra` type class.
genericFF :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a
genericFF = to genericFF'

-- | A `Generic` implementation of the `tt` member from the `HeytingAlgebra` type class.
genericTT :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a
genericTT = to genericTT'

-- | A `Generic` implementation of the `implies` member from the `HeytingAlgebra` type class.
genericImplies :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a
genericImplies x y = to $ from x `genericImplies'` from y

-- | A `Generic` implementation of the `conj` member from the `HeytingAlgebra` type class.
genericConj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a
genericConj x y = to $ from x `genericConj'` from y

-- | A `Generic` implementation of the `disj` member from the `HeytingAlgebra` type class.
genericDisj :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a -> a
genericDisj x y = to $ from x `genericDisj'` from y

-- | A `Generic` implementation of the `not` member from the `HeytingAlgebra` type class.
genericNot :: forall a rep. Generic a rep => GenericHeytingAlgebra rep => a -> a
genericNot x = to $ genericNot' (from x)
27 changes: 27 additions & 0 deletions src/Data/Monoid/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
module Data.Monoid.Generic
( class GenericMonoid
, genericMempty'
, genericMempty
) where

import Data.Monoid (class Monoid, mempty)
import Data.Generic.Rep

class GenericMonoid a where
genericMempty' :: a

instance genericMonoidNoArguments :: GenericMonoid NoArguments where
genericMempty' = NoArguments

instance genericMonoidProduct :: (GenericMonoid a, GenericMonoid b) => GenericMonoid (Product a b) where
genericMempty' = Product genericMempty' genericMempty'

instance genericMonoidConstructor :: GenericMonoid a => GenericMonoid (Constructor name a) where
genericMempty' = Constructor genericMempty'

instance genericMonoidArgument :: Monoid a => GenericMonoid (Argument a) where
genericMempty' = Argument mempty

-- | A `Generic` implementation of the `mempty` member from the `Monoid` type class.
genericMempty :: forall a rep. Generic a rep => GenericMonoid rep => a
genericMempty = to genericMempty'
39 changes: 39 additions & 0 deletions src/Data/Ord/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,39 @@
module Data.Ord.Generic
( class GenericOrd
, genericCompare'
, genericCompare
) where

import Prelude (class Ord, compare, Ordering(..))
import Data.Generic.Rep

class GenericOrd a where
genericCompare' :: a -> a -> Ordering

instance genericOrdNoConstructors :: GenericOrd NoConstructors where
genericCompare' _ _ = EQ

instance genericOrdNoArguments :: GenericOrd NoArguments where
genericCompare' _ _ = EQ

instance genericOrdSum :: (GenericOrd a, GenericOrd b) => GenericOrd (Sum a b) where
genericCompare' (Inl a1) (Inl a2) = genericCompare' a1 a2
genericCompare' (Inr b1) (Inr b2) = genericCompare' b1 b2
genericCompare' (Inl b1) (Inr b2) = LT
genericCompare' (Inr b1) (Inl b2) = GT

instance genericOrdProduct :: (GenericOrd a, GenericOrd b) => GenericOrd (Product a b) where
genericCompare' (Product a1 b1) (Product a2 b2) =
case genericCompare' a1 a2 of
EQ -> genericCompare' b1 b2
other -> other

instance genericOrdConstructor :: GenericOrd a => GenericOrd (Constructor name a) where
genericCompare' (Constructor a1) (Constructor a2) = genericCompare' a1 a2

instance genericOrdArgument :: Ord a => GenericOrd (Argument a) where
genericCompare' (Argument a1) (Argument a2) = compare a1 a2

-- | A `Generic` implementation of the `compare` member from the `Ord` type class.
genericCompare :: forall a rep. Generic a rep => GenericOrd rep => a -> a -> Ordering
genericCompare x y = genericCompare' (from x) (from y)
24 changes: 24 additions & 0 deletions src/Data/Ring/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@
module Data.Ring.Generic where

import Prelude

import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)

class GenericRing a where
genericSub' :: a -> a -> a

instance genericRingNoArguments :: GenericRing NoArguments where
genericSub' _ _ = NoArguments

instance genericRingArgument :: Ring a => GenericRing (Argument a) where
genericSub' (Argument x) (Argument y) = Argument (sub x y)

instance genericRingProduct :: (GenericRing a, GenericRing b) => GenericRing (Product a b) where
genericSub' (Product a1 b1) (Product a2 b2) = Product (genericSub' a1 a2) (genericSub' b1 b2)

instance genericRingConstructor :: GenericRing a => GenericRing (Constructor name a) where
genericSub' (Constructor a1) (Constructor a2) = Constructor (genericSub' a1 a2)

-- | A `Generic` implementation of the `sub` member from the `Ring` type class.
genericSub :: forall a rep. Generic a rep => GenericRing rep => a -> a -> a
genericSub x y = to $ from x `genericSub'` from y
31 changes: 31 additions & 0 deletions src/Data/Semigroup/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
module Data.Semigroup.Generic
( class GenericSemigroup
, genericAppend'
, genericAppend
) where

import Prelude (class Semigroup, append)
import Data.Generic.Rep

class GenericSemigroup a where
genericAppend' :: a -> a -> a

instance genericSemigroupNoConstructors :: GenericSemigroup NoConstructors where
genericAppend' a _ = a

instance genericSemigroupNoArguments :: GenericSemigroup NoArguments where
genericAppend' a _ = a

instance genericSemigroupProduct :: (GenericSemigroup a, GenericSemigroup b) => GenericSemigroup (Product a b) where
genericAppend' (Product a1 b1) (Product a2 b2) =
Product (genericAppend' a1 a2) (genericAppend' b1 b2)

instance genericSemigroupConstructor :: GenericSemigroup a => GenericSemigroup (Constructor name a) where
genericAppend' (Constructor a1) (Constructor a2) = Constructor (genericAppend' a1 a2)

instance genericSemigroupArgument :: Semigroup a => GenericSemigroup (Argument a) where
genericAppend' (Argument a1) (Argument a2) = Argument (append a1 a2)

-- | A `Generic` implementation of the `append` member from the `Semigroup` type class.
genericAppend :: forall a rep. Generic a rep => GenericSemigroup rep => a -> a -> a
genericAppend x y = to (genericAppend' (from x) (from y))
51 changes: 51 additions & 0 deletions src/Data/Semiring/Generic.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
module Data.Semiring.Generic where

import Prelude

import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)

class GenericSemiring a where
genericAdd' :: a -> a -> a
genericZero' :: a
genericMul' :: a -> a -> a
genericOne' :: a

instance genericSemiringNoArguments :: GenericSemiring NoArguments where
genericAdd' _ _ = NoArguments
genericZero' = NoArguments
genericMul' _ _ = NoArguments
genericOne' = NoArguments

instance genericSemiringArgument :: Semiring a => GenericSemiring (Argument a) where
genericAdd' (Argument x) (Argument y) = Argument (add x y)
genericZero' = Argument zero
genericMul' (Argument x) (Argument y) = Argument (mul x y)
genericOne' = Argument one

instance genericSemiringProduct :: (GenericSemiring a, GenericSemiring b) => GenericSemiring (Product a b) where
genericAdd' (Product a1 b1) (Product a2 b2) = Product (genericAdd' a1 a2) (genericAdd' b1 b2)
genericZero' = Product genericZero' genericZero'
genericMul' (Product a1 b1) (Product a2 b2) = Product (genericMul' a1 a2) (genericMul' b1 b2)
genericOne' = Product genericOne' genericOne'

instance genericSemiringConstructor :: GenericSemiring a => GenericSemiring (Constructor name a) where
genericAdd' (Constructor a1) (Constructor a2) = Constructor (genericAdd' a1 a2)
genericZero' = Constructor genericZero'
genericMul' (Constructor a1) (Constructor a2) = Constructor (genericMul' a1 a2)
genericOne' = Constructor genericOne'

-- | A `Generic` implementation of the `zero` member from the `Semiring` type class.
genericZero :: forall a rep. Generic a rep => GenericSemiring rep => a
genericZero = to genericZero'

-- | A `Generic` implementation of the `one` member from the `Semiring` type class.
genericOne :: forall a rep. Generic a rep => GenericSemiring rep => a
genericOne = to genericOne'

-- | A `Generic` implementation of the `add` member from the `Semiring` type class.
genericAdd :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a
genericAdd x y = to $ from x `genericAdd'` from y

-- | A `Generic` implementation of the `mul` member from the `Semiring` type class.
genericMul :: forall a rep. Generic a rep => GenericSemiring rep => a -> a -> a
genericMul x y = to $ from x `genericMul'` from y
14 changes: 14 additions & 0 deletions src/Data/Show/Generic.js
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
"use strict";

exports.intercalate = function (separator) {
return function (xs) {
var len = xs.length;
if (len === 0) return "";

var res = xs[0];
for (var i = 1; i < len; i++) {
res = res + separator + xs[i];
}
return res;
};
};
Loading

0 comments on commit f18bbac

Please sign in to comment.