groups-generic (empty) → 0.1.0.0

raw patch · 3 files changed

+213/−0 lines, 3 filesdep +basedep +generic-datadep +groups

Dependencies added: base, generic-data, groups

Files

changelog.md +5/−0
groups-generic.cabal +55/−0
src/Data/Group/Generics.hs +153/−0

+ changelog.md view

@@ -0,0 +1,5 @@+# Changelog for package `generic-groups`
+
+## 0.1.0.0 ( February 14, 2020 )
+
+* Initial release

+ groups-generic.cabal view

@@ -0,0 +1,55 @@+cabal-version:  2.4
+name:           groups-generic
+version:        0.1.0.0
+synopsis:       Generically derive Group instances.
+category:       Algebra, Math
+license:        BSD-3-Clause
+build-type:     Simple
+author:         Sam Derbyshire
+maintainer:     Sam Derbyshire
+homepage:       https://github.com/sheaf/groups-generic
+bug-reports:    https://github.com/sheaf/groups-generic/issues
+extra-source-files:
+  changelog.md
+description:
+  Generically derive group instances:
+  .
+  > data MyRecord
+  >   = MyRecord
+  >   { field1 :: Sum Double
+  >   , field2 :: Product Double
+  >   , field3 :: ( Sum Int, Sum Int )
+  >   }
+  >   deriving Generic
+  >   deriving ( Semigroup, Monoid, Group )
+  >     via GenericProduct MyRecord
+
+source-repository head
+  type: git
+  location: git://github.com/sheaf/generic-groups.git
+
+library
+
+  build-depends: 
+      base
+        >= 4.12 && < 4.15
+    , generic-data
+        ^>= 0.8.0.0
+    , groups
+        ^>= 0.4.0.0
+
+  hs-source-dirs:
+      src
+
+  exposed-modules:
+      Data.Group.Generics
+
+  ghc-options:
+      -Wall
+      -Wcompat
+      -fwarn-missing-local-signatures
+      -fwarn-incomplete-uni-patterns
+      -fwarn-missing-deriving-strategies
+
+  default-language:
+      Haskell2010

+ src/Data/Group/Generics.hs view

@@ -0,0 +1,153 @@+{-# LANGUAGE
+    FlexibleContexts
+  , MonoLocalBinds
+  , ScopedTypeVariables
+  , TypeApplications
+  , UndecidableInstances
+#-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-|
+Module: Data.Group.Generics
+
+Orphan instances allowing generic deriving of 'Group' instances:
+
+> > data MyRecord
+> >   = MyRecord
+> >   { field1 :: Sum Double
+> >   , field2 :: Product Double
+> >   , field3 :: ( Sum Int, Sum Int )
+> >   }
+> >   deriving Generic
+> >   deriving ( Semigroup, Monoid, Group )
+> >     via GenericProduct MyRecord
+
+Also includes some instances for newtypes from @base@ such as 'Identity' and 'Const'.
+-}
+
+
+module Data.Group.Generics
+  ( )
+  where
+
+-- base
+import Data.Functor.Const
+  ( Const(..) )
+import Data.Functor.Identity
+  ( Identity(..) )
+import Data.Ord
+  ( Down(..) )
+import Data.Proxy
+  ( Proxy(..) )
+import GHC.Generics
+  ( Generic(..)
+  , U1(..), Rec1(..), M1(..), K1(..), Par1(..)
+  , (:*:)(..), (:.:)(..)
+  )
+
+-- generic-data
+import Generic.Data
+  ( Generically(..), GenericProduct(..) )
+
+-- groups
+import Data.Group
+  ( Group(..), Abelian )
+
+-----------------------------------------------------------------------
+-- Instances for 'Group'.
+
+instance Group (U1 p) where
+  invert _ = U1
+  pow  _ _ = U1
+instance Group (f p) => Group (Rec1 f p) where
+  invert (Rec1 g) = Rec1 (invert g)
+  pow (Rec1 g) n = Rec1 (pow g n)
+instance Group (f p) => Group (M1 i c f p) where
+  invert (M1 g) = M1 (invert g)
+  pow (M1 g) n = M1 (pow g n)
+instance Group g => Group (K1 i g p) where
+  invert (K1 g) = K1 (invert g)
+  pow (K1 g) n = K1 (pow g n)
+instance Group g => Group (Par1 g) where
+  invert (Par1 g) = Par1 (invert g)
+  pow (Par1 g) n = Par1 (pow g n)
+instance (Group (f1 p), Group (f2 p) ) => Group ((:*:) f1 f2 p) where
+  invert ( g1 :*: g2 ) = ( invert g1 :*: invert g2 )
+  pow ( g1 :*: g2 ) n = ( pow g1 n :*: pow g2 n )
+instance Group (f (g p)) => Group ((:.:) f g p) where
+  invert (Comp1 g) = Comp1 (invert g)
+  pow (Comp1 g) n = Comp1 (pow g n)
+
+ginvert :: forall g. ( Generic g, Group ( Rep g () ) ) => g -> g
+ginvert = to . invert @( Rep g () ) . from
+
+gpow :: forall n g. ( Integral n, Generic g, Group ( Rep g () ) ) => g -> n -> g
+gpow x n = to ( pow @( Rep g () ) ( from x ) n )
+
+instance
+  ( Generic g
+  , Monoid ( GenericProduct g )
+  , Group  ( Rep g () )
+  )
+  => Group ( GenericProduct g ) where
+  invert  = ginvert
+  pow x n = gpow x n
+
+instance
+  ( Generic g
+  , Semigroup g
+  , Monoid ( Generically g )
+  , Group  ( Rep g () )
+  )
+  => Group ( Generically g ) where
+  invert  = ginvert
+  pow x n = gpow x n
+
+-- Other useful instances.
+instance Group a => Group (Down a) where
+  invert (Down a) = Down (invert a)
+  pow (Down a) n = Down (pow a n)
+instance Group a => Group (Identity a) where
+  invert (Identity a) = Identity (invert a)
+  pow (Identity a) n = Identity (pow a n)
+instance Group a => Group (Const a b) where
+  invert (Const a) = Const (invert a)
+  pow (Const a) n = Const (pow a n)
+instance Group (Proxy s) where
+  invert _ = Proxy
+  pow  _ _ = Proxy
+
+
+-----------------------------------------------------------------------
+-- Instances for 'Abelian'.
+
+instance Abelian (U1 p)
+instance Abelian (f p) => Abelian (Rec1 f p)
+instance Abelian (f p) => Abelian (M1 i c f p)
+instance Abelian g => Abelian (K1 i g p)
+instance Abelian g => Abelian (Par1 g)
+instance (Abelian (f1 p), Abelian (f2 p)) => Abelian ((:*:) f1 f2 p)
+instance Abelian (f (g p)) => Abelian ((:.:) f g p)
+
+instance
+  ( Generic g
+  , Monoid  ( GenericProduct g )
+  , Abelian ( Rep g () )
+  )
+  => Abelian ( GenericProduct g )
+
+instance
+  ( Generic g
+  , Semigroup g
+  , Monoid  ( Generically g )
+  , Abelian ( Rep g () )
+  )
+  => Abelian ( Generically g )
+
+
+-- Other useful instances.
+instance Abelian a => Abelian (Down a)
+instance Abelian a => Abelian (Identity a) where
+instance Abelian a => Abelian (Const a b) where
+instance Abelian (Proxy s) where