{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Ring.Semi.Natural -- Copyright : (c) Edward Kmett 2009 -- License : BSD-style -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : non-portable (type families, MPTCs) -- -- Monoids for non-negative integers ('Natural') and ints ('Nat') -- -- The naturals form a module over any of our monoids. ----------------------------------------------------------------------------- module Data.Ring.Semi.Natural ( module Data.Ring.Semi , Natural , natural ) where import Prelude hiding (id,(.)) import Numeric (readDec, showInt) import Control.Applicative import Control.Monad import Data.Ring.Semi import qualified Data.Monoid.Combinators as Monoid -- import Data.Word import Data.Monoid.Monad import Data.Monoid.Applicative import Data.Monoid.Multiplicative import Data.Monoid.Categorical import Data.Monoid.Self import Data.Monoid.FromString import Data.Monoid.Lexical.SourcePosition import Data.Monoid.Lexical.UTF8.Decoder import Data.Monoid.Generator.Free import Data.Monoid.Generator.RLE import Data.Sequence (Seq) natural :: Integer -> Natural natural = fromInteger newtype Natural = Natural { getNatural :: Integer } deriving (Eq,Ord) instance Read Natural where readsPrec = const readDec instance Show Natural where showsPrec = const showInt instance Num Natural where Natural a + Natural b = Natural (a + b) Natural a - Natural b = fromInteger (a - b) Natural a * Natural b = Natural (a * b) abs = id signum = Natural . signum . getNatural fromInteger x | x < 0 = error "Natural < 0" | otherwise = Natural x negate 0 = 0 negate _ = error "Natural < 0" instance Enum Natural where succ (Natural n) = Natural (n + 1) pred (Natural 0) = error "Natural < 0" pred (Natural n) = Natural (n - 1) toEnum n | n < 0 = error "Natural < 0" toEnum n = Natural (fromIntegral n) fromEnum = fromIntegral enumFrom (Natural n) = Natural `map` enumFrom n enumFromThen (Natural n) (Natural np) | np < n = Natural `map` enumFromThenTo n np 0 | otherwise = Natural `map` enumFromThen n np enumFromTo (Natural n) (Natural m) = Natural `map` enumFromTo n m enumFromThenTo (Natural n) (Natural m) (Natural o) = Natural `map` enumFromThenTo n m o instance Real Natural where toRational = toRational . getNatural instance Integral Natural where toInteger = getNatural Natural a `quot` Natural b = Natural (a `quot` b) Natural a `rem` Natural b = Natural (a `rem` b) Natural a `div` Natural b = Natural (a `div` b) Natural a `mod` Natural b = Natural (a `mod` b) Natural a `quotRem` Natural b = (Natural q,Natural r) where ~(q,r) = a `quotRem` b Natural a `divMod` Natural b = (Natural q,Natural r) where ~(q,r) = a `divMod` b instance Monoid Natural where mempty = 0 mappend = (+) instance Multiplicative Natural where one = 1 times = (*) instance LeftSemiNearRing Natural instance RightSemiNearRing Natural instance SemiRing Natural instance LeftModule Natural () where _ *. _ = () instance RightModule Natural () where _ .* _ = () instance Module Natural () -- idempotent monoids instance LeftModule Natural Any where 0 *. _ = mempty _ *. m = m instance RightModule Natural Any where _ .* 0 = mempty m .* _ = m instance Module Natural Any instance LeftModule Natural All where 0 *. _ = mempty _ *. m = m instance RightModule Natural All where _ .* 0 = mempty m .* _ = m instance Module Natural All instance LeftModule Natural (First a) where 0 *. _ = mempty _ *. m = m instance RightModule Natural (First a) where _ .* 0 = mempty m .* _ = m instance Module Natural (First a) instance LeftModule Natural (Last a) where 0 *. _ = mempty _ *. m = m instance RightModule Natural (Last a) where _ .* 0 = mempty m .* _ = m instance Module Natural (Last a) instance LeftModule Natural Ordering where 0 *. _ = mempty _ *. m = m instance RightModule Natural Ordering where _ .* 0 = mempty m .* _ = m instance Module Natural Ordering -- other monoids instance LeftModule Natural [a] where (*.) = flip Monoid.replicate instance RightModule Natural [a] where (.*) = Monoid.replicate instance Module Natural [a] instance Monoid m => LeftModule Natural (a -> m) where (*.) = flip Monoid.replicate instance Monoid m => RightModule Natural (a -> m) where (.*) = Monoid.replicate instance Monoid m => Module Natural (a -> m) instance Num a => LeftModule Natural (Sum a) where (*.) = flip Monoid.replicate instance Num a => RightModule Natural (Sum a) where (.*) = Monoid.replicate instance Num a => Module Natural (Sum a) instance Num a => LeftModule Natural (Product a) where (*.) = flip (.*) instance Num a => RightModule Natural (Product a) where Product m .* Natural n = Product (m ^ n) instance Num a => Module Natural (Product a) instance LeftModule Natural (Endo a) where (*.) = flip Monoid.replicate instance RightModule Natural (Endo a) where (.*) = Monoid.replicate instance Module Natural (Endo a) instance Monoid m => LeftModule Natural (Dual m) where (*.) = flip Monoid.replicate instance Monoid m => RightModule Natural (Dual m) where (.*) = Monoid.replicate instance Monoid m => Module Natural (Dual m) -- FromString instance Monoid m => LeftModule Natural (FromString m) where (*.) = flip Monoid.replicate instance Monoid m => RightModule Natural (FromString m) where (.*) = Monoid.replicate instance Monoid m => Module Natural (FromString m) -- Self instance Monoid m => LeftModule Natural (Self m) where (*.) = flip Monoid.replicate instance Monoid m => RightModule Natural (Self m) where (.*) = Monoid.replicate instance Monoid m => Module Natural (Self m) -- Free Generator instance LeftModule Natural (Free a) where (*.) = flip Monoid.replicate instance RightModule Natural (Free a) where (.*) = Monoid.replicate instance Module Natural (Free a) -- RLE Seq instance Eq a => LeftModule Natural (RLE Seq a) where (*.) = flip Monoid.replicate instance Eq a => RightModule Natural (RLE Seq a) where (.*) = Monoid.replicate instance Eq a => Module Natural (RLE Seq a) -- Categorical instance Category k => LeftModule Natural (GEndo k a) where (*.) = flip Monoid.replicate instance Category k => RightModule Natural (GEndo k a) where (.*) = Monoid.replicate instance Category k => Module Natural (GEndo k a) instance Monoid m => LeftModule Natural (CMonoid m m m) where (*.) = flip Monoid.replicate instance Monoid m => RightModule Natural (CMonoid m m m) where (.*) = Monoid.replicate instance Monoid m => Module Natural (CMonoid m m m) -- Alternative instance Applicative f => LeftModule Natural (Traversal f) where (*.) = flip Monoid.replicate instance Applicative f => RightModule Natural (Traversal f) where (.*) = Monoid.replicate instance Applicative f => Module Natural (Traversal f) instance Alternative f => LeftModule Natural (Alt f a) where (*.) = flip Monoid.replicate instance Alternative f => RightModule Natural (Alt f a) where (.*) = Monoid.replicate instance Alternative f => Module Natural (Alt f a) --instance (Alternative f, Monoid m) => LeftModule Natural (App f m) where (*.) = flip Monoid.replicate --instance (Alternative f, Monoid m) => RightModule Natural (App f m) where (.*) = Monoid.replicate --instance (Alternative f, Monoid m) => Module Natural (App f m) -- Monad instance Monad f => LeftModule Natural (Action f) where (*.) = flip Monoid.replicate instance Monad f => RightModule Natural (Action f) where (.*) = Monoid.replicate instance Monad f => Module Natural (Action f) instance MonadPlus f => LeftModule Natural (MonadSum f a) where (*.) = flip Monoid.replicate instance MonadPlus f => RightModule Natural (MonadSum f a) where (.*) = Monoid.replicate instance MonadPlus f => Module Natural (MonadSum f a) --instance (MonadPlus f, Monoid m) => LeftModule Natural (Mon f m) where (*.) = flip Monoid.replicate --instance (MonadPlus f, Monoid m) => RightModule Natural (Mon f m) where (.*) = Monoid.replicate --instance (MonadPlus f, Monoid m) => Module Natural (Mon f m) -- Lexical instance LeftModule Natural (SourcePosition f) where 0 *. _ = mempty n *. Columns x = Columns (fromIntegral n * x) n *. Lines l c = Lines (fromIntegral n * l) c _ *. Pos f l c = Pos f l c n *. t = Monoid.replicate t n instance RightModule Natural (SourcePosition f) where (.*) = flip (*.) instance Module Natural (SourcePosition f) instance CharReducer m => LeftModule Natural (UTF8 m) where (*.) = flip Monoid.replicate instance CharReducer m => RightModule Natural (UTF8 m) where (.*) = Monoid.replicate instance CharReducer m => Module Natural (UTF8 m) instance Multiplicative m => LeftModule Natural (Log m) where (*.) = flip Monoid.replicate instance Multiplicative m => RightModule Natural (Log m) where (.*) = Monoid.replicate instance Multiplicative m => Module Natural (Log m) -- TODO -- -- Control.Monad.* -- ParsecT -- FingerTree -- Int, Integer, Ratio -- SourcePosition -- Replace Natural here with some other notion of NonNegative a -- Words, Lines, Unspaced, Unlined -- Union/UnionWith, Map, Set, etc. -- Max, Min, MaxPriority, MinPriority idempotent -- BoolRing -- Seq