{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
-- | Inverting a 'Join' semilattice gives rise to a 'Meet' semilattice, and vice versa.
module Data.Semilattice.Tumble
( Tumble(..)
) where

import Data.Semilattice.Join
import Data.Semilattice.Lower
import Data.Semilattice.Meet
import Data.Semilattice.Upper

-- | 'Tumble' gives a 'Join' semilattice for any 'Meet' semilattice and vice versa, 'Lower' bounds for 'Upper' bounds and vice versa, and swaps the bounds of 'Bounded' instances.
newtype Tumble a = Tumble { Tumble a -> a
getTumble :: a }
  deriving (Int -> Tumble a
Tumble a -> Int
Tumble a -> [Tumble a]
Tumble a -> Tumble a
Tumble a -> Tumble a -> [Tumble a]
Tumble a -> Tumble a -> Tumble a -> [Tumble a]
(Tumble a -> Tumble a)
-> (Tumble a -> Tumble a)
-> (Int -> Tumble a)
-> (Tumble a -> Int)
-> (Tumble a -> [Tumble a])
-> (Tumble a -> Tumble a -> [Tumble a])
-> (Tumble a -> Tumble a -> [Tumble a])
-> (Tumble a -> Tumble a -> Tumble a -> [Tumble a])
-> Enum (Tumble a)
forall a. Enum a => Int -> Tumble a
forall a. Enum a => Tumble a -> Int
forall a. Enum a => Tumble a -> [Tumble a]
forall a. Enum a => Tumble a -> Tumble a
forall a. Enum a => Tumble a -> Tumble a -> [Tumble a]
forall a. Enum a => Tumble a -> Tumble a -> Tumble a -> [Tumble a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tumble a -> Tumble a -> Tumble a -> [Tumble a]
$cenumFromThenTo :: forall a. Enum a => Tumble a -> Tumble a -> Tumble a -> [Tumble a]
enumFromTo :: Tumble a -> Tumble a -> [Tumble a]
$cenumFromTo :: forall a. Enum a => Tumble a -> Tumble a -> [Tumble a]
enumFromThen :: Tumble a -> Tumble a -> [Tumble a]
$cenumFromThen :: forall a. Enum a => Tumble a -> Tumble a -> [Tumble a]
enumFrom :: Tumble a -> [Tumble a]
$cenumFrom :: forall a. Enum a => Tumble a -> [Tumble a]
fromEnum :: Tumble a -> Int
$cfromEnum :: forall a. Enum a => Tumble a -> Int
toEnum :: Int -> Tumble a
$ctoEnum :: forall a. Enum a => Int -> Tumble a
pred :: Tumble a -> Tumble a
$cpred :: forall a. Enum a => Tumble a -> Tumble a
succ :: Tumble a -> Tumble a
$csucc :: forall a. Enum a => Tumble a -> Tumble a
Enum, Tumble a -> Tumble a -> Bool
(Tumble a -> Tumble a -> Bool)
-> (Tumble a -> Tumble a -> Bool) -> Eq (Tumble a)
forall a. Eq a => Tumble a -> Tumble a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tumble a -> Tumble a -> Bool
$c/= :: forall a. Eq a => Tumble a -> Tumble a -> Bool
== :: Tumble a -> Tumble a -> Bool
$c== :: forall a. Eq a => Tumble a -> Tumble a -> Bool
Eq, Tumble a -> Bool
(a -> m) -> Tumble a -> m
(a -> b -> b) -> b -> Tumble a -> b
(forall m. Monoid m => Tumble m -> m)
-> (forall m a. Monoid m => (a -> m) -> Tumble a -> m)
-> (forall m a. Monoid m => (a -> m) -> Tumble a -> m)
-> (forall a b. (a -> b -> b) -> b -> Tumble a -> b)
-> (forall a b. (a -> b -> b) -> b -> Tumble a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tumble a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tumble a -> b)
-> (forall a. (a -> a -> a) -> Tumble a -> a)
-> (forall a. (a -> a -> a) -> Tumble a -> a)
-> (forall a. Tumble a -> [a])
-> (forall a. Tumble a -> Bool)
-> (forall a. Tumble a -> Int)
-> (forall a. Eq a => a -> Tumble a -> Bool)
-> (forall a. Ord a => Tumble a -> a)
-> (forall a. Ord a => Tumble a -> a)
-> (forall a. Num a => Tumble a -> a)
-> (forall a. Num a => Tumble a -> a)
-> Foldable Tumble
forall a. Eq a => a -> Tumble a -> Bool
forall a. Num a => Tumble a -> a
forall a. Ord a => Tumble a -> a
forall m. Monoid m => Tumble m -> m
forall a. Tumble a -> Bool
forall a. Tumble a -> Int
forall a. Tumble a -> [a]
forall a. (a -> a -> a) -> Tumble a -> a
forall m a. Monoid m => (a -> m) -> Tumble a -> m
forall b a. (b -> a -> b) -> b -> Tumble a -> b
forall a b. (a -> b -> b) -> b -> Tumble a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Tumble a -> a
$cproduct :: forall a. Num a => Tumble a -> a
sum :: Tumble a -> a
$csum :: forall a. Num a => Tumble a -> a
minimum :: Tumble a -> a
$cminimum :: forall a. Ord a => Tumble a -> a
maximum :: Tumble a -> a
$cmaximum :: forall a. Ord a => Tumble a -> a
elem :: a -> Tumble a -> Bool
$celem :: forall a. Eq a => a -> Tumble a -> Bool
length :: Tumble a -> Int
$clength :: forall a. Tumble a -> Int
null :: Tumble a -> Bool
$cnull :: forall a. Tumble a -> Bool
toList :: Tumble a -> [a]
$ctoList :: forall a. Tumble a -> [a]
foldl1 :: (a -> a -> a) -> Tumble a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Tumble a -> a
foldr1 :: (a -> a -> a) -> Tumble a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Tumble a -> a
foldl' :: (b -> a -> b) -> b -> Tumble a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Tumble a -> b
foldl :: (b -> a -> b) -> b -> Tumble a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Tumble a -> b
foldr' :: (a -> b -> b) -> b -> Tumble a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Tumble a -> b
foldr :: (a -> b -> b) -> b -> Tumble a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Tumble a -> b
foldMap' :: (a -> m) -> Tumble a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Tumble a -> m
foldMap :: (a -> m) -> Tumble a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Tumble a -> m
fold :: Tumble m -> m
$cfold :: forall m. Monoid m => Tumble m -> m
Foldable, a -> Tumble b -> Tumble a
(a -> b) -> Tumble a -> Tumble b
(forall a b. (a -> b) -> Tumble a -> Tumble b)
-> (forall a b. a -> Tumble b -> Tumble a) -> Functor Tumble
forall a b. a -> Tumble b -> Tumble a
forall a b. (a -> b) -> Tumble a -> Tumble b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Tumble b -> Tumble a
$c<$ :: forall a b. a -> Tumble b -> Tumble a
fmap :: (a -> b) -> Tumble a -> Tumble b
$cfmap :: forall a b. (a -> b) -> Tumble a -> Tumble b
Functor, Integer -> Tumble a
Tumble a -> Tumble a
Tumble a -> Tumble a -> Tumble a
(Tumble a -> Tumble a -> Tumble a)
-> (Tumble a -> Tumble a -> Tumble a)
-> (Tumble a -> Tumble a -> Tumble a)
-> (Tumble a -> Tumble a)
-> (Tumble a -> Tumble a)
-> (Tumble a -> Tumble a)
-> (Integer -> Tumble a)
-> Num (Tumble a)
forall a. Num a => Integer -> Tumble a
forall a. Num a => Tumble a -> Tumble a
forall a. Num a => Tumble a -> Tumble a -> Tumble a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tumble a
$cfromInteger :: forall a. Num a => Integer -> Tumble a
signum :: Tumble a -> Tumble a
$csignum :: forall a. Num a => Tumble a -> Tumble a
abs :: Tumble a -> Tumble a
$cabs :: forall a. Num a => Tumble a -> Tumble a
negate :: Tumble a -> Tumble a
$cnegate :: forall a. Num a => Tumble a -> Tumble a
* :: Tumble a -> Tumble a -> Tumble a
$c* :: forall a. Num a => Tumble a -> Tumble a -> Tumble a
- :: Tumble a -> Tumble a -> Tumble a
$c- :: forall a. Num a => Tumble a -> Tumble a -> Tumble a
+ :: Tumble a -> Tumble a -> Tumble a
$c+ :: forall a. Num a => Tumble a -> Tumble a -> Tumble a
Num, ReadPrec [Tumble a]
ReadPrec (Tumble a)
Int -> ReadS (Tumble a)
ReadS [Tumble a]
(Int -> ReadS (Tumble a))
-> ReadS [Tumble a]
-> ReadPrec (Tumble a)
-> ReadPrec [Tumble a]
-> Read (Tumble a)
forall a. Read a => ReadPrec [Tumble a]
forall a. Read a => ReadPrec (Tumble a)
forall a. Read a => Int -> ReadS (Tumble a)
forall a. Read a => ReadS [Tumble a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tumble a]
$creadListPrec :: forall a. Read a => ReadPrec [Tumble a]
readPrec :: ReadPrec (Tumble a)
$creadPrec :: forall a. Read a => ReadPrec (Tumble a)
readList :: ReadS [Tumble a]
$creadList :: forall a. Read a => ReadS [Tumble a]
readsPrec :: Int -> ReadS (Tumble a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tumble a)
Read, Int -> Tumble a -> ShowS
[Tumble a] -> ShowS
Tumble a -> String
(Int -> Tumble a -> ShowS)
-> (Tumble a -> String) -> ([Tumble a] -> ShowS) -> Show (Tumble a)
forall a. Show a => Int -> Tumble a -> ShowS
forall a. Show a => [Tumble a] -> ShowS
forall a. Show a => Tumble a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tumble a] -> ShowS
$cshowList :: forall a. Show a => [Tumble a] -> ShowS
show :: Tumble a -> String
$cshow :: forall a. Show a => Tumble a -> String
showsPrec :: Int -> Tumble a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tumble a -> ShowS
Show, Functor Tumble
Foldable Tumble
(Functor Tumble, Foldable Tumble) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Tumble a -> f (Tumble b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Tumble (f a) -> f (Tumble a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tumble a -> m (Tumble b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Tumble (m a) -> m (Tumble a))
-> Traversable Tumble
(a -> f b) -> Tumble a -> f (Tumble b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Tumble (m a) -> m (Tumble a)
forall (f :: * -> *) a.
Applicative f =>
Tumble (f a) -> f (Tumble a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tumble a -> m (Tumble b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tumble a -> f (Tumble b)
sequence :: Tumble (m a) -> m (Tumble a)
$csequence :: forall (m :: * -> *) a. Monad m => Tumble (m a) -> m (Tumble a)
mapM :: (a -> m b) -> Tumble a -> m (Tumble b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tumble a -> m (Tumble b)
sequenceA :: Tumble (f a) -> f (Tumble a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tumble (f a) -> f (Tumble a)
traverse :: (a -> f b) -> Tumble a -> f (Tumble b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tumble a -> f (Tumble b)
$cp2Traversable :: Foldable Tumble
$cp1Traversable :: Functor Tumble
Traversable)

-- $
--
-- Idempotence:
--
-- prop> x /\ x == (x :: Tumble Bool)
--
-- Associativity:
--
-- prop> a /\ (b /\ c) == (a /\ b) /\ (c :: Tumble Bool)
--
-- Commutativity:
--
-- prop> a /\ b == b /\ (a :: Tumble Bool)
--
-- Identity:
--
-- prop> upperBound /\ a == (a :: Tumble Bool)
--
-- Absorption:
--
-- prop> lowerBound /\ a == (lowerBound :: Tumble Bool)
instance Join a => Meet (Tumble a) where
  Tumble a :: a
a /\ :: Tumble a -> Tumble a -> Tumble a
/\ Tumble b :: a
b = a -> Tumble a
forall a. a -> Tumble a
Tumble (a
a a -> a -> a
forall s. Join s => s -> s -> s
\/ a
b)

-- $
--
-- Idempotence:
--
-- prop> x \/ x == (x :: Tumble Bool)
--
-- Associativity:
--
-- prop> a \/ (b \/ c) == (a \/ b) \/ (c :: Tumble Bool)
--
-- Commutativity:
--
-- prop> a \/ b == b \/ (a :: Tumble Bool)
--
-- Identity:
--
-- prop> lowerBound \/ a == (a :: Tumble Bool)
--
-- Absorption:
--
-- prop> upperBound \/ a == (upperBound :: Tumble Bool)
instance Meet a => Join (Tumble a) where
  Tumble a :: a
a \/ :: Tumble a -> Tumble a -> Tumble a
\/ Tumble b :: a
b = a -> Tumble a
forall a. a -> Tumble a
Tumble (a
a a -> a -> a
forall s. Meet s => s -> s -> s
/\ a
b)

instance Bounded a => Bounded (Tumble a) where
  minBound :: Tumble a
minBound = a -> Tumble a
forall a. a -> Tumble a
Tumble a
forall a. Bounded a => a
maxBound
  maxBound :: Tumble a
maxBound = a -> Tumble a
forall a. a -> Tumble a
Tumble a
forall a. Bounded a => a
minBound

-- $
--
-- Bounded:
--
-- prop> upperBound == (maxBound :: Tumble Bool)
--
-- Identity of '/\':
--
-- prop> upperBound /\ a == (a :: Tumble Bool)
--
-- Absorbing element of '\/':
--
-- prop> upperBound \/ a == (upperBound :: Tumble Bool)
--
-- Ord:
--
-- prop> compare upperBound (a :: Tumble Bool) /= LT
instance Lower a => Upper (Tumble a) where
  upperBound :: Tumble a
upperBound = a -> Tumble a
forall a. a -> Tumble a
Tumble a
forall s. Lower s => s
lowerBound

-- $
--
-- Bounded:
--
-- prop> lowerBound == (minBound :: Tumble Bool)
--
-- Identity of '\/':
--
-- prop> lowerBound \/ a == (a :: Tumble Bool)
--
-- Absorbing element of '/\':
--
-- prop> lowerBound /\ a == (lowerBound :: Tumble Bool)
--
-- Ord:
--
-- prop> compare lowerBound (a :: Tumble Bool) /= GT
instance Upper a => Lower (Tumble a) where
  lowerBound :: Tumble a
lowerBound = a -> Tumble a
forall a. a -> Tumble a
Tumble a
forall s. Upper s => s
upperBound


instance Ord a => Ord (Tumble a) where
  compare :: Tumble a -> Tumble a -> Ordering
compare (Tumble a :: a
a) (Tumble b :: a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
b a
a


-- $setup
-- >>> import Test.QuickCheck
-- >>> instance Arbitrary a => Arbitrary (Tumble a) where arbitrary = Tumble <$> arbitrary ; shrink (Tumble a) = Tumble <$> shrink a