+

{-# LANGUAGE DataKinds #-}

+

{-# LANGUAGE DerivingVia #-}

+

{-# LANGUAGE EmptyCase #-}

+

{-# LANGUAGE FlexibleInstances #-}

+

{-# LANGUAGE LambdaCase #-}

+

{-# LANGUAGE NoImplicitPrelude #-}

+

{-# LANGUAGE RankNTypes #-}

+

{-# LANGUAGE ScopedTypeVariables #-}

+

{-# LANGUAGE StandaloneDeriving #-}

+

{-# LANGUAGE TypeApplications #-}

+

{-# LANGUAGE TypeOperators #-}

+

{-# LANGUAGE UndecidableInstances #-}

+

{-# OPTIONS -Wno-unticked-promoted-constructors #-}

+

module Data.Measure.Class

+

, DataMeasureClassOverflowException (..)

+

import Control.Exception (Exception, throw)

+

import Data.Word (Word8, Word16, Word32, Word64)

+

import GHC.Natural (Natural)

+

import qualified Prelude

+

-- | Core combinators for a possibly-multidimensional measurement

+

-- @[email protected] is a fixed set of measurements of a /single/ object. It is not the

+

-- measurements from multiple objects.

+

-- - @('zero', 'plus')@ is a commutative monoid

+

-- - @('zero', 'max')@ is a bounded join-semilattice

+

-- - @('min', 'max')@ is a lattice

+

-- - /lattice-ordered monoid/ @'min' ('plus' a b) ('plus' a c) = a + 'min' b [email protected]

+

-- Note that the bounded join-semilattice precludes negative (components of)

+

class Prelude.Eq a => Measure a where

+

-- | The measurement of nothing

+

-- See 'Measure' for laws.

+

-- | Combine two measurements

+

-- See 'Measure' for laws.

+

-- | The lesser of two measurements

+

-- See 'Measure' for laws.

+

-- | The greater of two measurements

+

-- See 'Measure' for laws.

+

-- | A unique maximal measurement

+

-- - @('maxBound', 'min')@ is a bounded meet-semilattice

+

class Measure a => BoundedMeasure a where

+

-- | A unique maximal measurement

+

-- See 'BoundedMeasure' for laws.

+

--------------------------------------------------------------------------------

+

--------------------------------------------------------------------------------

+

-- we conservatively don't instantiate for types that represent negative

+

instance Measure Natural where

+

deriving via InstantiatedAt Generic (a, b)

+

instance (Measure a, Measure b) => Measure (a, b)

+

deriving via InstantiatedAt Generic (a, b, c)

+

instance (Measure a, Measure b, Measure c) => Measure (a, b, c)

+

deriving via InstantiatedAt Generic (a, b, c, d)

+

instance (Measure a, Measure b, Measure c, Measure d)

+

=> Measure (a, b, c, d)

+

deriving via InstantiatedAt Generic (a, b, c, d, e)

+

instance (Measure a, Measure b, Measure c, Measure d, Measure e)

+

=> Measure (a, b, c, d, e)

+

deriving via InstantiatedAt Generic (a, b, c, d, e, f)

+

instance (Measure a, Measure b, Measure c, Measure d, Measure e, Measure f)

+

=> Measure (a, b, c, d, e, f)

+

deriving via InstantiatedAt Generic (a, b, c, d, e, f, g)

+

instance ( Measure a, Measure b, Measure c, Measure d, Measure e, Measure f

+

=> Measure (a, b, c, d, e, f, g)

+

-- larger tuples unfortunatley do not have Generic instances

+

-- | 'plus' throws 'DataMeasureClassOverflowException'

+

instance Measure Word8 where

+

instance BoundedMeasure Word8 where

+

maxBound = Prelude.maxBound

+

-- | 'plus' throws 'DataMeasureClassOverflowException'

+

instance Measure Word16 where

+

instance BoundedMeasure Word16 where

+

maxBound = Prelude.maxBound

+

-- | 'plus' throws 'DataMeasureClassOverflowException'

+

instance Measure Word32 where

+

instance BoundedMeasure Word32 where

+

maxBound = Prelude.maxBound

+

-- | 'plus' throws 'DataMeasureClassOverflowException'

+

instance Measure Word64 where

+

instance BoundedMeasure Word64 where

+

maxBound = Prelude.maxBound

+

-- Throws 'DataMeasureClassOverflowException'

+

(Prelude.Bounded a, Prelude.Integral a)

+

if x Prelude.> Prelude.maxBound Prelude.- y

+

then throw DataMeasureClassOverflowException

+

-- | An exception thrown by 'plus' on overflow, since overflow violates

+

-- /lattice-ordered monoid/

+

data DataMeasureClassOverflowException = DataMeasureClassOverflowException

+

deriving (Prelude.Show)

+

instance Exception DataMeasureClassOverflowException

+

--------------------------------------------------------------------------------

+

-- DerivingVia instances via these classes

+

--------------------------------------------------------------------------------

+

-- | The @('zero', 'plus')@ monoid

+

instance Measure a => Prelude.Monoid (InstantiatedAt Measure a) where

+

mempty = coerce $ zero @a

+

-- | The @('zero', 'plus')@ monoid

+

instance Measure a => Prelude.Semigroup (InstantiatedAt Measure a) where

+

(<>) = coerce $ plus @a

+

--------------------------------------------------------------------------------

+

-- DerivingVia instances of these classes

+

--------------------------------------------------------------------------------

+

instance (Prelude.Monoid a, Prelude.Ord a)