Port generics-rep to prelude

src/Data/Bounded/Generic.purs

@@ -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'

src/Data/Eq/Generic.purs

@@ -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)

src/Data/Generic/Rep.purs

@@ -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

src/Data/HeytingAlgebra/Generic.purs

@@ -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)

src/Data/Monoid/Generic.purs

@@ -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'

src/Data/Ord/Generic.purs

@@ -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)

src/Data/Ring/Generic.purs

@@ -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

src/Data/Semigroup/Generic.purs

@@ -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))

src/Data/Semiring/Generic.purs

@@ -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

src/Data/Show/Generic.js

@@ -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;
+  };
+};