{-# 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
    , 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

-- | @a * (b + c) = (a * b) + (a * c)@
class (Multiplicative m, Monoid m) => LeftSemiNearRing m 

-- 'Monoid' transformers
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 (Multiplicative m, Monoid m) => RightSemiNearRing m 

-- 'Monoid' transformers
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)

-- non-'Monad' instances
instance (Measured v m, Monoid m) => RightSemiNearRing (FingerTree v m)

-- 'Monad' instances
-- Every 'MonadPlus' over a 'Monoid' with an appropriate 'Multiplicative' instance
-- for 'liftM2 mappend' is a 'RightSemiNearRing' by 'MonadPlus' left-distributivity

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)