module Data.Semiring
(
Semiring(..)
,StarSemiring(..)
,mulFoldable
,addFoldable
,
HasPositiveInfinity(..)
,HasNegativeInfinity(..)
,DetectableZero(..)
,
Add(..)
,Mul(..)
,
Max(..)
,Min(..)
,
Matrix(..)
,transpose
,mulMatrix)
where
import Data.Functor.Identity (Identity(..))
import Data.Complex (Complex)
import Data.Fixed (Fixed, HasResolution)
import Data.Ratio (Ratio)
import Numeric.Natural (Natural)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign.C.Types
(CChar, CClock, CDouble, CFloat, CInt, CIntMax, CIntPtr, CLLong,
CLong, CPtrdiff, CSChar, CSUSeconds, CShort, CSigAtomic, CSize,
CTime, CUChar, CUInt, CUIntMax, CUIntPtr, CULLong, CULong,
CUSeconds, CUShort, CWchar)
import Foreign.Ptr (IntPtr, WordPtr)
import System.Posix.Types
(CCc, CDev, CGid, CIno, CMode, CNlink, COff, CPid, CRLim, CSpeed,
CSsize, CTcflag, CUid, Fd)
import Data.Scientific(Scientific)
import Data.Time.Clock(DiffTime,NominalDiffTime)
import Data.Semigroup hiding (Max(..), Min(..))
import Data.Coerce
import GHC.Generics (Generic, Generic1)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Data.Semiring.TH
import Data.Functor.Classes
import Text.Read
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import Data.Hashable
import qualified Data.Vector as Vector
import qualified Data.Vector.Storable as StorableVector
import qualified Data.Vector.Unboxed as UnboxedVector
import Numeric.Log hiding (sum)
import qualified Numeric.Log
import Control.Monad
import Control.Applicative
import Data.Foldable
import Data.Traversable
class Semiring a where
zero
:: a
one
:: a
infixl 7 <.>
(<.>) :: a -> a -> a
infixl 6 <+>
(<+>) :: a -> a -> a
add
:: [a] -> a
add = getAdd . foldMap Add
mul
:: [a] -> a
mul = getMul . foldMap Mul
mulFoldable :: (Foldable f, Semiring a) => f a -> a
mulFoldable = mul . toList
addFoldable :: (Foldable f, Semiring a) => f a -> a
addFoldable = add . toList
class Semiring a =>
StarSemiring a where
star :: a -> a
plus :: a -> a
star x = one <+> plus x
plus x = x <.> star x
class Semiring a =>
DetectableZero a where
isZero
:: a -> Bool
isZeroEq
:: (Semiring a, Eq a)
=> a -> Bool
isZeroEq = (zero ==)
class HasPositiveInfinity a where
positiveInfinity
:: a
isPositiveInfinity
:: a -> Bool
defaultPositiveInfinity
:: RealFloat a
=> a
defaultPositiveInfinity = 1 / 0
defaultIsPositiveInfinity
:: RealFloat a
=> a -> Bool
defaultIsPositiveInfinity x = isInfinite x && x > 0
class HasNegativeInfinity a where
negativeInfinity
:: a
isNegativeInfinity
:: a -> Bool
defaultIsNegativeInfinity
:: RealFloat a
=> a -> Bool
defaultIsNegativeInfinity x = isInfinite x && x < 0
defaultNegativeInfinity
:: RealFloat a
=> a
defaultNegativeInfinity = negate (1 / 0)
instance HasPositiveInfinity Double where
positiveInfinity = defaultPositiveInfinity
isPositiveInfinity = defaultIsPositiveInfinity
instance HasNegativeInfinity Double where
negativeInfinity = defaultNegativeInfinity
isNegativeInfinity = defaultIsNegativeInfinity
instance HasPositiveInfinity Float where
positiveInfinity = defaultPositiveInfinity
isPositiveInfinity = defaultIsPositiveInfinity
instance HasNegativeInfinity Float where
negativeInfinity = defaultNegativeInfinity
isNegativeInfinity = defaultIsNegativeInfinity
instance HasPositiveInfinity CDouble where
positiveInfinity = defaultPositiveInfinity
isPositiveInfinity = defaultIsPositiveInfinity
instance HasNegativeInfinity CDouble where
negativeInfinity = defaultNegativeInfinity
isNegativeInfinity = defaultIsNegativeInfinity
instance HasPositiveInfinity CFloat where
positiveInfinity = defaultPositiveInfinity
isPositiveInfinity = defaultIsPositiveInfinity
instance HasNegativeInfinity CFloat where
negativeInfinity = defaultNegativeInfinity
isNegativeInfinity = defaultIsNegativeInfinity
instance Semiring Bool where
one = True
zero = False
(<+>) = (||)
(<.>) = (&&)
instance StarSemiring Bool where
star _ = True
plus = id
instance DetectableZero Bool where
isZero = not
instance Semiring () where
one = ()
zero = ()
_ <+> _ = ()
_ <.> _ = ()
instance DetectableZero () where
isZero _ = True
instance StarSemiring () where
star _ = ()
plus _ = ()
instance Semiring a =>
Semiring [a] where
one = [one]
zero = []
[] <+> ys = ys
xs <+> [] = xs
(x:xs) <+> (y:ys) = (x <+> y) : (xs <+> ys)
[] <.> _ = []
_ <.> [] = []
(x:xs) <.> (y:ys) = (x <.> y) : add' xs ys
where
add' xs' [] = map (<.> y) xs'
add' [] ys' = map (x <.>) ys'
add' xs' ys' =
map (x <.>) ys' <+> map (<.> y) xs' <+> (zero : (xs' <.> ys'))
instance StarSemiring a => StarSemiring [a] where
star [] = one
star (x:xs) = r where
r = [star x] <.> (one : (xs <.> r))
instance DetectableZero a =>
DetectableZero [a] where
isZero = all isZero
type BinaryContainer c a = c a -> c a -> c a
instance Semiring a =>
Semiring (Vector.Vector a) where
one = Vector.singleton one
zero = Vector.empty
xs <+> ys =
case compare (Vector.length xs) (Vector.length ys) of
EQ -> Vector.zipWith (<+>) xs ys
LT -> Vector.unsafeAccumulate (<+>) ys (Vector.indexed xs)
GT -> Vector.unsafeAccumulate (<+>) xs (Vector.indexed ys)
signal <.> kernel
| Vector.null signal = Vector.empty
| Vector.null kernel = Vector.empty
| otherwise = Vector.generate (slen + klen 1) f
where
f n =
foldl'
(\a k ->
a <+>
Vector.unsafeIndex signal k <.>
Vector.unsafeIndex kernel (n k))
zero
[kmin .. kmax]
where
kmin = max 0 (n (klen 1))
kmax = min n (slen 1)
slen = Vector.length signal
klen = Vector.length kernel
instance DetectableZero a => DetectableZero (Vector.Vector a) where
isZero = Vector.all isZero
instance (UnboxedVector.Unbox a, Semiring a) =>
Semiring (UnboxedVector.Vector a) where
one = UnboxedVector.singleton one
zero = UnboxedVector.empty
xs <+> ys =
case compare (UnboxedVector.length xs) (UnboxedVector.length ys) of
EQ -> UnboxedVector.zipWith (<+>) xs ys
LT -> UnboxedVector.unsafeAccumulate (<+>) ys (UnboxedVector.indexed xs)
GT -> UnboxedVector.unsafeAccumulate (<+>) xs (UnboxedVector.indexed ys)
signal <.> kernel
| UnboxedVector.null signal = UnboxedVector.empty
| UnboxedVector.null kernel = UnboxedVector.empty
| otherwise = UnboxedVector.generate (slen + klen 1) f
where
f n =
foldl'
(\a k ->
a <+>
UnboxedVector.unsafeIndex signal k <.>
UnboxedVector.unsafeIndex kernel (n k))
zero
[kmin .. kmax]
where
kmin = max 0 (n (klen 1))
kmax = min n (slen 1)
slen = UnboxedVector.length signal
klen = UnboxedVector.length kernel
instance (UnboxedVector.Unbox a, DetectableZero a) => DetectableZero (UnboxedVector.Vector a) where
isZero = UnboxedVector.all isZero
instance (StorableVector.Storable a, Semiring a) =>
Semiring (StorableVector.Vector a) where
one = StorableVector.singleton one
zero = StorableVector.empty
xs <+> ys =
case compare lxs lys of
EQ -> StorableVector.zipWith (<+>) xs ys
LT -> StorableVector.unsafeAccumulate_ (<+>) ys (StorableVector.enumFromN 0 lxs) xs
GT -> StorableVector.unsafeAccumulate_ (<+>) xs (StorableVector.enumFromN 0 lys) ys
where
lxs = StorableVector.length xs
lys = StorableVector.length ys
signal <.> kernel
| StorableVector.null signal = StorableVector.empty
| StorableVector.null kernel = StorableVector.empty
| otherwise = StorableVector.generate (slen + klen 1) f
where
f n =
foldl'
(\a k ->
a <+>
StorableVector.unsafeIndex signal k <.>
StorableVector.unsafeIndex kernel (n k))
zero
[kmin .. kmax]
where
kmin = max 0 (n (klen 1))
kmax = min n (slen 1)
slen = StorableVector.length signal
klen = StorableVector.length kernel
instance (StorableVector.Storable a, DetectableZero a) => DetectableZero (StorableVector.Vector a) where
isZero = StorableVector.all isZero
instance (Monoid a, Ord a) =>
Semiring (Set a) where
(<+>) = Set.union
zero = Set.empty
one = Set.singleton mempty
xs <.> ys = foldMap (flip Set.map ys . mappend) xs
instance (Monoid a, Hashable a, Eq a) => Semiring (HashSet.HashSet a) where
(<+>) = HashSet.union
zero = HashSet.empty
one = HashSet.singleton mempty
xs <.> ys = foldMap (flip HashSet.map ys . mappend) xs
instance (Ord a, Monoid a, Semiring b) =>
Semiring (Map a b) where
one = Map.singleton mempty one
zero = Map.empty
(<+>) = Map.unionWith (<+>)
xs <.> ys =
Map.fromListWith
(<+>)
[ (mappend k l, v <.> u)
| (k,v) <- Map.toList xs
, (l,u) <- Map.toList ys ]
instance (Hashable a, Monoid a, Semiring b, Eq a) =>
Semiring (HashMap.HashMap a b) where
one = HashMap.singleton mempty one
zero = HashMap.empty
(<+>) = HashMap.unionWith (<+>)
xs <.> ys =
HashMap.fromListWith
(<+>)
[ (mappend k l, v <.> u)
| (k,v) <- HashMap.toList xs
, (l,u) <- HashMap.toList ys ]
instance (Monoid a, Ord a) =>
DetectableZero (Set a) where
isZero = Set.null
instance (Monoid a, Hashable a, Eq a) =>
DetectableZero (HashSet.HashSet a) where
isZero = HashSet.null
instance (Precise a, RealFloat a) => Semiring (Log a) where
(<.>) = (*)
(<+>) = (+)
one = Exp 0
zero = Exp ((1/0))
add = Numeric.Log.sum
instance (Precise a, RealFloat a) => DetectableZero (Log a) where
isZero = isZeroEq
showsNewtype
:: Coercible b a
=> String
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> b
-> ShowS
showsNewtype cons acc = s
where
s sp _ n x =
showParen (n > 10) $
showString cons .
showString " {" .
showString acc . showString " =" . sp 0 (coerce x) . showChar '}'
readsNewtype
:: Coercible a b
=> String -> String -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS b
readsNewtype cons acc = r where
r rp _ = readPrec_to_S $ prec 10 $ do
Ident c <- lexP
guard (c == cons)
Punc "{" <- lexP
Ident a <- lexP
guard (a == acc)
Punc "=" <- lexP
x <- prec 0 $ readS_to_Prec rp
Punc "}" <- lexP
pure (coerce x)
type WrapBinary f a = (a -> a -> a) -> f a -> f a -> f a
newtype Add a = Add
{ getAdd :: a
} deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable
,Semiring,DetectableZero,StarSemiring)
instance Eq1 Add where
liftEq = coerce
instance Ord1 Add where
liftCompare = coerce
instance Show1 Add where
liftShowsPrec = showsNewtype "Add" "getAdd"
instance Read1 Add where
liftReadsPrec = readsNewtype "Add" "getAdd"
newtype Mul a = Mul
{ getMul :: a
} deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable
,Semiring,DetectableZero,StarSemiring)
instance Eq1 Mul where
liftEq = coerce
instance Ord1 Mul where
liftCompare = coerce
instance Show1 Mul where
liftShowsPrec = showsNewtype "Mul" "getMul"
instance Read1 Mul where
liftReadsPrec = readsNewtype "Mul" "getMul"
instance Semiring a =>
Semigroup (Add a) where
(<>) = (coerce :: WrapBinary Add a) (<+>)
instance Semiring a =>
Semigroup (Mul a) where
(<>) = (coerce :: WrapBinary Mul a) (<.>)
instance Semiring a =>
Monoid (Add a) where
mempty = Add zero
mappend = (<>)
mconcat = (coerce :: ([a] -> a) -> [Add a] -> Add a) add
instance Semiring a =>
Monoid (Mul a) where
mempty = Mul one
mappend = (<>)
mconcat = (coerce :: ([a] -> a) -> [Mul a] -> Mul a) mul
newtype Matrix f g a = Matrix
{ getMatrix :: f (g a)
} deriving (Generic,Generic1,Typeable,Functor,Foldable,Traversable)
instance (Applicative f, Applicative g) =>
Applicative (Matrix f g) where
pure = Matrix #. pure . pure
(<*>) =
(coerce :: (f (g (a -> b)) -> f (g a) -> f (g b)) -> Matrix f g (a -> b) -> Matrix f g a -> Matrix f g b)
(liftA2 (<*>))
instance (Traversable f, Applicative f, Semiring a, f ~ g) =>
Semiring (Matrix f g a) where
(<.>) = mulMatrix
(<+>) = liftA2 (<+>)
zero = pure zero
one =
(coerce :: (f (g a) -> f (g a)) -> Matrix f g a -> Matrix f g a)
(imap (\i -> imap (\j z -> if i == j then o else z))) zero
where
imap f = snd . mapAccumL (\ !i x -> (i + 1, f i x)) (0 :: Int)
o :: a
o = one
instance (Traversable f, Applicative f, DetectableZero a, f ~ g) =>
DetectableZero (Matrix f g a) where
isZero = all isZero
transpose :: (Applicative g, Traversable f) => Matrix f g a -> Matrix g f a
transpose (Matrix xs) = Matrix (sequenceA xs)
mulMatrix
:: (Applicative f, Traversable g, Applicative g, Semiring a)
=> Matrix f g a -> Matrix g f a -> Matrix f f a
mulMatrix (Matrix xs) (Matrix ys) =
Matrix
(fmap (\row -> fmap (addFoldable . liftA2 (<.>) row) c) xs)
where
c = sequenceA ys
infixr 9 #.
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) _ = coerce
instance (Show1 f, Show1 g) =>
Show1 (Matrix f g) where
liftShowsPrec (sp :: Int -> a -> ShowS) sl =
showsNewtype "Matrix" "getMatrix" liftedTwiceSP liftedTwiceSL
where
liftedOnceSP :: Int -> g a -> ShowS
liftedOnceSP = liftShowsPrec sp sl
liftedOnceSL :: [g a] -> ShowS
liftedOnceSL = liftShowList sp sl
liftedTwiceSP :: Int -> f (g a) -> ShowS
liftedTwiceSP = liftShowsPrec liftedOnceSP liftedOnceSL
liftedTwiceSL :: [f (g a)] -> ShowS
liftedTwiceSL = liftShowList liftedOnceSP liftedOnceSL
instance (Read1 f, Read1 g) =>
Read1 (Matrix f g) where
liftReadsPrec (rp :: Int -> ReadS a) rl =
readsNewtype "Matrix" "getMatrix" liftedTwiceRP liftedTwiceRL
where
liftedOnceRP :: Int -> ReadS (g a)
liftedOnceRP = liftReadsPrec rp rl
liftedOnceRL :: ReadS [g a]
liftedOnceRL = liftReadList rp rl
liftedTwiceRP :: Int -> ReadS (f (g a))
liftedTwiceRP = liftReadsPrec liftedOnceRP liftedOnceRL
liftedTwiceRL :: ReadS [f (g a)]
liftedTwiceRL = liftReadList liftedOnceRP liftedOnceRL
instance (Eq1 f, Eq1 g) =>
Eq1 (Matrix f g) where
liftEq (eq :: a -> b -> Bool) =
coerce (liftEq (liftEq eq) :: f (g a) -> f (g b) -> Bool)
instance (Ord1 f, Ord1 g) => Ord1 (Matrix f g) where
liftCompare (cmp :: a -> b -> Ordering) =
coerce (liftCompare (liftCompare cmp) :: f (g a) -> f (g b) -> Ordering)
instance (Show1 f, Show1 g, Show a) => Show (Matrix f g a) where
showsPrec = showsPrec1
instance (Read1 f, Read1 g, Read a) => Read (Matrix f g a) where
readsPrec = readsPrec1
instance (Eq1 f, Eq1 g, Eq a) => Eq (Matrix f g a) where
(==) = eq1
instance (Ord1 f, Ord1 g, Ord a) => Ord (Matrix f g a) where
compare = compare1
newtype Min a = Min
{ getMin :: a
} deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable)
newtype Max a = Max
{ getMax :: a
} deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable)
instance Eq1 Max where
liftEq = coerce
instance Ord1 Max where
liftCompare = coerce
instance Show1 Max where
liftShowsPrec = showsNewtype "Max" "getMax"
instance Read1 Max where
liftReadsPrec = readsNewtype "Max" "getMax"
instance Eq1 Min where
liftEq = coerce
instance Ord1 Min where
liftCompare = coerce
instance Show1 Min where
liftShowsPrec = showsNewtype "Min" "getMin"
instance Read1 Min where
liftReadsPrec = readsNewtype "Min" "getMin"
instance Ord a =>
Semigroup (Max a) where
(<>) = (coerce :: WrapBinary Max a) max
instance Ord a =>
Semigroup (Min a) where
(<>) = (coerce :: WrapBinary Min a) min
instance (Ord a, HasNegativeInfinity a) =>
Monoid (Max a) where
mempty = Max negativeInfinity
mappend = (<>)
instance (Ord a, HasPositiveInfinity a) =>
Monoid (Min a) where
mempty = Min positiveInfinity
mappend = (<>)
instance (Semiring a, Ord a, HasNegativeInfinity a) =>
Semiring (Max a) where
(<+>) = mappend
zero = mempty
(<.>) = (coerce :: WrapBinary Max a) (<+>)
one = Max zero
instance (Semiring a, Ord a, HasPositiveInfinity a) =>
Semiring (Min a) where
(<+>) = mappend
zero = mempty
(<.>) = (coerce :: WrapBinary Min a) (<+>)
one = Min zero
instance (Semiring a, Ord a, HasPositiveInfinity a, HasNegativeInfinity a) =>
StarSemiring (Max a) where
star (Max x)
| x > zero = Max positiveInfinity
| otherwise = Max zero
instance (Semiring a, Ord a, HasPositiveInfinity a, HasNegativeInfinity a) =>
StarSemiring (Min a) where
star (Min x)
| x < zero = Min negativeInfinity
| otherwise = Min zero
instance (Semiring a, Ord a, HasPositiveInfinity a) =>
DetectableZero (Min a) where
isZero (Min x) = isPositiveInfinity x
instance (Semiring a, Ord a, HasNegativeInfinity a) =>
DetectableZero (Max a) where
isZero (Max x) = isNegativeInfinity x
instance Semiring b =>
Semiring (a -> b) where
zero = const zero
one = const one
(f <+> g) x = f x <+> g x
(f <.> g) x = f x <.> g x
instance StarSemiring b =>
StarSemiring (a -> b) where
star = (.) star
plus = (.) plus
instance Monoid a =>
Semiring (Endo a) where
zero = Endo mempty
Endo f <+> Endo g = Endo (f `mappend` g)
one = mempty
(<.>) = mappend
instance (Monoid a, Eq a) =>
StarSemiring (Endo a) where
star (Endo f) = Endo converge
where
converge x = go x
where
go inp =
mappend
x
(if inp == next
then inp
else go next)
where
next = mappend x (f inp)
instance (Enum a, Bounded a, Eq a, Monoid a) =>
DetectableZero (Endo a) where
isZero (Endo f) = all (mempty ==) (map f [minBound .. maxBound])
instance Semiring Any where
(<+>) = coerce (||)
zero = Any False
(<.>) = coerce (&&)
one = Any True
instance StarSemiring Any where
star _ = Any True
plus = id
instance Semiring All where
(<+>) = coerce (||)
zero = All False
(<.>) = coerce (&&)
one = All True
instance StarSemiring All where
star _ = All True
plus = id
instance DetectableZero Any where
isZero = isZeroEq
instance DetectableZero All where
isZero = isZeroEq
instance Semiring Int where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Int8 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Int16 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Int32 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Int64 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Integer where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Word where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Word8 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Word16 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Word32 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Word64 where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Float where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Double where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Scientific where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring DiffTime where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring NominalDiffTime where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUIntMax where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CIntMax where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUIntPtr where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CIntPtr where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSUSeconds where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUSeconds where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CTime where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CClock where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSigAtomic where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CWchar where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSize where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CPtrdiff where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CDouble where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CFloat where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CULLong where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CLLong where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CULong where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CLong where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUInt where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CInt where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUShort where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CShort where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUChar where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSChar where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CChar where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring IntPtr where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring WordPtr where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Fd where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CRLim where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CTcflag where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSpeed where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CCc where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CUid where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CNlink where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CGid where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CSsize where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CPid where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring COff where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CMode where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CIno where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring CDev where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring Natural where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Integral a =>
Semiring (Ratio a) where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring a => Semiring (Product a) where
one = Product one
zero = Product zero
(<+>) = (coerce :: WrapBinary Product a) (<+>)
(<.>) = (coerce :: WrapBinary Product a) (<.>)
instance Semiring a => Semiring (Sum a) where
one = Sum one
zero = Sum zero
(<+>) = (coerce :: WrapBinary Sum a) (<+>)
(<.>) = (coerce :: WrapBinary Sum a) (<.>)
instance RealFloat a =>
Semiring (Complex a) where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance HasResolution a =>
Semiring (Fixed a) where
one = 1
zero = 0
(<+>) = (+)
(<.>) = (*)
instance Semiring a => Semiring (Identity a) where
one = Identity one
zero = Identity zero
(<+>) = (coerce :: WrapBinary Identity a) (<+>)
(<.>) = (coerce :: WrapBinary Identity a) (<.>)
instance DetectableZero Int where
isZero = isZeroEq
instance DetectableZero Int8 where
isZero = isZeroEq
instance DetectableZero Int16 where
isZero = isZeroEq
instance DetectableZero Int32 where
isZero = isZeroEq
instance DetectableZero Int64 where
isZero = isZeroEq
instance DetectableZero Integer where
isZero = isZeroEq
instance DetectableZero Word where
isZero = isZeroEq
instance DetectableZero Word8 where
isZero = isZeroEq
instance DetectableZero Word16 where
isZero = isZeroEq
instance DetectableZero Word32 where
isZero = isZeroEq
instance DetectableZero Word64 where
isZero = isZeroEq
instance DetectableZero Float where
isZero = isZeroEq
instance DetectableZero Double where
isZero = isZeroEq
instance DetectableZero Scientific where
isZero = isZeroEq
instance DetectableZero DiffTime where
isZero = isZeroEq
instance DetectableZero NominalDiffTime where
isZero = isZeroEq
instance DetectableZero CUIntMax where
isZero = isZeroEq
instance DetectableZero CIntMax where
isZero = isZeroEq
instance DetectableZero CUIntPtr where
isZero = isZeroEq
instance DetectableZero CIntPtr where
isZero = isZeroEq
instance DetectableZero CSUSeconds where
isZero = isZeroEq
instance DetectableZero CUSeconds where
isZero = isZeroEq
instance DetectableZero CTime where
isZero = isZeroEq
instance DetectableZero CClock where
isZero = isZeroEq
instance DetectableZero CSigAtomic where
isZero = isZeroEq
instance DetectableZero CWchar where
isZero = isZeroEq
instance DetectableZero CSize where
isZero = isZeroEq
instance DetectableZero CPtrdiff where
isZero = isZeroEq
instance DetectableZero CDouble where
isZero = isZeroEq
instance DetectableZero CFloat where
isZero = isZeroEq
instance DetectableZero CULLong where
isZero = isZeroEq
instance DetectableZero CLLong where
isZero = isZeroEq
instance DetectableZero CULong where
isZero = isZeroEq
instance DetectableZero CLong where
isZero = isZeroEq
instance DetectableZero CUInt where
isZero = isZeroEq
instance DetectableZero CInt where
isZero = isZeroEq
instance DetectableZero CUShort where
isZero = isZeroEq
instance DetectableZero CShort where
isZero = isZeroEq
instance DetectableZero CUChar where
isZero = isZeroEq
instance DetectableZero CSChar where
isZero = isZeroEq
instance DetectableZero CChar where
isZero = isZeroEq
instance DetectableZero IntPtr where
isZero = isZeroEq
instance DetectableZero WordPtr where
isZero = isZeroEq
instance DetectableZero Fd where
isZero = isZeroEq
instance DetectableZero CRLim where
isZero = isZeroEq
instance DetectableZero CTcflag where
isZero = isZeroEq
instance DetectableZero CSpeed where
isZero = isZeroEq
instance DetectableZero CCc where
isZero = isZeroEq
instance DetectableZero CUid where
isZero = isZeroEq
instance DetectableZero CNlink where
isZero = isZeroEq
instance DetectableZero CGid where
isZero = isZeroEq
instance DetectableZero CSsize where
isZero = isZeroEq
instance DetectableZero CPid where
isZero = isZeroEq
instance DetectableZero COff where
isZero = isZeroEq
instance DetectableZero CMode where
isZero = isZeroEq
instance DetectableZero CIno where
isZero = isZeroEq
instance DetectableZero CDev where
isZero = isZeroEq
instance DetectableZero Natural where
isZero = isZeroEq
instance Integral a =>
DetectableZero (Ratio a) where
isZero = isZeroEq
deriving instance DetectableZero a => DetectableZero (Product a)
deriving instance DetectableZero a => DetectableZero (Sum a)
instance RealFloat a =>
DetectableZero (Complex a) where
isZero = isZeroEq
instance HasResolution a =>
DetectableZero (Fixed a) where
isZero = isZeroEq
deriving instance DetectableZero a => DetectableZero (Identity a)
$(traverse semiringIns [2 .. 15])
$(traverse starIns [2 .. 15])
$(traverse zeroIns [2 .. 15])