Graded semigroups/monoids/groups - two versions

graded1.hs

{-# language FlexibleInstances #-}
{-# language DefaultSignatures #-}
{-# language RankNTypes #-}
{-# language MultiParamTypeClasses #-}
{-# language QuantifiedConstraints #-}
module Data.Group.Graded where

import Data.Functor.WithIndex
import Data.Group
import Data.Map (Map)
import qualified Data.Map as M

class GradedSemigroup i f where
  iappend :: Semigroup g => i -> g -> f g -> f g
  default iappend :: (Eq i, FunctorWithIndex i f, Semigroup g) => i -> g -> f g -> f g
  iappend i h = imap go where
    go j g
      | i == j = g <> h
      | otherwise = g
  {-# inline iappend #-}

class GradedSemigroup i f => GradedMonoid i f where
  imempty :: Monoid g => i -> f g -> f g
  default imempty :: (Monoid g, Eq i) => i -> f g -> f g
  imempty _ fg = fg
  {-# inline imempty #-}

class GradedMonoid i f => GradedGroup i f where
  iinvert :: Group g => i -> f g -> f g
  default iinvert :: (Eq i, FunctorWithIndex i f, Group g) => i -> f g -> f g
  iinvert i = imap go where
    go j g
      | i == j = invert g
      | otherwise = g
  {-# inline iinvert #-}

instance Ord k => GradedSemigroup k (Map k) where
  iappend = M.insertWith (<>)
  {-# inline iappend #-}
  
instance Ord k => GradedMonoid k (Map k)

instance Ord k => GradedGroup k (Map k) where
  iinvert = M.adjust invert
  {-# inline iinvert #-}

instance GradedSemigroup Int []
instance GradedMonoid Int []
instance GradedGroup Int []