forked from purescript/purescript-prelude
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Port generics-rep to prelude (purescript#235)
* 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
Showing
16 changed files
with
643 additions
and
13 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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' |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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' |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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; | ||
}; | ||
}; |
Oops, something went wrong.