Add a newtype implementing generic instances for use with deriving via

Author: kl0tl

src/Data/Generic/Rep.purs

@@ -1,48 +1,6 @@
 module Data.Generic.Rep
-  ( class Generic
-  , to
-  , from
-  , NoConstructors
-  , NoArguments(..)
-  , Sum(..)
-  , Product(..)
-  , Constructor(..)
-  , Argument(..)
+  ( module X
   ) where
 
-import Data.Maybe (Maybe(..))
-
--- | 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
-
-instance genericMaybe
-  :: Generic (Maybe a) (Sum (Constructor "Nothing" NoArguments)
-                            (Constructor "Just" (Argument a))) where
-  to (Inl _) = Nothing
-  to (Inr (Constructor (Argument a))) = Just a
-
-  from Nothing = Inl (Constructor NoArguments)
-  from (Just a) = Inr (Constructor (Argument a))
-
+import Data.Generic.Rep.Class (class Generic, Argument(..), Constructor(..), NoArguments(..), NoConstructors, Product(..), Sum(..), from, to) as X
+import Data.Generic.Rep.Derive (UsingGeneric(..)) as X

src/Data/Generic/Rep/Bounded.purs

@@ -7,7 +7,7 @@ module Data.Generic.Rep.Bounded
   , genericTop
   ) where
 
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 
 import Data.Bounded (class Bounded, bottom, top)
 

src/Data/Generic/Rep/Class.purs

@@ -0,0 +1,47 @@
+module Data.Generic.Rep.Class
+  ( class Generic
+  , to
+  , from
+  , NoConstructors
+  , NoArguments(..)
+  , Sum(..)
+  , Product(..)
+  , Constructor(..)
+  , Argument(..)
+  ) where
+
+import Data.Maybe (Maybe(..))
+
+-- | 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
+
+instance genericMaybe
+  :: Generic (Maybe a) (Sum (Constructor "Nothing" NoArguments)
+                            (Constructor "Just" (Argument a))) where
+  to (Inl _) = Nothing
+  to (Inr (Constructor (Argument a))) = Just a
+
+  from Nothing = Inl (Constructor NoArguments)
+  from (Just a) = Inr (Constructor (Argument a))

src/Data/Generic/Rep/Derive.purs

@@ -0,0 +1,113 @@
+module Data.Generic.Rep.Derive where
+
+import Prelude
+
+import Data.Enum (class BoundedEnum, class Enum, Cardinality(..))
+import Data.Function (on)
+import Data.Generic.Rep.Bounded (class GenericBottom, class GenericTop, genericBottom, genericTop)
+import Data.Generic.Rep.Class (class Generic)
+import Data.Generic.Rep.Enum (class GenericBoundedEnum, class GenericEnum, genericCardinality, genericFromEnum, genericPred, genericSucc, genericToEnum)
+import Data.Generic.Rep.Eq (class GenericEq, genericEq)
+import Data.Generic.Rep.HeytingAlgebra (class GenericHeytingAlgebra, genericConj, genericDisj, genericFF, genericImplies, genericNot, genericTT)
+import Data.Generic.Rep.Monoid (class GenericMonoid, genericMempty)
+import Data.Generic.Rep.Ord (class GenericOrd, genericCompare)
+import Data.Generic.Rep.Ring (class GenericRing, genericSub)
+import Data.Generic.Rep.Semigroup (class GenericSemigroup, genericAppend)
+import Data.Generic.Rep.Semiring (class GenericSemiring, genericAdd, genericMul, genericOne, genericZero)
+import Data.Generic.Rep.Show (class GenericShow, genericShow)
+import Data.Newtype (class Newtype, over, over2, traverse, unwrap)
+
+newtype UsingGeneric a = UsingGeneric a
+
+derive instance newtypeUsingGeneric :: Newtype (UsingGeneric a) _
+
+instance boundedUsingGeneric ::
+  ( Generic a rep
+  , GenericBottom rep
+  , GenericEq rep
+  , GenericOrd rep
+  , GenericTop rep
+  ) => Bounded (UsingGeneric a) where
+  top = UsingGeneric genericTop
+  bottom = UsingGeneric genericBottom
+
+instance boundedEnumUsingGeneric ::
+  ( Generic a rep
+  , GenericBottom rep
+  , GenericBoundedEnum rep
+  , GenericEnum rep
+  , GenericEq rep
+  , GenericOrd rep
+  , GenericTop rep
+  ) => BoundedEnum (UsingGeneric a) where
+  cardinality = Cardinality $ unwrap (genericCardinality :: Cardinality a)
+  toEnum = genericToEnum >>> map UsingGeneric
+  fromEnum = unwrap >>> genericFromEnum
+
+instance enumUsingGeneric ::
+  ( Generic a rep
+  , GenericEnum rep
+  , GenericEq rep
+  , GenericOrd rep
+  ) => Enum (UsingGeneric a) where
+  succ = traverse UsingGeneric genericSucc
+  pred = traverse UsingGeneric genericPred
+
+instance eqUsingGeneric ::
+  ( Generic a rep
+  , GenericEq rep
+  ) => Eq (UsingGeneric a) where
+  eq = genericEq `on` unwrap
+
+instance heytingAlgebraUsingGeneric ::
+  ( Generic a rep
+  , GenericHeytingAlgebra rep
+  ) => HeytingAlgebra (UsingGeneric a) where
+  ff = UsingGeneric genericFF
+  tt = UsingGeneric genericTT
+  implies = over2 UsingGeneric genericImplies
+  conj = over2 UsingGeneric genericConj
+  disj = over2 UsingGeneric genericDisj
+  not = over UsingGeneric genericNot
+
+instance monoidUsingGeneric ::
+  ( Generic a rep
+  , GenericMonoid rep
+  , GenericSemigroup rep
+  ) => Monoid (UsingGeneric a) where
+  mempty = UsingGeneric genericMempty
+
+instance ordUsingGeneric ::
+  ( Generic a rep
+  , GenericEq rep
+  , GenericOrd rep
+  ) => Ord (UsingGeneric a) where
+  compare = genericCompare `on` unwrap
+
+instance ringUsingGeneric ::
+  ( Generic a rep
+  , GenericRing rep
+  , GenericSemiring rep
+  ) => Ring (UsingGeneric a) where
+  sub = over2 UsingGeneric genericSub
+
+instance semigroupUsingGeneric ::
+  ( Generic a rep
+  , GenericSemigroup rep
+  ) => Semigroup (UsingGeneric a) where
+  append = over2 UsingGeneric genericAppend
+
+instance semiringUsingGeneric ::
+  ( Generic a rep
+  , GenericSemiring rep
+  ) => Semiring (UsingGeneric a) where
+  add = over2 UsingGeneric genericAdd
+  zero = UsingGeneric genericZero
+  mul = over2 UsingGeneric genericMul
+  one = UsingGeneric genericOne
+
+instance showUsingGeneric ::
+  ( Generic a rep
+  , GenericShow rep
+  ) => Show (UsingGeneric a) where
+  show = unwrap >>> genericShow

src/Data/Generic/Rep/Enum.purs

@@ -3,7 +3,7 @@ module Data.Generic.Rep.Enum where
 import Prelude
 
 import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum)
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to)
+import Data.Generic.Rep.Class (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to)
 import Data.Generic.Rep.Bounded (class GenericBottom, class GenericTop, genericBottom', genericTop')
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)

src/Data/Generic/Rep/Eq.purs

@@ -5,7 +5,7 @@ module Data.Generic.Rep.Eq
   ) where
 
 import Prelude (class Eq, (==), (&&))
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 
 class GenericEq a where
   genericEq' :: a -> a -> Boolean

src/Data/Generic/Rep/HeytingAlgebra.purs

@@ -2,7 +2,7 @@ module Data.Generic.Rep.HeytingAlgebra where
 
 import Prelude
 
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
+import Data.Generic.Rep.Class (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
 import Data.HeytingAlgebra (ff, implies, tt)
 
 class GenericHeytingAlgebra a where
@@ -67,4 +67,4 @@ 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)
+genericNot x = to $ genericNot' (from x)

src/Data/Generic/Rep/Monoid.purs

@@ -5,7 +5,7 @@ module Data.Generic.Rep.Monoid
   ) where
 
 import Data.Monoid (class Monoid, mempty)
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 
 class GenericMonoid a where
   genericMempty' :: a

src/Data/Generic/Rep/Ord.purs

@@ -5,7 +5,7 @@ module Data.Generic.Rep.Ord
   ) where
 
 import Prelude (class Ord, compare, Ordering(..))
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 
 class GenericOrd a where
   genericCompare' :: a -> a -> Ordering

src/Data/Generic/Rep/Ring.purs

@@ -2,7 +2,7 @@ module Data.Generic.Rep.Ring where
 
 import Prelude
 
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
+import Data.Generic.Rep.Class (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
 
 class GenericRing a where
   genericSub' :: a -> a -> a
@@ -21,4 +21,4 @@ instance genericRingConstructor :: GenericRing a => GenericRing (Constructor nam
 
 -- | 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
+genericSub x y = to $ from x `genericSub'` from y

src/Data/Generic/Rep/Semigroup.purs

@@ -5,7 +5,7 @@ module Data.Generic.Rep.Semigroup
   ) where
 
 import Prelude (class Semigroup, append)
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 
 class GenericSemigroup a where
   genericAppend' :: a -> a -> a

src/Data/Generic/Rep/Semiring.purs

@@ -2,7 +2,7 @@ module Data.Generic.Rep.Semiring where
 
 import Prelude
 
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
+import Data.Generic.Rep.Class (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)
 
 class GenericSemiring a where
   genericAdd'  :: a -> a -> a
@@ -48,4 +48,4 @@ 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
+genericMul x y = to $ from x `genericMul'` from y

src/Data/Generic/Rep/Show.purs

@@ -8,7 +8,7 @@ module Data.Generic.Rep.Show
 
 import Prelude (class Show, show, (<>))
 import Data.Foldable (intercalate)
-import Data.Generic.Rep
+import Data.Generic.Rep.Class
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 
 class GenericShow a where