packages feed

eventlog-live-0.4.0.0: src/GHC/Eventlog/Live/Data/Group.hs

{- |
Module      : GHC.Eventlog.Live.Data.Group
Description : Core machines for processing data in batches.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Data.Group (
  -- * GroupBy
  GroupBy (..),
  Group (..),
  GroupedBy,
  singleton,
  elems,
  groups,
) where

import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as M
import Data.Hashable (Hashable (..))
import Data.Kind (Type)
import Data.Semigroup (First (..), Last (..), Max (..), Min (..), Product (..), Sum (..))

{- |
This class defines the key to group by when aggregating.
-}
class (Hashable (Key a)) => GroupBy a where
  type Key a :: Type
  toKey :: a -> Key a

deriving newtype instance (GroupBy a) => GroupBy (First a)
deriving newtype instance (GroupBy a) => GroupBy (Last a)
deriving newtype instance (GroupBy a) => GroupBy (Max a)
deriving newtype instance (GroupBy a) => GroupBy (Min a)
deriving newtype instance (GroupBy a) => GroupBy (Product a)
deriving newtype instance (GroupBy a) => GroupBy (Sum a)

{- |
This type defines a set of groups, grouped by the key given by `GroupBy`.
-}
data GroupedBy a = (GroupBy a) => GroupedBy
  { groups :: HashMap (Key a) (Group a)
  }

{- |
Internal helper.
This type defines a group representative and the group size.
-}
data Group a = Group
  { representative :: !a
  , size :: !Word
  }
  deriving (Show, Functor, Foldable, Traversable)

{- |
Construct the singleton `GroupedBy`.
-}
singleton :: (GroupBy a) => a -> GroupedBy a
singleton a = GroupedBy{groups = M.singleton (toKey a) Group{representative = a, size = 1}}

{- |
Get all group representatives from a `GroupedBy`.
-}
elems :: GroupedBy a -> [a]
elems = fmap (.representative) . groups

{- |
Get all group representatives and sizes from a `GroupedBy`.
-}
groups :: GroupedBy a -> [Group a]
groups = M.elems . (.groups)

instance (Semigroup a) => Semigroup (Group a) where
  (<>) :: Group a -> Group a -> Group a
  x <> y =
    Group
      { representative = x.representative <> y.representative
      , size = x.size + y.size
      }

instance (Semigroup a, GroupBy a) => Semigroup (GroupedBy a) where
  (<>) :: GroupedBy a -> GroupedBy a -> GroupedBy a
  x <> y = GroupedBy{groups = M.unionWith (<>) x.groups y.groups}