monoids 0.1.17 → 0.1.19

raw patch · 7 files changed

+303/−17 lines, 7 files

Files

• Data/Monoid/Applicative.hs +2/−6
• Data/Monoid/Lexical/SourcePosition.hs +3/−2
• Data/Ring.hs +13/−0
• Data/Ring/ModularArithmetic.hs +1/−1
• Data/Ring/Module.hs +22/−7
• Data/Ring/Semi/Natural.hs +260/−0
• monoids.cabal +2/−1

@@ -92,10 +92,6 @@ instance (c `Reducer` m, Applicative f) => Reducer c (f `App` m) where     unit = pure . unit -instance (LeftModule r m, Applicative f) => LeftModule r (f `App` m) where-    x *. m = (x *.) <$> m--instance (RightModule r m, Applicative f) => RightModule r (f `App` m) where-    m .* y = (.* y) <$> m-+instance (LeftModule r m, Applicative f) => LeftModule r (f `App` m) where x *. m = (x *.) <$> m+instance (RightModule r m, Applicative f) => RightModule r (f `App` m) where m .* y = (.* y) <$> m instance (Module r m, Applicative f) => Module r (f `App` m)

@@ -21,7 +21,7 @@ module Data.Monoid.Lexical.SourcePosition     ( module Data.Monoid.Reducer.Char     , nextTab-    , SourcePosition+    , SourcePosition(Pos,Lines,Columns,Tab)     , SourceLine     , SourceColumn     , sourceLine@@ -30,12 +30,13 @@     , showSourcePosition     ) where -import Prelude hiding (lex) import Control.Functor.Extras import Control.Functor.Pointed import Data.Monoid.Reducer.Char import Data.Monoid.Generator import Data.String++  type SourceLine = Int type SourceColumn = Int

@@ -1,4 +1,17 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable (instances use MPTCs)+--+-----------------------------------------------------------------------------+ module Data.Ring     ( module Data.Group     , module Data.Ring.Semi

@@ -33,7 +33,7 @@  data ModulusNum s a -instance (ReflectNum s, Num a) => Modular (ModulusNum s a) a where+instance (ReflectedNum s, Num a) => Modular (ModulusNum s a) a where     modulus _ = reflectNum (undefined :: s)  withIntegralModulus :: Integral a => a -> (forall s. Modular s a => w `Mod` s) -> w

@@ -37,10 +37,25 @@ -- | @ (x *. m) .* y = x *. (m .* y) @ class (LeftModule r m, RightModule r m) => Module r m  --- instance Monoid m => LeftModule Int m where i *. m = Monoid.replicate m i --- instance Monoid m => RightModule Int m where m .* i = Monoid.replicate m i --- instance Monoid m => Module Int m-    --- instance Monoid m => LeftModule Integer m where i *. m = Monoid.replicate m i --- instance Monoid m => RightModule Integer m where m .* i = Monoid.replicate m i --- instance Monoid m => Module Integer m+instance (LeftModule r m, LeftModule r n) => LeftModule r (m,n) where+    r *. (m,n) = (r *. m, r *. n)+instance (LeftModule r m, LeftModule r n, LeftModule r o) => LeftModule r (m,n,o) where+    r *. (m,n,o) = (r *. m, r *. n, r *. o)+instance (LeftModule r m, LeftModule r n, LeftModule r o, LeftModule r p) => LeftModule r (m,n,o,p) where+    r *. (m,n,o,p) = (r *. m, r *. n, r *. o, r *. p)+instance (LeftModule r m, LeftModule r n, LeftModule r o, LeftModule r p, LeftModule r q) => LeftModule r (m,n,o,p,q) where+    r *. (m,n,o,p,q) = (r *. m, r *. n, r *. o, r *. p, r *. q)++instance (RightModule r m, RightModule r n) => RightModule r (m,n) where+    (m,n) .* r = (m .* r, n .* r)+instance (RightModule r m, RightModule r n, RightModule r o) => RightModule r (m,n,o) where+    (m,n,o) .* r = (m .* r, n .* r, o .* r)+instance (RightModule r m, RightModule r n, RightModule r o, RightModule r p ) => RightModule r (m,n,o,p) where+    (m,n,o,p) .* r = (m .* r, n .* r, o .* r, p .* r)+instance (RightModule r m, RightModule r n, RightModule r o, RightModule r p, RightModule r q ) => RightModule r (m,n,o,p,q) where+    (m,n,o,p,q) .* r = (m .* r, n .* r, o .* r, p .* r, q .* r)++instance (Module r m, Module r n) => Module r (m,n)+instance (Module r m, Module r n, Module r o) => Module r (m,n,o)+instance (Module r m, Module r n, Module r o, Module r p) => Module r (m,n,o,p)+instance (Module r m, Module r n, Module r o, Module r p, Module r q) => Module r (m,n,o,p,q)

@@ -0,0 +1,260 @@+{-# 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

@@ -1,5 +1,5 @@ name:		    monoids-version:	    0.1.17+version:	    0.1.19 license:	    BSD3 license-file:   LICENSE author:		    Edward A. Kmett@@ -64,6 +64,7 @@     Data.Ring.Module.AutomaticDifferentiation     Data.Ring.Semi     Data.Ring.Semi.Near+    Data.Ring.Semi.Natural     Data.Ring.Semi.Ord     Data.Ring.Semi.Tropical     Data.Ring.Sugar