{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Data.JoinSemilattice.Intersect where
import Control.Applicative (liftA2)
import Data.Coerce (coerce)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Hashable (Hashable)
import Data.Input.Config (Config (..), Input (..))
import Data.Kind (Type)
import Data.Set (Set)
import qualified Data.Set as Set
import Prelude hiding (filter, map, unzip)
newtype Intersect (x :: Type)
= Intersect { Intersect x -> HashSet x
toHashSet :: HashSet x }
deriving stock (Intersect x -> Intersect x -> Bool
(Intersect x -> Intersect x -> Bool)
-> (Intersect x -> Intersect x -> Bool) -> Eq (Intersect x)
forall x. Eq x => Intersect x -> Intersect x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Intersect x -> Intersect x -> Bool
$c/= :: forall x. Eq x => Intersect x -> Intersect x -> Bool
== :: Intersect x -> Intersect x -> Bool
$c== :: forall x. Eq x => Intersect x -> Intersect x -> Bool
Eq, Eq (Intersect x)
Eq (Intersect x)
-> (Intersect x -> Intersect x -> Ordering)
-> (Intersect x -> Intersect x -> Bool)
-> (Intersect x -> Intersect x -> Bool)
-> (Intersect x -> Intersect x -> Bool)
-> (Intersect x -> Intersect x -> Bool)
-> (Intersect x -> Intersect x -> Intersect x)
-> (Intersect x -> Intersect x -> Intersect x)
-> Ord (Intersect x)
Intersect x -> Intersect x -> Bool
Intersect x -> Intersect x -> Ordering
Intersect x -> Intersect x -> Intersect x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (Intersect x)
forall x. Ord x => Intersect x -> Intersect x -> Bool
forall x. Ord x => Intersect x -> Intersect x -> Ordering
forall x. Ord x => Intersect x -> Intersect x -> Intersect x
min :: Intersect x -> Intersect x -> Intersect x
$cmin :: forall x. Ord x => Intersect x -> Intersect x -> Intersect x
max :: Intersect x -> Intersect x -> Intersect x
$cmax :: forall x. Ord x => Intersect x -> Intersect x -> Intersect x
>= :: Intersect x -> Intersect x -> Bool
$c>= :: forall x. Ord x => Intersect x -> Intersect x -> Bool
> :: Intersect x -> Intersect x -> Bool
$c> :: forall x. Ord x => Intersect x -> Intersect x -> Bool
<= :: Intersect x -> Intersect x -> Bool
$c<= :: forall x. Ord x => Intersect x -> Intersect x -> Bool
< :: Intersect x -> Intersect x -> Bool
$c< :: forall x. Ord x => Intersect x -> Intersect x -> Bool
compare :: Intersect x -> Intersect x -> Ordering
$ccompare :: forall x. Ord x => Intersect x -> Intersect x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (Intersect x)
Ord, Int -> Intersect x -> ShowS
[Intersect x] -> ShowS
Intersect x -> String
(Int -> Intersect x -> ShowS)
-> (Intersect x -> String)
-> ([Intersect x] -> ShowS)
-> Show (Intersect x)
forall x. Show x => Int -> Intersect x -> ShowS
forall x. Show x => [Intersect x] -> ShowS
forall x. Show x => Intersect x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Intersect x] -> ShowS
$cshowList :: forall x. Show x => [Intersect x] -> ShowS
show :: Intersect x -> String
$cshow :: forall x. Show x => Intersect x -> String
showsPrec :: Int -> Intersect x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Intersect x -> ShowS
Show, Intersect a -> Bool
(a -> m) -> Intersect a -> m
(a -> b -> b) -> b -> Intersect a -> b
(forall m. Monoid m => Intersect m -> m)
-> (forall m a. Monoid m => (a -> m) -> Intersect a -> m)
-> (forall m a. Monoid m => (a -> m) -> Intersect a -> m)
-> (forall a b. (a -> b -> b) -> b -> Intersect a -> b)
-> (forall a b. (a -> b -> b) -> b -> Intersect a -> b)
-> (forall b a. (b -> a -> b) -> b -> Intersect a -> b)
-> (forall b a. (b -> a -> b) -> b -> Intersect a -> b)
-> (forall a. (a -> a -> a) -> Intersect a -> a)
-> (forall a. (a -> a -> a) -> Intersect a -> a)
-> (forall a. Intersect a -> [a])
-> (forall a. Intersect a -> Bool)
-> (forall a. Intersect a -> Int)
-> (forall a. Eq a => a -> Intersect a -> Bool)
-> (forall a. Ord a => Intersect a -> a)
-> (forall a. Ord a => Intersect a -> a)
-> (forall a. Num a => Intersect a -> a)
-> (forall a. Num a => Intersect a -> a)
-> Foldable Intersect
forall a. Eq a => a -> Intersect a -> Bool
forall a. Num a => Intersect a -> a
forall a. Ord a => Intersect a -> a
forall m. Monoid m => Intersect m -> m
forall a. Intersect a -> Bool
forall a. Intersect a -> Int
forall a. Intersect a -> [a]
forall a. (a -> a -> a) -> Intersect a -> a
forall m a. Monoid m => (a -> m) -> Intersect a -> m
forall b a. (b -> a -> b) -> b -> Intersect a -> b
forall a b. (a -> b -> b) -> b -> Intersect 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 :: Intersect a -> a
$cproduct :: forall a. Num a => Intersect a -> a
sum :: Intersect a -> a
$csum :: forall a. Num a => Intersect a -> a
minimum :: Intersect a -> a
$cminimum :: forall a. Ord a => Intersect a -> a
maximum :: Intersect a -> a
$cmaximum :: forall a. Ord a => Intersect a -> a
elem :: a -> Intersect a -> Bool
$celem :: forall a. Eq a => a -> Intersect a -> Bool
length :: Intersect a -> Int
$clength :: forall a. Intersect a -> Int
null :: Intersect a -> Bool
$cnull :: forall a. Intersect a -> Bool
toList :: Intersect a -> [a]
$ctoList :: forall a. Intersect a -> [a]
foldl1 :: (a -> a -> a) -> Intersect a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Intersect a -> a
foldr1 :: (a -> a -> a) -> Intersect a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Intersect a -> a
foldl' :: (b -> a -> b) -> b -> Intersect a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Intersect a -> b
foldl :: (b -> a -> b) -> b -> Intersect a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Intersect a -> b
foldr' :: (a -> b -> b) -> b -> Intersect a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Intersect a -> b
foldr :: (a -> b -> b) -> b -> Intersect a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Intersect a -> b
foldMap' :: (a -> m) -> Intersect a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Intersect a -> m
foldMap :: (a -> m) -> Intersect a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Intersect a -> m
fold :: Intersect m -> m
$cfold :: forall m. Monoid m => Intersect m -> m
Foldable)
deriving newtype (Int -> Intersect x -> Int
Intersect x -> Int
(Int -> Intersect x -> Int)
-> (Intersect x -> Int) -> Hashable (Intersect x)
forall x. Hashable x => Int -> Intersect x -> Int
forall x. Hashable x => Intersect x -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Intersect x -> Int
$chash :: forall x. Hashable x => Intersect x -> Int
hashWithSalt :: Int -> Intersect x -> Int
$chashWithSalt :: forall x. Hashable x => Int -> Intersect x -> Int
Hashable)
class (Bounded content, Enum content, Ord content, Hashable content)
=> Intersectable content
instance (Bounded content, Enum content, Ord content, Hashable content)
=> Intersectable content
instance (Eq content, Hashable content) => Semigroup (Intersect content) where
<> :: Intersect content -> Intersect content -> Intersect content
(<>) = (HashSet content -> HashSet content -> HashSet content)
-> Intersect content -> Intersect content -> Intersect content
coerce HashSet content -> HashSet content -> HashSet content
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.intersection
instance Intersectable content => Monoid (Intersect content) where
mempty :: Intersect content
mempty = [content] -> Intersect content
forall x. (Eq x, Hashable x) => [x] -> Intersect x
fromList [ content
forall a. Bounded a => a
minBound .. content
forall a. Bounded a => a
maxBound ]
lift2
:: ( Intersectable this
, Intersectable that
, Intersectable result
)
=> (this -> that -> result)
-> Intersect this
-> Intersect that
-> Intersect result
lift2 :: (this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
lift2 this -> that -> result
f Intersect this
these Intersect that
those = [result] -> Intersect result
forall x. (Eq x, Hashable x) => [x] -> Intersect x
fromList do
(this -> that -> result) -> [this] -> [that] -> [result]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 this -> that -> result
f (Intersect this -> [this]
forall x. (Bounded x, Enum x, Eq x) => Intersect x -> [x]
toList Intersect this
these) (Intersect that -> [that]
forall x. (Bounded x, Enum x, Eq x) => Intersect x -> [x]
toList Intersect that
those)
instance (Intersectable content, Num content)
=> Num (Intersect content) where
+ :: Intersect content -> Intersect content -> Intersect content
(+) = (content -> content -> content)
-> Intersect content -> Intersect content -> Intersect content
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
lift2 content -> content -> content
forall a. Num a => a -> a -> a
(+)
* :: Intersect content -> Intersect content -> Intersect content
(*) = (content -> content -> content)
-> Intersect content -> Intersect content -> Intersect content
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
lift2 content -> content -> content
forall a. Num a => a -> a -> a
(*)
(-) = (content -> content -> content)
-> Intersect content -> Intersect content -> Intersect content
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
lift2 (-)
abs :: Intersect content -> Intersect content
abs = (content -> content) -> Intersect content -> Intersect content
forall y x.
(Eq y, Hashable y) =>
(x -> y) -> Intersect x -> Intersect y
map content -> content
forall a. Num a => a -> a
abs
fromInteger :: Integer -> Intersect content
fromInteger = content -> Intersect content
forall x. Hashable x => x -> Intersect x
singleton (content -> Intersect content)
-> (Integer -> content) -> Integer -> Intersect content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> content
forall a. Num a => Integer -> a
fromInteger
negate :: Intersect content -> Intersect content
negate = (content -> content) -> Intersect content -> Intersect content
forall y x.
(Eq y, Hashable y) =>
(x -> y) -> Intersect x -> Intersect y
map content -> content
forall a. Num a => a -> a
negate
signum :: Intersect content -> Intersect content
signum = (content -> content) -> Intersect content -> Intersect content
forall y x.
(Eq y, Hashable y) =>
(x -> y) -> Intersect x -> Intersect y
map content -> content
forall a. Num a => a -> a
signum
instance (Intersectable x, Fractional x) => Fractional (Intersect x) where
/ :: Intersect x -> Intersect x -> Intersect x
(/) = (x -> x -> x) -> Intersect x -> Intersect x -> Intersect x
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
lift2 x -> x -> x
forall a. Fractional a => a -> a -> a
(/)
fromRational :: Rational -> Intersect x
fromRational = x -> Intersect x
forall x. Hashable x => x -> Intersect x
singleton (x -> Intersect x) -> (Rational -> x) -> Rational -> Intersect x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> x
forall a. Fractional a => Rational -> a
fromRational
recip :: Intersect x -> Intersect x
recip = (x -> x) -> Intersect x -> Intersect x
forall y x.
(Eq y, Hashable y) =>
(x -> y) -> Intersect x -> Intersect y
map x -> x
forall a. Fractional a => a -> a
recip
fromList :: (Eq x, Hashable x) => [ x ] -> Intersect x
fromList :: [x] -> Intersect x
fromList = ([x] -> HashSet x) -> [x] -> Intersect x
coerce [x] -> HashSet x
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
toList :: (Bounded x, Enum x, Eq x) => Intersect x -> [ x ]
toList :: Intersect x -> [x]
toList = (HashSet x -> [x]) -> Intersect x -> [x]
coerce HashSet x -> [x]
forall a. HashSet a -> [a]
HashSet.toList
decided :: (Applicative m, Intersectable x) => (x -> m ()) -> Intersect x -> m ()
decided :: (x -> m ()) -> Intersect x -> m ()
decided x -> m ()
f = \case
(Intersect x -> [x]
forall x. (Bounded x, Enum x, Eq x) => Intersect x -> [x]
toList -> [ x
x ]) -> x -> m ()
f x
x
Intersect x
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
delete :: Intersectable x => x -> Intersect x -> Intersect x
delete :: x -> Intersect x -> Intersect x
delete = (x -> HashSet x -> HashSet x) -> x -> Intersect x -> Intersect x
coerce x -> HashSet x -> HashSet x
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete
except :: Intersectable x => Intersect x -> Intersect x
except :: Intersect x -> Intersect x
except = (x -> Intersect x -> Intersect x)
-> Intersect x -> Intersect x -> Intersect x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> Intersect x -> Intersect x
forall x. Intersectable x => x -> Intersect x -> Intersect x
delete Intersect x
forall a. Monoid a => a
mempty
filter :: (x -> Bool) -> Intersect x -> Intersect x
filter :: (x -> Bool) -> Intersect x -> Intersect x
filter = ((x -> Bool) -> HashSet x -> HashSet x)
-> (x -> Bool) -> Intersect x -> Intersect x
coerce (x -> Bool) -> HashSet x -> HashSet x
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter
fromSet :: (Eq x, Hashable x) => Set x -> Intersect x
fromSet :: Set x -> Intersect x
fromSet = HashSet x -> Intersect x
forall x. HashSet x -> Intersect x
Intersect (HashSet x -> Intersect x)
-> (Set x -> HashSet x) -> Set x -> Intersect x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> HashSet x -> HashSet x) -> HashSet x -> Set x -> HashSet x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> HashSet x -> HashSet x
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HashSet x
forall a. Monoid a => a
mempty
map :: (Eq y, Hashable y) => (x -> y) -> Intersect x -> Intersect y
map :: (x -> y) -> Intersect x -> Intersect y
map = ((x -> y) -> HashSet x -> HashSet y)
-> (x -> y) -> Intersect x -> Intersect y
coerce (x -> y) -> HashSet x -> HashSet y
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map
powerSet :: (Bounded x, Enum x, Hashable x, Ord x) => Intersect x -> Intersect (Intersect x)
powerSet :: Intersect x -> Intersect (Intersect x)
powerSet = Set (Intersect x) -> Intersect (Intersect x)
forall x. (Eq x, Hashable x) => Set x -> Intersect x
fromSet (Set (Intersect x) -> Intersect (Intersect x))
-> (Intersect x -> Set (Intersect x))
-> Intersect x
-> Intersect (Intersect x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set x -> Intersect x) -> Set (Set x) -> Set (Intersect x)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Set x -> Intersect x
forall x. (Eq x, Hashable x) => Set x -> Intersect x
fromSet (Set (Set x) -> Set (Intersect x))
-> (Intersect x -> Set (Set x)) -> Intersect x -> Set (Intersect x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set x -> Set (Set x)
forall a. Set a -> Set (Set a)
Set.powerSet (Set x -> Set (Set x))
-> (Intersect x -> Set x) -> Intersect x -> Set (Set x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Intersect x -> Set x
forall x. Ord x => Intersect x -> Set x
toSet
singleton :: Hashable x => x -> Intersect x
singleton :: x -> Intersect x
singleton = (x -> HashSet x) -> x -> Intersect x
coerce x -> HashSet x
forall a. Hashable a => a -> HashSet a
HashSet.singleton
size :: Intersectable x => Intersect x -> Int
size :: Intersect x -> Int
size = (HashSet x -> Int) -> Intersect x -> Int
coerce HashSet x -> Int
forall a. HashSet a -> Int
HashSet.size
toSet :: Ord x => Intersect x -> Set x
toSet :: Intersect x -> Set x
toSet = (x -> Set x -> Set x) -> Set x -> Intersect x -> Set x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> Set x -> Set x
forall a. Ord a => a -> Set a -> Set a
Set.insert Set x
forall a. Monoid a => a
mempty
union :: Intersectable x => Intersect x -> Intersect x -> Intersect x
union :: Intersect x -> Intersect x -> Intersect x
union = (HashSet x -> HashSet x -> HashSet x)
-> Intersect x -> Intersect x -> Intersect x
coerce (Semigroup (HashSet x) => HashSet x -> HashSet x -> HashSet x
forall a. Semigroup a => a -> a -> a
(<>) @(HashSet _))
instance Intersectable x => Input (Intersect x) where
type Raw (Intersect x) = x
from :: Int -> [Raw (Intersect x)] -> Config m (Intersect x)
from Int
count = [Intersect x] -> Config m (Intersect x)
forall (m :: * -> *) x.
(Applicative m, Intersectable x) =>
[Intersect x] -> Config m (Intersect x)
using ([Intersect x] -> Config m (Intersect x))
-> ([x] -> [Intersect x]) -> [x] -> Config m (Intersect x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Intersect x -> [Intersect x]
forall a. Int -> a -> [a]
replicate Int
count (Intersect x -> [Intersect x])
-> ([x] -> Intersect x) -> [x] -> [Intersect x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> Intersect x
forall x. (Eq x, Hashable x) => [x] -> Intersect x
fromList
using :: (Applicative m, Intersectable x) => [ Intersect x ] -> Config m (Intersect x)
using :: [Intersect x] -> Config m (Intersect x)
using [Intersect x]
xs = [Intersect x]
-> (Intersect x -> m [Intersect x]) -> Config m (Intersect x)
forall (m :: * -> *) x. [x] -> (x -> m [x]) -> Config m x
Config [Intersect x]
xs ([Intersect x] -> m [Intersect x]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Intersect x] -> m [Intersect x])
-> (Intersect x -> [Intersect x]) -> Intersect x -> m [Intersect x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Intersect x) -> [x] -> [Intersect x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Intersect x
forall x. Hashable x => x -> Intersect x
singleton ([x] -> [Intersect x])
-> (Intersect x -> [x]) -> Intersect x -> [Intersect x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Intersect x -> [x]
forall x. (Bounded x, Enum x, Eq x) => Intersect x -> [x]
toList)