{-# LANGUAGE CPP #-}
#if MIN_VERSION_base(4,6,0)
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Semiring.Generic
(
#if MIN_VERSION_base(4,6,0)
GSemiring(..)
, gzero
, gone
, gplus
, gtimes
, gfromNatural
, GRing(..)
, gnegate
, GenericSemiring(..)
#endif
) where
#if MIN_VERSION_base(4,6,0)
import Data.Semiring
import GHC.Generics
import Numeric.Natural (Natural)
import Prelude hiding (Num(..))
newtype GenericSemiring a = GenericSemiring a
instance (Generic a, GSemiring (Rep a)) => Semiring (GenericSemiring a) where
zero :: GenericSemiring a
zero = a -> GenericSemiring a
forall a. a -> GenericSemiring a
GenericSemiring a
forall a. (Generic a, GSemiring (Rep a)) => a
gzero
one :: GenericSemiring a
one = a -> GenericSemiring a
forall a. a -> GenericSemiring a
GenericSemiring a
forall a. (Generic a, GSemiring (Rep a)) => a
gone
plus :: GenericSemiring a -> GenericSemiring a -> GenericSemiring a
plus (GenericSemiring a
x) (GenericSemiring a
y) = a -> GenericSemiring a
forall a. a -> GenericSemiring a
GenericSemiring (a -> a -> a
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus a
x a
y)
times :: GenericSemiring a -> GenericSemiring a -> GenericSemiring a
times (GenericSemiring a
x) (GenericSemiring a
y) = a -> GenericSemiring a
forall a. a -> GenericSemiring a
GenericSemiring (a -> a -> a
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes a
x a
y)
fromNatural :: Natural -> GenericSemiring a
fromNatural Natural
x = a -> GenericSemiring a
forall a. a -> GenericSemiring a
GenericSemiring (Natural -> a
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural Natural
x)
instance (Semiring a, Semiring b) => Semiring (a,b) where
zero :: (a, b)
zero = (a, b)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b)
one = (a, b)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b) -> (a, b) -> (a, b)
plus = (a, b) -> (a, b) -> (a, b)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b) -> (a, b) -> (a, b)
times = (a, b) -> (a, b) -> (a, b)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b)
fromNatural = Natural -> (a, b)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where
zero :: (a, b, c)
zero = (a, b, c)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b, c)
one = (a, b, c)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b, c) -> (a, b, c) -> (a, b, c)
plus = (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b, c) -> (a, b, c) -> (a, b, c)
times = (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b, c)
fromNatural = Natural -> (a, b, c)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where
zero :: (a, b, c, d)
zero = (a, b, c, d)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b, c, d)
one = (a, b, c, d)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
plus = (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
times = (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b, c, d)
fromNatural = Natural -> (a, b, c, d)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where
zero :: (a, b, c, d, e)
zero = (a, b, c, d, e)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b, c, d, e)
one = (a, b, c, d, e)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
plus = (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
times = (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b, c, d, e)
fromNatural = Natural -> (a, b, c, d, e)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where
zero :: (a, b, c, d, e, f)
zero = (a, b, c, d, e, f)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b, c, d, e, f)
one = (a, b, c, d, e, f)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
plus = (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
times = (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b, c, d, e, f)
fromNatural = Natural -> (a, b, c, d, e, f)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where
zero :: (a, b, c, d, e, f, g)
zero = (a, b, c, d, e, f, g)
forall a. (Generic a, GSemiring (Rep a)) => a
gzero; one :: (a, b, c, d, e, f, g)
one = (a, b, c, d, e, f, g)
forall a. (Generic a, GSemiring (Rep a)) => a
gone; plus :: (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
plus = (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus; times :: (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
times = (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
forall a. (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes; fromNatural :: Natural -> (a, b, c, d, e, f, g)
fromNatural = Natural -> (a, b, c, d, e, f, g)
forall a. (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural;
instance (Ring a, Ring b) => Ring (a,b) where
negate :: (a, b) -> (a, b)
negate = (a, b) -> (a, b)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
instance (Ring a, Ring b, Ring c) => Ring (a,b,c) where
negate :: (a, b, c) -> (a, b, c)
negate = (a, b, c) -> (a, b, c)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
instance (Ring a, Ring b, Ring c, Ring d) => Ring (a,b,c,d) where
negate :: (a, b, c, d) -> (a, b, c, d)
negate = (a, b, c, d) -> (a, b, c, d)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a,b,c,d,e) where
negate :: (a, b, c, d, e) -> (a, b, c, d, e)
negate = (a, b, c, d, e) -> (a, b, c, d, e)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f) => Ring (a,b,c,d,e,f) where
negate :: (a, b, c, d, e, f) -> (a, b, c, d, e, f)
negate = (a, b, c, d, e, f) -> (a, b, c, d, e, f)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f, Ring g) => Ring (a,b,c,d,e,f,g) where
negate :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
negate = (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
forall a. (Generic a, GRing (Rep a)) => a -> a
gnegate
class GSemiring f where
#if __GLASGOW_HASKELL__ >= 708
{-# MINIMAL gplus', gzero', gtimes', gone', gfromNatural' #-}
#endif
gzero' :: f a
gone' :: f a
gplus' :: f a -> f a -> f a
gtimes' :: f a -> f a -> f a
gfromNatural' :: Natural -> f a
class GRing f where
#if __GLASGOW_HASKELL__ >= 708
{-# MINIMAL gnegate' #-}
#endif
gnegate' :: f a -> f a
gzero :: (Generic a, GSemiring (Rep a)) => a
gzero :: a
gzero = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) a. GSemiring f => f a
gzero'
gone :: (Generic a, GSemiring (Rep a)) => a
gone :: a
gone = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) a. GSemiring f => f a
gone'
gplus :: (Generic a, GSemiring (Rep a)) => a -> a -> a
gplus :: a -> a -> a
gplus a
x a
y = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x Rep a Any -> Rep a Any -> Rep a Any
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
`gplus'` a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
y
gtimes :: (Generic a, GSemiring (Rep a)) => a -> a -> a
gtimes :: a -> a -> a
gtimes a
x a
y = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x Rep a Any -> Rep a Any -> Rep a Any
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
`gtimes'` a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
y
gfromNatural :: (Generic a, GSemiring (Rep a)) => Natural -> a
gfromNatural :: Natural -> a
gfromNatural = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (Natural -> Rep a Any) -> Natural -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Rep a Any
forall (f :: * -> *) a. GSemiring f => Natural -> f a
gfromNatural'
gnegate :: (Generic a, GRing (Rep a)) => a -> a
gnegate :: a -> a
gnegate a
x = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> Rep a Any
forall (f :: * -> *) a. GRing f => f a -> f a
gnegate' (Rep a Any -> Rep a Any) -> Rep a Any -> Rep a Any
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x
instance GSemiring U1 where
gzero' :: U1 a
gzero' = U1 a
forall k (p :: k). U1 p
U1
gone' :: U1 a
gone' = U1 a
forall k (p :: k). U1 p
U1
gplus' :: U1 a -> U1 a -> U1 a
gplus' U1 a
_ U1 a
_ = U1 a
forall k (p :: k). U1 p
U1
gtimes' :: U1 a -> U1 a -> U1 a
gtimes' U1 a
_ U1 a
_ = U1 a
forall k (p :: k). U1 p
U1
gfromNatural' :: Natural -> U1 a
gfromNatural' Natural
_ = U1 a
forall k (p :: k). U1 p
U1
instance GRing U1 where
gnegate' :: U1 a -> U1 a
gnegate' U1 a
_ = U1 a
forall k (p :: k). U1 p
U1
instance (GSemiring a, GSemiring b) => GSemiring (a :*: b) where
gzero' :: (:*:) a b a
gzero' = a a
forall (f :: * -> *) a. GSemiring f => f a
gzero' a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
forall (f :: * -> *) a. GSemiring f => f a
gzero'
gone' :: (:*:) a b a
gone' = a a
forall (f :: * -> *) a. GSemiring f => f a
gone' a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
forall (f :: * -> *) a. GSemiring f => f a
gone'
gplus' :: (:*:) a b a -> (:*:) a b a -> (:*:) a b a
gplus' (a a
a :*: b a
b) (a a
c :*: b a
d) = a a -> a a -> a a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gplus' a a
a a a
c a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a -> b a -> b a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gplus' b a
b b a
d
gtimes' :: (:*:) a b a -> (:*:) a b a -> (:*:) a b a
gtimes' (a a
a :*: b a
b) (a a
c :*: b a
d) = a a -> a a -> a a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gtimes' a a
a a a
c a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a -> b a -> b a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gtimes' b a
b b a
d
gfromNatural' :: Natural -> (:*:) a b a
gfromNatural' Natural
n = Natural -> a a
forall (f :: * -> *) a. GSemiring f => Natural -> f a
gfromNatural' Natural
n a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Natural -> b a
forall (f :: * -> *) a. GSemiring f => Natural -> f a
gfromNatural' Natural
n
instance (GRing a, GRing b) => GRing (a :*: b) where
gnegate' :: (:*:) a b a -> (:*:) a b a
gnegate' (a a
a :*: b a
b) = a a -> a a
forall (f :: * -> *) a. GRing f => f a -> f a
gnegate' a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a -> b a
forall (f :: * -> *) a. GRing f => f a -> f a
gnegate' b a
b
instance (GSemiring a) => GSemiring (M1 i c a) where
gzero' :: M1 i c a a
gzero' = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 a a
forall (f :: * -> *) a. GSemiring f => f a
gzero'
gone' :: M1 i c a a
gone' = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 a a
forall (f :: * -> *) a. GSemiring f => f a
gone'
gplus' :: M1 i c a a -> M1 i c a a -> M1 i c a a
gplus' (M1 a a
x) (M1 a a
y) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ a a -> a a -> a a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gplus' a a
x a a
y
gtimes' :: M1 i c a a -> M1 i c a a -> M1 i c a a
gtimes' (M1 a a
x) (M1 a a
y) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ a a -> a a -> a a
forall (f :: * -> *) a. GSemiring f => f a -> f a -> f a
gtimes' a a
x a a
y
gfromNatural' :: Natural -> M1 i c a a
gfromNatural' = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> (Natural -> a a) -> Natural -> M1 i c a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> a a
forall (f :: * -> *) a. GSemiring f => Natural -> f a
gfromNatural'
instance (GRing a) => GRing (M1 i c a) where
gnegate' :: M1 i c a a -> M1 i c a a
gnegate' (M1 a a
x) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ a a -> a a
forall (f :: * -> *) a. GRing f => f a -> f a
gnegate' a a
x
instance (Semiring a) => GSemiring (K1 i a) where
gzero' :: K1 i a a
gzero' = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 a
forall a. Semiring a => a
zero
gone' :: K1 i a a
gone' = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 a
forall a. Semiring a => a
one
gplus' :: K1 i a a -> K1 i a a -> K1 i a a
gplus' (K1 a
x) (K1 a
y) = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> a -> K1 i a a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Semiring a => a -> a -> a
plus a
x a
y
gtimes' :: K1 i a a -> K1 i a a -> K1 i a a
gtimes' (K1 a
x) (K1 a
y) = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> a -> K1 i a a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Semiring a => a -> a -> a
times a
x a
y
gfromNatural' :: Natural -> K1 i a a
gfromNatural' = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> (Natural -> a) -> Natural -> K1 i a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> a
forall a. Semiring a => Natural -> a
fromNatural
instance (Ring a) => GRing (K1 i a) where
gnegate' :: K1 i a a -> K1 i a a
gnegate' (K1 a
x) = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> a -> K1 i a a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Ring a => a -> a
negate a
x
#endif