Powerset.hs 2.13 KB
Newer Older
Sven Keidel's avatar
Sven Keidel committed
1 2 3 4 5
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveTraversable #-}
6
{-# LANGUAGE DeriveGeneric #-}
Sven Keidel's avatar
Sven Keidel committed
7 8
module Data.Powerset where

Jente Hidskes's avatar
Jente Hidskes committed
9
import           Prelude hiding ((.))
Sven Keidel's avatar
Sven Keidel committed
10 11 12 13

import           Control.Category
import           Control.Applicative
import           Control.Monad
14
import           Control.Monad.Deduplicate
Sven Keidel's avatar
Sven Keidel committed
15 16

import           Data.Sequence (Seq)
17 18
import           Data.Set (Set)
import           Data.Map (Map)
Sven Keidel's avatar
Sven Keidel committed
19 20 21 22 23 24
import           Data.Hashable
import           Data.HashSet (HashSet)
import qualified Data.HashSet as H
import           Data.Foldable (foldl',toList)
import           Data.List (intercalate)
import           Data.Order
25 26 27

import GHC.Generics (Generic)

28
newtype Pow a = Pow (Seq a) deriving (Functor, Applicative, Monad, Alternative, MonadPlus, Monoid, Foldable, Traversable, Generic)
Sven Keidel's avatar
Sven Keidel committed
29 30 31 32

instance (Eq a, Hashable a) => PreOrd (Pow a) where
  as  bs = all (`H.member` toHashSet as) (toHashSet bs)

33
instance (Eq a, Hashable a) => Eq (Pow a) where
Sven Keidel's avatar
Sven Keidel committed
34
  as == bs = toHashSet as == toHashSet bs
35

36
instance (Eq a, Hashable a) => Complete (Pow a) where
Sven Keidel's avatar
Sven Keidel committed
37 38 39 40 41
  as  bs = as `union` bs

instance Show a => Show (Pow a) where
  show (Pow a) = "{" ++ intercalate ", " (show <$> toList a) ++ "}"

Sven Keidel's avatar
Sven Keidel committed
42 43
instance (Eq a, Hashable a) => Hashable (Pow a) where
  hashWithSalt salt x = hashWithSalt salt (toHashSet x)
44

45 46 47 48 49 50
instance Hashable a => Hashable (Set a) where
  hashWithSalt salt seq = foldl hashWithSalt salt seq

instance (Hashable k,Hashable v) => Hashable (Map k v) where
  hashWithSalt salt seq = foldl hashWithSalt salt seq

51 52 53 54 55
empty :: Pow a
empty = mempty

singleton :: a -> Pow a
singleton = Pow . return
Sven Keidel's avatar
Sven Keidel committed
56

57
union :: Pow a -> Pow a -> Pow a
Sven Keidel's avatar
Sven Keidel committed
58 59
union = mappend

60
cartesian :: (Pow a, Pow b) -> Pow (a,b)
Sven Keidel's avatar
Sven Keidel committed
61 62 63 64 65
cartesian (as,bs) = do
  a <- as
  b <- bs
  return (a,b)

66
toHashSet :: (Hashable a, Eq a) => Pow a -> HashSet a
Sven Keidel's avatar
Sven Keidel committed
67 68 69 70 71 72 73
toHashSet = foldl' (flip H.insert) H.empty

fromFoldable :: (Foldable f, Monad t, Monoid (t a)) => f a -> t a
fromFoldable = foldMap return

size :: Foldable f => f a -> Int
size = length
74 75 76

instance MonadDeduplicate Pow where
  dedup = fromFoldable . toHashSet