module Data.Set.CharSet
( CharSet
, emptyCS
, allCS
, singleCS
, stringCS
, rangeCS
, nullCS
, fullCS
, unionCS
, diffCS
, intersectCS
, exorCS
, compCS
, elemCS
, toListCS
)
where
type CharSet = [(Char, Char)]
emptyCS :: CharSet
emptyCS = []
allCS :: CharSet
allCS = [(minBound, maxBound)]
singleCS :: Char -> CharSet
singleCS c = [(c,c)]
stringCS :: String -> CharSet
stringCS = foldr (unionCS . singleCS) emptyCS
rangeCS :: Char -> Char -> CharSet
rangeCS l u
| l <= u = [(l,u)]
| otherwise = emptyCS
nullCS :: CharSet -> Bool
nullCS = null
fullCS :: CharSet -> Bool
fullCS [(lb, ub)]
= lb == minBound
&&
ub == maxBound
fullCS _ = False
elemCS :: Char -> CharSet -> Bool
elemCS i = foldr (\ (lb, ub) b -> i >= lb && (i <= ub || b)) False
toListCS :: CharSet -> [Char]
toListCS = concatMap (\ (lb, ub) -> [lb..ub])
unionCS :: CharSet -> CharSet -> CharSet
unionCS [] s2 = s2
unionCS s1 [] = s1
unionCS s1@((l1,u1):s1') s2@((l2,u2):s2')
| l1 < l2 = union l1 u1 $ unionCS s1' s2
| l1 == l2 = union l1 (u1 `max` u2) $ unionCS s1' s2'
| otherwise = union l2 u2 $ unionCS s1 s2'
where
union l u [] = [(l,u)]
union l u s@((l', u') : s')
| u < pred l' = (l,u) : s
| otherwise = union l (u `max` u') s'
diffCS :: CharSet -> CharSet -> CharSet
diffCS [] _ = []
diffCS s [] = s
diffCS s1@((l1,u1):s1') s2@((l2,u2):s2')
| u1 < l2 = (l1,u1) : diffCS s1' s2
| u2 < l1 = diffCS s1 s2'
| otherwise = p ++ diffCS (s ++ s1') s2
where
p | l1 < l2 = [(l1, pred l2)]
| otherwise = []
s | u2 < u1 = [(succ u2, u1)]
| otherwise = []
compCS :: CharSet -> CharSet
compCS = (allCS `diffCS`)
intersectCS :: CharSet -> CharSet -> CharSet
intersectCS [] _s2 = []
intersectCS _s1 [] = []
intersectCS s1@((l1,u1):s1') s2@((l2,u2):s2')
| u1 < l2 = intersectCS s1' s2
| u2 < l1 = intersectCS s1 s2'
| otherwise = i : isect
where
i = (l1 `max` l2, u1 `min` u2)
isect
| u1 < u2 = intersectCS s1' s2
| otherwise = intersectCS s1 s2'
exorCS :: CharSet -> CharSet -> CharSet
exorCS [] s2 = s2
exorCS s1 [] = s1
exorCS s1@(i1@(l1,u1):s1') s2@(i2@(l2,u2):s2')
| u1 < l2 = i1 : exorCS s1' s2
| u2 < l1 = i2 : exorCS s1 s2'
| otherwise = i ++ exor'
where
i | l1 < l2 = [(l1, pred l2)]
| l2 < l1 = [(l2, pred l1)]
| otherwise = []
exor'
| u1 < u2 = exorCS s1' ((succ u1, u2) : s2')
| u2 < u1 = exorCS ((succ u2, u1) : s1') s2'
| otherwise = exorCS s1' s2'