packages feed

commutative (empty) → 0.0.1

raw patch · 6 files changed

+209/−0 lines, 6 filesdep +QuickCheckdep +basedep +quickcheck-instancessetup-changed

Dependencies added: QuickCheck, base, quickcheck-instances, random, semigroups, tasty, tasty-hunit, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Athan Clark++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Athan Clark nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ commutative.cabal view
@@ -0,0 +1,41 @@+Name:                   commutative+Version:                0.0.1+Author:                 Athan Clark <athan.clark@gmail.com>+Maintainer:             Athan Clark <athan.clark@gmail.com>+License:                BSD3+License-File:           LICENSE+Synopsis:               Commutative binary operations.+Description:+  This package provides a trivial class for abelian binary operations, and an+  analogue to @Data.Foldable@.+Cabal-Version:          >= 1.10+Build-Type:             Simple+Category:               Data, Math++Library+  Default-Language:     Haskell2010+  HS-Source-Dirs:       src+  GHC-Options:          -Wall+  Exposed-Modules:      Data.Commutative+                        Data.Mergeable+  Build-Depends:        base >= 4.6 && < 5+                      , random+                      , semigroups++Test-Suite spec+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       src+                      , test+  Ghc-Options:          -Wall+  Main-Is:              Spec.hs+  Build-Depends:        base+                      , tasty+                      , tasty-quickcheck+                      , tasty-hunit+                      , QuickCheck+                      , quickcheck-instances++Source-Repository head+  Type:                 git+  Location:             https://github.com/athanclark/commutative.git
+ src/Data/Commutative.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE+    GeneralizedNewtypeDeriving+  #-}++module Data.Commutative where++import Data.Monoid (Any (..), All (..), First (..), Last (..), Sum (..), Product (..))+import System.IO.Unsafe (unsafePerformIO)+import System.Random (randomIO)+++class Commutative a where+  commute :: a -> a -> a -- ^ Abelian magma - @x `commute` y == y `commute` x@.+                         -- Note that the commutative behaviour should be embedded in the+                         -- instance. For distinguished commutes, more information is needed - like+                         -- a predicate as is the case for @commuteVia@ and @commuteViaM@.++(<~>) :: Commutative a => a -> a -> a+(<~>) = commute++class Commutative a => CommutativeId a where+  cempty :: a -- ^ Identity element - @x `commute` cempty == cempty `commute` x == x@++-- | @flip@ when @False@ - simple & pure "predicative" commute.+commuteVia :: Bool -> (a -> a -> a) -> a -> a -> a+commuteVia p f = if p then f else flip f++-- | Lifted predicative behaviour.+commuteViaF :: Functor f => f Bool -> (a -> a -> a) -> a -> a -> f a+commuteViaF mb f x y = (\b -> if b then f x y else f y x) <$> mb+++-- Unit+instance Commutative () where+  commute () () = ()++instance CommutativeId () where+  cempty = ()++-- | Endomorphisms commutative over composition.+-- __Warning__: The @Commutative@ instance uses @unsafePerformIO@ to randomly pick the order.+newtype CommEndo a = CommEndo {appCommEndo :: a -> a}++instance Commutative (CommEndo a) where+  commute (CommEndo f) (CommEndo g) = CommEndo $ pick1 (f . g) (g . f) -- it doesn't matter which is chosen++instance CommutativeId (CommEndo a) where+  cempty = CommEndo id++-- Booleans+instance Commutative Any where+  commute (Any x) (Any y) = Any $ x || y++instance CommutativeId Any where+  cempty = Any False++instance Commutative All where+  commute (All x) (All y) = All $ x && y++instance CommutativeId All where+  cempty = All True++-- Maybe++-- | In the case of two @Just@ values, the commutative instance randomly chooses one of them.+-- __Warning__: The @Commutative@ instance uses @unsafePerformIO@ to randomly pick the order.+newtype OneOf a = OneOf {getOneOf :: Maybe a}+  deriving (Show, Eq)++instance Commutative (OneOf a) where+  commute (OneOf x) (OneOf y) = OneOf $ pick1 (getFirst $ First x `mappend` First y)+                                              (getLast  $ Last x  `mappend` Last y)++-- Numbers+instance Num a => Commutative (Sum a) where+  commute (Sum x) (Sum y) = Sum $ x + y++instance Num a => CommutativeId (Sum a) where+  cempty = Sum 0++instance Num a => Commutative (Product a) where+  commute (Product x) (Product y) = Product $ x * y++instance Num a => CommutativeId (Product a) where+  cempty = Product 1+++pick1 :: a -> a -> a+pick1 l r = let leftOrRight = unsafePerformIO randomIO+            in if leftOrRight then l else r
+ src/Data/Mergeable.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE+    FlexibleInstances+  , UndecidableInstances+  #-}++module Data.Mergeable where++import Data.Commutative+import Data.List.NonEmpty as NE+++class Mergeable t where+  mergeMap :: CommutativeId m => (a -> m) -> t a -> m+  merge :: (a -> b -> b) -> b -> t a -> b++  mergeMap f = merge (commute . f) cempty+  merge f i xs = appCommEndo (mergeMap (CommEndo . f) xs) i++instance Mergeable [] where+  mergeMap _ [] = cempty+  mergeMap f (x:xs) = f x <~> mergeMap f xs+++class Functor t => Mergeable1 t where+  mergeMap1 :: Commutative m => (a -> m) -> t a -> m+  merge1 :: Commutative m => t m -> m++  mergeMap1 f = merge1 . fmap f+  merge1 = mergeMap1 id++instance Mergeable1 NonEmpty where+  mergeMap1 f (x:|[]) = f x+  mergeMap1 f (x:|xs) = f x <~> mergeMap1 f (NE.fromList xs)
+ test/Spec.hs view
@@ -0,0 +1,13 @@+module Spec where++import Data.CommutativeSpec++import Test.Tasty+++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Testing..."+  [spec]