module Data.Algebra.Internal where
import GHC.Exts (Constraint)
import Control.Applicative
import Data.Traversable (Traversable(..))
import GHC.Conc (STM)
import Data.Monoid
import Control.Arrow ((&&&))
class Traversable f => AlgebraSignature f where
type Class f :: * -> Constraint
evaluate :: Class f b => f b -> b
class Algebra f a where
algebra :: AlgebraSignature f => f a -> a
algebraA :: (Applicative g, Class f b, AlgebraSignature f) => f (g b) -> g b
algebraA = fmap evaluate . sequenceA
instance Algebra f () where
algebra = const ()
instance (Class f m, Class f n) => Algebra f (m, n) where
algebra = evaluate . fmap fst &&& evaluate . fmap snd
instance Class f b => Algebra f (a -> b) where algebra = algebraA
instance Class f b => Algebra f (IO b) where algebra = algebraA
instance Class f b => Algebra f (Maybe b) where algebra = algebraA
instance Class f b => Algebra f (Either a b) where algebra = algebraA
instance Class f b => Algebra f (STM b) where algebra = algebraA
instance (Monoid m, Class f b) => Algebra f (Const m b) where algebra = algebraA