{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE Safe               #-}
{-# LANGUAGE TypeOperators      #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Algebra.Lattice.Op
-- Copyright   :  (C) 2010-2015 Maximilian Bolingbroke, 2015-2019 Oleg Grenrus
-- License     :  BSD-3-Clause (see the file LICENSE)
--
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
----------------------------------------------------------------------------
module Algebra.Lattice.Op (
    Op(..)
  ) where

import Prelude ()
import Prelude.Compat

import Algebra.Lattice
import Algebra.PartialOrd

import Control.DeepSeq     (NFData (..))
import Control.Monad       (ap)
import Data.Data           (Data, Typeable)
import Data.Hashable       (Hashable (..))
import Data.Universe.Class (Finite (..), Universe (..))
import GHC.Generics        (Generic, Generic1)

import qualified Test.QuickCheck as QC

--
-- Op
--

-- | The opposite lattice of a given lattice.  That is, switch
-- meets and joins.
newtype Op a = Op { forall a. Op a -> a
getOp :: a }
  deriving ( Op a -> Op a -> Bool
forall a. Eq a => Op a -> Op a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op a -> Op a -> Bool
$c/= :: forall a. Eq a => Op a -> Op a -> Bool
== :: Op a -> Op a -> Bool
$c== :: forall a. Eq a => Op a -> Op a -> Bool
Eq, Int -> Op a -> ShowS
forall a. Show a => Int -> Op a -> ShowS
forall a. Show a => [Op a] -> ShowS
forall a. Show a => Op a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op a] -> ShowS
$cshowList :: forall a. Show a => [Op a] -> ShowS
show :: Op a -> String
$cshow :: forall a. Show a => Op a -> String
showsPrec :: Int -> Op a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Op a -> ShowS
Show, ReadPrec [Op a]
ReadPrec (Op a)
ReadS [Op a]
forall a. Read a => ReadPrec [Op a]
forall a. Read a => ReadPrec (Op a)
forall a. Read a => Int -> ReadS (Op a)
forall a. Read a => ReadS [Op a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Op a]
$creadListPrec :: forall a. Read a => ReadPrec [Op a]
readPrec :: ReadPrec (Op a)
$creadPrec :: forall a. Read a => ReadPrec (Op a)
readList :: ReadS [Op a]
$creadList :: forall a. Read a => ReadS [Op a]
readsPrec :: Int -> ReadS (Op a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Op a)
Read, Op a -> DataType
Op a -> Constr
forall {a}. Data a => Typeable (Op a)
forall a. Data a => Op a -> DataType
forall a. Data a => Op a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> Op a -> Op a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Op a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Op a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op a -> c (Op a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Op a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op a -> c (Op a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Op a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Op a -> m (Op a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Op a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Op a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Op a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op a -> r
gmapT :: (forall b. Data b => b -> b) -> Op a -> Op a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Op a -> Op a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Op a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Op a))
dataTypeOf :: Op a -> DataType
$cdataTypeOf :: forall a. Data a => Op a -> DataType
toConstr :: Op a -> Constr
$ctoConstr :: forall a. Data a => Op a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op a -> c (Op a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op a -> c (Op a)
Data, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Op a) x -> Op a
forall a x. Op a -> Rep (Op a) x
$cto :: forall a x. Rep (Op a) x -> Op a
$cfrom :: forall a x. Op a -> Rep (Op a) x
Generic, forall a b. a -> Op b -> Op a
forall a b. (a -> b) -> Op a -> Op b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Op b -> Op a
$c<$ :: forall a b. a -> Op b -> Op a
fmap :: forall a b. (a -> b) -> Op a -> Op b
$cfmap :: forall a b. (a -> b) -> Op a -> Op b
Functor, forall a. Eq a => a -> Op a -> Bool
forall a. Num a => Op a -> a
forall a. Ord a => Op a -> a
forall m. Monoid m => Op m -> m
forall a. Op a -> Bool
forall a. Op a -> Int
forall a. Op a -> [a]
forall a. (a -> a -> a) -> Op a -> a
forall m a. Monoid m => (a -> m) -> Op a -> m
forall b a. (b -> a -> b) -> b -> Op a -> b
forall a b. (a -> b -> b) -> b -> Op 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 :: forall a. Num a => Op a -> a
$cproduct :: forall a. Num a => Op a -> a
sum :: forall a. Num a => Op a -> a
$csum :: forall a. Num a => Op a -> a
minimum :: forall a. Ord a => Op a -> a
$cminimum :: forall a. Ord a => Op a -> a
maximum :: forall a. Ord a => Op a -> a
$cmaximum :: forall a. Ord a => Op a -> a
elem :: forall a. Eq a => a -> Op a -> Bool
$celem :: forall a. Eq a => a -> Op a -> Bool
length :: forall a. Op a -> Int
$clength :: forall a. Op a -> Int
null :: forall a. Op a -> Bool
$cnull :: forall a. Op a -> Bool
toList :: forall a. Op a -> [a]
$ctoList :: forall a. Op a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Op a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Op a -> a
foldr1 :: forall a. (a -> a -> a) -> Op a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Op a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Op a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Op a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Op a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Op a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Op a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Op a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Op a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Op a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Op a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Op a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Op a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Op a -> m
fold :: forall m. Monoid m => Op m -> m
$cfold :: forall m. Monoid m => Op m -> m
Foldable, Functor Op
Foldable Op
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 => Op (m a) -> m (Op a)
forall (f :: * -> *) a. Applicative f => Op (f a) -> f (Op a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Op a -> m (Op b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Op a -> f (Op b)
sequence :: forall (m :: * -> *) a. Monad m => Op (m a) -> m (Op a)
$csequence :: forall (m :: * -> *) a. Monad m => Op (m a) -> m (Op a)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Op a -> m (Op b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Op a -> m (Op b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Op (f a) -> f (Op a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Op (f a) -> f (Op a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Op a -> f (Op b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Op a -> f (Op b)
Traversable
           , forall a. Rep1 Op a -> Op a
forall a. Op a -> Rep1 Op a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Op a -> Op a
$cfrom1 :: forall a. Op a -> Rep1 Op a
Generic1
           )

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

instance Applicative Op where
  pure :: forall a. a -> Op a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b. Op (a -> b) -> Op a -> Op b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Op where
  return :: forall a. a -> Op a
return      = forall a. a -> Op a
Op
  Op a
x >>= :: forall a b. Op a -> (a -> Op b) -> Op b
>>= a -> Op b
f  = a -> Op b
f a
x

instance NFData a => NFData (Op a) where
  rnf :: Op a -> ()
rnf (Op a
a) = forall a. NFData a => a -> ()
rnf a
a

instance Hashable a => Hashable (Op a)

instance Lattice a => Lattice (Op a) where
  Op a
x \/ :: Op a -> Op a -> Op a
\/ Op a
y = forall a. a -> Op a
Op (a
x forall a. Lattice a => a -> a -> a
/\ a
y)
  Op a
x /\ :: Op a -> Op a -> Op a
/\ Op a
y = forall a. a -> Op a
Op (a
x forall a. Lattice a => a -> a -> a
\/ a
y)

instance BoundedMeetSemiLattice a => BoundedJoinSemiLattice (Op a) where
  bottom :: Op a
bottom = forall a. a -> Op a
Op forall a. BoundedMeetSemiLattice a => a
top

instance BoundedJoinSemiLattice a => BoundedMeetSemiLattice (Op a) where
  top :: Op a
top = forall a. a -> Op a
Op forall a. BoundedJoinSemiLattice a => a
bottom

instance PartialOrd a => PartialOrd (Op a) where
    Op a
a leq :: Op a -> Op a -> Bool
`leq` Op a
b = a
b forall a. PartialOrd a => a -> a -> Bool
`leq` a
a -- Note swap.
    comparable :: Op a -> Op a -> Bool
comparable (Op a
a) (Op a
b) = forall a. PartialOrd a => a -> a -> Bool
comparable a
a a
b

instance Universe a => Universe (Op a) where
    universe :: [Op a]
universe = forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Op a
Op forall a. Universe a => [a]
universe
instance Finite a => Finite (Op a) where
    universeF :: [Op a]
universeF = forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Op a
Op forall a. Finite a => [a]
universeF

instance QC.Arbitrary a => QC.Arbitrary (Op a) where
    arbitrary :: Gen (Op a)
arbitrary = forall a. a -> Op a
Op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
    shrink :: Op a -> [Op a]
shrink    = forall a b. Arbitrary a => (a -> b) -> (b -> a) -> b -> [b]
QC.shrinkMap forall a. Op a -> a
getOp forall a. a -> Op a
Op

instance QC.CoArbitrary a => QC.CoArbitrary (Op a) where
    coarbitrary :: forall b. Op a -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Op a -> a
getOp

instance QC.Function a => QC.Function (Op a) where
    function :: forall b. (Op a -> b) -> Op a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap forall a. Op a -> a
getOp forall a. a -> Op a
Op