{- |
  Module        : Text.Tokenizer.BlackWhiteSet
  Copyright     : (c) Lev Dvorkin, 2022
  License       : MIT
  Maintainer    : lev_135@mail.ru
  Stability     : Experimental

  This module contains auxillary set structure to store
  effectively small sets of symbols and complementary to them
-}
module Text.Tokenizer.BlackWhiteSet (
    BlackWhiteSet (..),
    -- ** Some simple utilities to work with BlackWhiteSet

    singleton, intersection, isEmpty, member
  ) where

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

-- | Select some "white set" of available elements or "black set" of

-- forbidden ones

data BlackWhiteSet c = BlackSet (Set c) | WhiteSet (Set c)
  deriving (BlackWhiteSet c -> BlackWhiteSet c -> Bool
(BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> Eq (BlackWhiteSet c)
forall c. Eq c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c/= :: forall c. Eq c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
== :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c== :: forall c. Eq c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
Eq, Eq (BlackWhiteSet c)
Eq (BlackWhiteSet c)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Ordering)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> (BlackWhiteSet c -> BlackWhiteSet c -> Bool)
-> (BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c)
-> (BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c)
-> Ord (BlackWhiteSet c)
BlackWhiteSet c -> BlackWhiteSet c -> Bool
BlackWhiteSet c -> BlackWhiteSet c -> Ordering
BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
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 c. Ord c => Eq (BlackWhiteSet c)
forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Ordering
forall c.
Ord c =>
BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
min :: BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
$cmin :: forall c.
Ord c =>
BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
max :: BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
$cmax :: forall c.
Ord c =>
BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
>= :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c>= :: forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
> :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c> :: forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
<= :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c<= :: forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
< :: BlackWhiteSet c -> BlackWhiteSet c -> Bool
$c< :: forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Bool
compare :: BlackWhiteSet c -> BlackWhiteSet c -> Ordering
$ccompare :: forall c. Ord c => BlackWhiteSet c -> BlackWhiteSet c -> Ordering
$cp1Ord :: forall c. Ord c => Eq (BlackWhiteSet c)
Ord, Int -> BlackWhiteSet c -> ShowS
[BlackWhiteSet c] -> ShowS
BlackWhiteSet c -> String
(Int -> BlackWhiteSet c -> ShowS)
-> (BlackWhiteSet c -> String)
-> ([BlackWhiteSet c] -> ShowS)
-> Show (BlackWhiteSet c)
forall c. Show c => Int -> BlackWhiteSet c -> ShowS
forall c. Show c => [BlackWhiteSet c] -> ShowS
forall c. Show c => BlackWhiteSet c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlackWhiteSet c] -> ShowS
$cshowList :: forall c. Show c => [BlackWhiteSet c] -> ShowS
show :: BlackWhiteSet c -> String
$cshow :: forall c. Show c => BlackWhiteSet c -> String
showsPrec :: Int -> BlackWhiteSet c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> BlackWhiteSet c -> ShowS
Show)

-- | Make a 'BlackWhiteSet' containing only one symbol

singleton :: c -> BlackWhiteSet c
singleton :: c -> BlackWhiteSet c
singleton = Set c -> BlackWhiteSet c
forall c. Set c -> BlackWhiteSet c
WhiteSet (Set c -> BlackWhiteSet c) -> (c -> Set c) -> c -> BlackWhiteSet c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Set c
forall a. a -> Set a
S.singleton

-- | Intersect two 'BlackWhiteSet's.

intersection :: Ord c => BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
intersection :: BlackWhiteSet c -> BlackWhiteSet c -> BlackWhiteSet c
intersection (BlackSet Set c
b) (BlackSet Set c
b') = Set c -> BlackWhiteSet c
forall c. Set c -> BlackWhiteSet c
BlackSet (Set c -> Set c -> Set c
forall a. Ord a => Set a -> Set a -> Set a
S.union Set c
b Set c
b')
intersection (BlackSet Set c
b) (WhiteSet Set c
w) = Set c -> BlackWhiteSet c
forall c. Set c -> BlackWhiteSet c
WhiteSet (Set c -> Set c -> Set c
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set c
w Set c
b)
intersection (WhiteSet Set c
w) (BlackSet Set c
b) = Set c -> BlackWhiteSet c
forall c. Set c -> BlackWhiteSet c
WhiteSet (Set c -> Set c -> Set c
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set c
w Set c
b)
intersection (WhiteSet Set c
w) (WhiteSet Set c
w') = Set c -> BlackWhiteSet c
forall c. Set c -> BlackWhiteSet c
WhiteSet (Set c -> Set c -> Set c
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set c
w Set c
w')

-- | Check if 'BlackWhiteSet' is empty

--

-- NB! number of all elements assumed to be too large, so 'BlackSet' is never

--     supposed to be empty

isEmpty :: BlackWhiteSet c -> Bool
isEmpty :: BlackWhiteSet c -> Bool
isEmpty (WhiteSet Set c
w) = Set c -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set c
w
isEmpty BlackWhiteSet c
_ = Bool
False

-- | Check if symbol is a member of a 'BlackWhiteSet'

--

-- >>> member 'a' (WhiteSet (S.fromList ['a', 'b']))

-- True

--

-- >>> member 'a' (BlackSet (S.fromList ['a', 'b']))

-- False

member :: Ord c => c -> BlackWhiteSet c -> Bool
member :: c -> BlackWhiteSet c -> Bool
member c
c (BlackSet Set c
s) = c -> Set c -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember c
c Set c
s
member c
c (WhiteSet Set c
s) = c -> Set c -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member c
c Set c
s