{-# language CPP #-}
{-# language FlexibleInstances #-}
{-# language Safe #-}
#if MIN_VERSION_base(4,12,0)
{-# language TypeOperators #-}
#endif
-- |
-- Module       : Data.Group
-- Copyright    : (c) 2020 Reed Mullanix, Emily Pillmore
-- License      : BSD-style
--
-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,
--                Emily Pillmore <emilypi@cohomolo.gy>
--
-- Stability    : stable
-- Portability  : non-portable
--
-- This module provides definitions 'GroupFoldable',
-- along with useful combinators.
--
module Data.Group.Foldable
( -- * Group foldable
  GroupFoldable(..)
  -- ** Group foldable combinators
, gold
, goldr
, toFreeGroup
) where


import Data.Functor.Compose
import Data.Functor.Const
import Data.Functor.Identity
import Data.Group
import Data.Group.Free
import Data.Group.Free.Church
import Data.Group.Permutation
import Data.Monoid

#if MIN_VERSION_base(4,12,0)
import GHC.Generics
#endif


-- $setup
--
-- >>> import qualified Prelude
-- >>> import Data.Group
-- >>> import Data.Monoid
-- >>> import Data.Semigroup
-- >>> import Data.Word
-- >>> :set -XTypeApplications
-- >>> :set -XFlexibleContexts

-- -------------------------------------------------------------------- --
-- Group foldable

-- | The class of data structures that can be groupoidally folded.
--
-- 'GroupFoldable' has difficult-to-define laws in terms of Haskell,
-- but is well-understood categorically: 'GroupFoldable's are
-- functors (not necessarily 'Functor's) in the slice category \( [\mathcal{Hask}, \mathcal{Hask}] / F \),
-- where \( F \) is the free group functor in \( \mathcal{Hask} \). Hence, they are
-- defined by the natural transformations \( [\mathcal{Hask},\mathcal{Hask}](-, F) \) - i.e. 'toFG', or 'toFreeGroup'.
--
class GroupFoldable t where
  -- | Apply a 'Group' fold to some container.
  --
  -- This function takes a container that can be represented as a
  -- 'FreeGroup', and simplifies the container as a word in the
  -- free group, producing a final output according to some
  -- mapping of elements into the target group.
  --
  -- The name is a pun on 'Group' and 'Data.Foldable.fold'.
  --
  -- === __Examples__:
  --
  -- >>> let x = FreeGroup $ [Left (1 :: Sum Word8), Left 2, Right 2, Right 3]
  -- >>> goldMap id x
  -- Sum {getSum = 2}
  --
  -- >>> goldMap (\a -> if a < 2 then mempty else a) x
  -- Sum {getSum = 3}
  --
  goldMap :: Group g => (a -> g) -> t a -> g
  goldMap a -> g
f t a
t = FG a -> (a -> g) -> g
forall a. FG a -> forall g. Group g => (a -> g) -> g
runFG (t a -> FG a
forall (t :: * -> *) a. GroupFoldable t => t a -> FG a
toFG t a
t) a -> g
f
  {-# inline goldMap #-}

  -- | Translate a 'GroupFoldable' container into a Church-encoded
  -- free group.
  --
  -- Analagous to 'Data.Foldable.toList' for 'Foldable', if 'Data.Foldable.toList' respected the
  -- associativity of ⊥.
  --
  toFG :: t a -> FG a
  toFG t a
t = (forall g. Group g => (a -> g) -> g) -> FG a
forall a. (forall g. Group g => (a -> g) -> g) -> FG a
FG ((forall g. Group g => (a -> g) -> g) -> FG a)
-> (forall g. Group g => (a -> g) -> g) -> FG a
forall a b. (a -> b) -> a -> b
$ \a -> g
k -> (a -> g) -> t a -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap a -> g
k t a
t
  {-# inline toFG #-}
  {-# minimal goldMap | toFG #-}

instance GroupFoldable FG where
  toFG :: FG a -> FG a
toFG = FG a -> FG a
forall a. a -> a
id

instance GroupFoldable FreeGroup where
  toFG :: FreeGroup a -> FG a
toFG = FreeGroup a -> FG a
forall a. FreeGroup a -> FG a
reflectFG

instance GroupFoldable Sum where
  goldMap :: (a -> g) -> Sum a -> g
goldMap a -> g
f = a -> g
f (a -> g) -> (Sum a -> a) -> Sum a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum a -> a
forall a. Sum a -> a
getSum

instance GroupFoldable Product where
  goldMap :: (a -> g) -> Product a -> g
goldMap a -> g
f = a -> g
f (a -> g) -> (Product a -> a) -> Product a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product a -> a
forall a. Product a -> a
getProduct

instance GroupFoldable Dual where
  goldMap :: (a -> g) -> Dual a -> g
goldMap a -> g
f = a -> g
f (a -> g) -> (Dual a -> a) -> Dual a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual a -> a
forall a. Dual a -> a
getDual

instance GroupFoldable (Const a) where
  goldMap :: (a -> g) -> Const a a -> g
goldMap a -> g
_ Const a a
_ = g
forall a. Monoid a => a
mempty

instance GroupFoldable Identity where
  goldMap :: (a -> g) -> Identity a -> g
goldMap a -> g
f = a -> g
f (a -> g) -> (Identity a -> a) -> Identity a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity

instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (Compose f g) where
  goldMap :: (a -> g) -> Compose f g a -> g
goldMap a -> g
f = (g a -> g) -> f (g a) -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap ((a -> g) -> g a -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap a -> g
f) (f (g a) -> g) -> (Compose f g a -> f (g a)) -> Compose f g a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

#if MIN_VERSION_base(4,12,0)
instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :*: g) where
  goldMap :: (a -> g) -> (:*:) f g a -> g
goldMap a -> g
f (f a
a :*: g a
b) = (a -> g) -> f a -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap a -> g
f f a
a g -> g -> g
forall a. Semigroup a => a -> a -> a
<> (a -> g) -> g a -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap a -> g
f g a
b

instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :+: g) where
  toFG :: (:+:) f g a -> FG a
toFG (L1 f a
l) = f a -> FG a
forall (t :: * -> *) a. GroupFoldable t => t a -> FG a
toFG f a
l
  toFG (R1 g a
r) = g a -> FG a
forall (t :: * -> *) a. GroupFoldable t => t a -> FG a
toFG g a
r

instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :.: g) where
  goldMap :: (a -> g) -> (:.:) f g a -> g
goldMap a -> g
f = (g a -> g) -> f (g a) -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap ((a -> g) -> g a -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap a -> g
f) (f (g a) -> g) -> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) f g a -> f (g a)
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1
#endif

instance GroupFoldable Abelianizer where
  goldMap :: (a -> g) -> Abelianizer a -> g
goldMap a -> g
_ Abelianizer a
Quot = g
forall a. Monoid a => a
mempty
  goldMap a -> g
f (Commuted a
a) = a -> g
f a
a

-- -------------------------------------------------------------------- --
-- Group foldable combinators

-- | Simplify a word in 'GroupFoldable' container as a word
-- in a 'FreeGroup'.
--
-- The name is a pun on 'Group' and 'Data.Foldable.fold'.
--
-- === __Examples__:
--
-- >>> let x = FreeGroup $ [Left (1 :: Sum Word8), Left 2, Right 2, Right 3]
-- >>> gold x
-- Sum {getSum = 2}
--
gold :: (GroupFoldable t, Group g) => t g -> g
gold :: t g -> g
gold = (g -> g) -> t g -> g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap g -> g
forall a. a -> a
id
{-# inline gold #-}

-- | Convert a 'GroupFoldable' container into a 'FreeGroup'
--
toFreeGroup :: (GroupFoldable t, Group g) => t g -> FreeGroup g
toFreeGroup :: t g -> FreeGroup g
toFreeGroup = FG g -> FreeGroup g
forall a. FG a -> FreeGroup a
reifyFG (FG g -> FreeGroup g) -> (t g -> FG g) -> t g -> FreeGroup g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t g -> FG g
forall (t :: * -> *) a. GroupFoldable t => t a -> FG a
toFG
{-# inline toFreeGroup #-}

-- | A right group fold from a 'GroupFoldable' container to its permutation group
--
-- Analogous to 'Data.Foldable.foldr' for monoidal 'Foldable's.
--
goldr
  :: GroupFoldable t
  => Group g
  => (a -> Permutation g)
  -> t a
  -> Permutation g
goldr :: (a -> Permutation g) -> t a -> Permutation g
goldr = (a -> Permutation g) -> t a -> Permutation g
forall (t :: * -> *) g a.
(GroupFoldable t, Group g) =>
(a -> g) -> t a -> g
goldMap
{-# inline goldr #-}