{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Ring.Semi.Near
-- Copyright   :  (c) Edward Kmett 2009
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  portable (instances use MPTCs)
--
-- Defines left- and right- seminearrings. Every 'MonadPlus' wrapped around
-- a 'Monoid' qualifies due to the distributivity of (>>=) over 'mplus'.
--
-- See <http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/>
--
-----------------------------------------------------------------------------

module Data.Ring.Semi.Near
    ( module Data.Monoid.Multiplicative
    , Ringoid
    , LeftSemiNearRing
    , RightSemiNearRing
    ) where

import Control.Monad.Reader

import qualified Control.Monad.RWS.Lazy as LRWS
import qualified Control.Monad.RWS.Strict as SRWS

import qualified Control.Monad.State.Lazy as LState
import qualified Control.Monad.State.Strict as SState

import qualified Control.Monad.Writer.Lazy as LWriter
import qualified Control.Monad.Writer.Strict as SWriter

import Data.Monoid.Multiplicative
import Data.FingerTree
import Data.Monoid.FromString
import Data.Monoid.Self
import Data.Generator

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

import Text.Parsec.Prim

-- | @0@ annihilates `times`
class (Multiplicative m, Monoid m) => Ringoid m
instance Ringoid m => Ringoid (Self m)
instance Ringoid m => Ringoid (FromString m)
instance Ringoid m => Ringoid (ReducedBy m s)
instance Ringoid m => Ringoid (Dual m)
instance (Measured v m, Monoid m) => Ringoid (FingerTree v m)
instance Monoid m => Ringoid [m]
instance Monoid m => Ringoid (Maybe m)
instance Monoid m => Ringoid (Seq m)
instance (Stream s m t, Monoid a) => Ringoid (ParsecT s u m a)
instance (MonadPlus m, Monoid n) => Ringoid (SState.StateT s m n)
instance (MonadPlus m, Monoid n) => Ringoid (LState.StateT s m n)
instance (MonadPlus m, Monoid n) => Ringoid (ReaderT e m n)
instance (MonadPlus m, Monoid w, Monoid n) => Ringoid (SRWS.RWST r w s m n)
instance (MonadPlus m, Monoid w, Monoid n) => Ringoid (LRWS.RWST r w s m n)
instance (MonadPlus m, Monoid w, Monoid n) => Ringoid (SWriter.WriterT w m n)
instance (MonadPlus m, Monoid w, Monoid n) => Ringoid (LWriter.WriterT w m n)

-- | @a * (b + c) = (a * b) + (a * c)@
class Ringoid m => LeftSemiNearRing m 
instance LeftSemiNearRing m => LeftSemiNearRing (Self m)
instance LeftSemiNearRing m => LeftSemiNearRing (FromString m)
instance LeftSemiNearRing m => LeftSemiNearRing (ReducedBy m s)
instance RightSemiNearRing m => LeftSemiNearRing (Dual m)

-- | @(a + b) * c = (a * c) + (b * c)@
class Ringoid m => RightSemiNearRing m 
instance RightSemiNearRing m => RightSemiNearRing (Self m)
instance RightSemiNearRing m => RightSemiNearRing (FromString m)
instance RightSemiNearRing m => RightSemiNearRing (ReducedBy m s)
instance LeftSemiNearRing m => RightSemiNearRing (Dual m)
instance (Measured v m, Monoid m) => RightSemiNearRing (FingerTree v m)
instance Monoid m => RightSemiNearRing [m]
instance Monoid m => RightSemiNearRing (Maybe m)
instance Monoid m => RightSemiNearRing (Seq m)
instance (Stream s m t, Monoid a) => RightSemiNearRing (ParsecT s u m a)
instance (MonadPlus m, Monoid n) => RightSemiNearRing (SState.StateT s m n)
instance (MonadPlus m, Monoid n) => RightSemiNearRing (LState.StateT s m n)
instance (MonadPlus m, Monoid n) => RightSemiNearRing (ReaderT e m n)
instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (SRWS.RWST r w s m n)
instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (LRWS.RWST r w s m n)
instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (SWriter.WriterT w m n)
instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (LWriter.WriterT w m n)