{-# LANGUAGE TemplateHaskell #-}

-- | Sets of @Maybe a@ values.

module SetMaybe where

import qualified Data.List as List
import Data.Set (Set)
import qualified Data.Set as Set

-- uses microlens-platform
import Lens.Micro.TH (makeLenses)

import DebugPrint

-- | A set of @Maybe t@ is stored as a set of @t@
--   plus a flag wether 'Nothing' is in the set.

data SetMaybe t = SetMaybe { forall t. SetMaybe t -> Set t
_smSet :: Set t, forall t. SetMaybe t -> Bool
_smNothing :: Bool }
  deriving (SetMaybe t -> SetMaybe t -> Bool
(SetMaybe t -> SetMaybe t -> Bool)
-> (SetMaybe t -> SetMaybe t -> Bool) -> Eq (SetMaybe t)
forall t. Eq t => SetMaybe t -> SetMaybe t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => SetMaybe t -> SetMaybe t -> Bool
== :: SetMaybe t -> SetMaybe t -> Bool
$c/= :: forall t. Eq t => SetMaybe t -> SetMaybe t -> Bool
/= :: SetMaybe t -> SetMaybe t -> Bool
Eq, Eq (SetMaybe t)
Eq (SetMaybe t) =>
(SetMaybe t -> SetMaybe t -> Ordering)
-> (SetMaybe t -> SetMaybe t -> Bool)
-> (SetMaybe t -> SetMaybe t -> Bool)
-> (SetMaybe t -> SetMaybe t -> Bool)
-> (SetMaybe t -> SetMaybe t -> Bool)
-> (SetMaybe t -> SetMaybe t -> SetMaybe t)
-> (SetMaybe t -> SetMaybe t -> SetMaybe t)
-> Ord (SetMaybe t)
SetMaybe t -> SetMaybe t -> Bool
SetMaybe t -> SetMaybe t -> Ordering
SetMaybe t -> SetMaybe t -> SetMaybe t
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 t. Ord t => Eq (SetMaybe t)
forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
forall t. Ord t => SetMaybe t -> SetMaybe t -> Ordering
forall t. Ord t => SetMaybe t -> SetMaybe t -> SetMaybe t
$ccompare :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Ordering
compare :: SetMaybe t -> SetMaybe t -> Ordering
$c< :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
< :: SetMaybe t -> SetMaybe t -> Bool
$c<= :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
<= :: SetMaybe t -> SetMaybe t -> Bool
$c> :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
> :: SetMaybe t -> SetMaybe t -> Bool
$c>= :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
>= :: SetMaybe t -> SetMaybe t -> Bool
$cmax :: forall t. Ord t => SetMaybe t -> SetMaybe t -> SetMaybe t
max :: SetMaybe t -> SetMaybe t -> SetMaybe t
$cmin :: forall t. Ord t => SetMaybe t -> SetMaybe t -> SetMaybe t
min :: SetMaybe t -> SetMaybe t -> SetMaybe t
Ord, Int -> SetMaybe t -> ShowS
[SetMaybe t] -> ShowS
SetMaybe t -> String
(Int -> SetMaybe t -> ShowS)
-> (SetMaybe t -> String)
-> ([SetMaybe t] -> ShowS)
-> Show (SetMaybe t)
forall t. Show t => Int -> SetMaybe t -> ShowS
forall t. Show t => [SetMaybe t] -> ShowS
forall t. Show t => SetMaybe t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> SetMaybe t -> ShowS
showsPrec :: Int -> SetMaybe t -> ShowS
$cshow :: forall t. Show t => SetMaybe t -> String
show :: SetMaybe t -> String
$cshowList :: forall t. Show t => [SetMaybe t] -> ShowS
showList :: [SetMaybe t] -> ShowS
Show, ReadPrec [SetMaybe t]
ReadPrec (SetMaybe t)
Int -> ReadS (SetMaybe t)
ReadS [SetMaybe t]
(Int -> ReadS (SetMaybe t))
-> ReadS [SetMaybe t]
-> ReadPrec (SetMaybe t)
-> ReadPrec [SetMaybe t]
-> Read (SetMaybe t)
forall t. (Read t, Ord t) => ReadPrec [SetMaybe t]
forall t. (Read t, Ord t) => ReadPrec (SetMaybe t)
forall t. (Read t, Ord t) => Int -> ReadS (SetMaybe t)
forall t. (Read t, Ord t) => ReadS [SetMaybe t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. (Read t, Ord t) => Int -> ReadS (SetMaybe t)
readsPrec :: Int -> ReadS (SetMaybe t)
$creadList :: forall t. (Read t, Ord t) => ReadS [SetMaybe t]
readList :: ReadS [SetMaybe t]
$creadPrec :: forall t. (Read t, Ord t) => ReadPrec (SetMaybe t)
readPrec :: ReadPrec (SetMaybe t)
$creadListPrec :: forall t. (Read t, Ord t) => ReadPrec [SetMaybe t]
readListPrec :: ReadPrec [SetMaybe t]
Read)

makeLenses ''SetMaybe

empty :: SetMaybe t
empty :: forall t. SetMaybe t
empty  = Set t -> Bool -> SetMaybe t
forall t. Set t -> Bool -> SetMaybe t
SetMaybe Set t
forall a. Set a
Set.empty Bool
False

setOfNothing :: SetMaybe t
setOfNothing :: forall t. SetMaybe t
setOfNothing = Set t -> Bool -> SetMaybe t
forall t. Set t -> Bool -> SetMaybe t
SetMaybe Set t
forall a. Set a
Set.empty Bool
True

singleton :: Maybe t -> SetMaybe t
singleton :: forall t. Maybe t -> SetMaybe t
singleton Maybe t
Nothing = SetMaybe t
forall t. SetMaybe t
setOfNothing
singleton (Just t
k) = Set t -> Bool -> SetMaybe t
forall t. Set t -> Bool -> SetMaybe t
SetMaybe (t -> Set t
forall a. a -> Set a
Set.singleton t
k) Bool
False

-- | Union.

union :: Ord t => SetMaybe t -> SetMaybe t -> SetMaybe t
union :: forall t. Ord t => SetMaybe t -> SetMaybe t -> SetMaybe t
union (SetMaybe Set t
s Bool
b) (SetMaybe Set t
s' Bool
b') = Set t -> Bool -> SetMaybe t
forall t. Set t -> Bool -> SetMaybe t
SetMaybe (Set t -> Set t -> Set t
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set t
s Set t
s') (Bool
b Bool -> Bool -> Bool
|| Bool
b')

-- | Query subset.

isSubsetOf :: Ord t => SetMaybe t -> SetMaybe t -> Bool
isSubsetOf :: forall t. Ord t => SetMaybe t -> SetMaybe t -> Bool
isSubsetOf (SetMaybe Set t
s Bool
b) (SetMaybe Set t
s' Bool
b') = (Bool
b' Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
b) Bool -> Bool -> Bool
&& Set t -> Set t -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set t
s Set t
s'

-- | Query membership.

member :: Ord t => Maybe t -> SetMaybe t -> Bool
member :: forall t. Ord t => Maybe t -> SetMaybe t -> Bool
member Maybe t
Nothing  (SetMaybe Set t
_  Bool
b) = Bool
b
member (Just t
k) (SetMaybe Set t
ks Bool
_) = t -> Set t -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member t
k Set t
ks

-- * Printing

instance (DebugPrint t) => DebugPrint (SetMaybe t) where
  debugPrint :: SetMaybe t -> String
debugPrint (SetMaybe Set t
s Bool
b) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"{" ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
set [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"}" ]
    where
    set :: [String]
set = String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
b then (String
"Nothing" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
forall a. DebugPrint a => a -> String
debugPrint ([t] -> [String]) -> [t] -> [String]
forall a b. (a -> b) -> a -> b
$ Set t -> [t]
forall a. Set a -> [a]
Set.toList Set t
s