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
(<~>) :: Commutative a => a -> a -> a
(<~>) = commute
class Commutative a => CommutativeId a where
cempty :: a
commuteVia :: Bool -> (a -> a -> a) -> a -> a -> a
commuteVia p f = if p then f else flip f
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
instance Commutative () where
commute () () = ()
instance CommutativeId () where
cempty = ()
newtype CommEndo a = CommEndo {appCommEndo :: a -> a}
instance Commutative (CommEndo a) where
commute (CommEndo f) (CommEndo g) = CommEndo $ pick1 (f . g) (g . f)
instance CommutativeId (CommEndo a) where
cempty = CommEndo id
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
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)
instance CommutativeId (OneOf a) where
cempty = OneOf Nothing
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