{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
module RERE.CharSet (
CharSet,
empty,
universe,
singleton,
insert,
union,
intersection,
complement,
difference,
size,
null,
member,
fromList,
toList,
fromIntervalList,
toIntervalList,
) where
import Prelude hiding (null)
import Data.Char (chr, ord)
import Data.List (foldl', sortBy)
import Data.String (IsString (..))
#if MIN_VERSION_containers(0,5,0)
import qualified Data.IntMap.Strict as IM
#else
import qualified Data.IntMap as IM
#endif
newtype CharSet = CS { CharSet -> IntMap Int
unCS :: IM.IntMap Int }
deriving (CharSet -> CharSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharSet -> CharSet -> Bool
$c/= :: CharSet -> CharSet -> Bool
== :: CharSet -> CharSet -> Bool
$c== :: CharSet -> CharSet -> Bool
Eq, Eq CharSet
CharSet -> CharSet -> Bool
CharSet -> CharSet -> Ordering
CharSet -> CharSet -> CharSet
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
min :: CharSet -> CharSet -> CharSet
$cmin :: CharSet -> CharSet -> CharSet
max :: CharSet -> CharSet -> CharSet
$cmax :: CharSet -> CharSet -> CharSet
>= :: CharSet -> CharSet -> Bool
$c>= :: CharSet -> CharSet -> Bool
> :: CharSet -> CharSet -> Bool
$c> :: CharSet -> CharSet -> Bool
<= :: CharSet -> CharSet -> Bool
$c<= :: CharSet -> CharSet -> Bool
< :: CharSet -> CharSet -> Bool
$c< :: CharSet -> CharSet -> Bool
compare :: CharSet -> CharSet -> Ordering
$ccompare :: CharSet -> CharSet -> Ordering
Ord)
instance IsString CharSet where
fromString :: String -> CharSet
fromString = String -> CharSet
fromList
instance Show CharSet where
showsPrec :: Int -> CharSet -> ShowS
showsPrec Int
d CharSet
cs
| CharSet -> Int
size CharSet
cs forall a. Ord a => a -> a -> Bool
< Int
20
= forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (CharSet -> String
toList CharSet
cs)
| Bool
otherwise
= Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"CS.fromIntervalList "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (CharSet -> [(Char, Char)]
toIntervalList CharSet
cs)
empty :: CharSet
empty :: CharSet
empty = IntMap Int -> CharSet
CS forall a. IntMap a
IM.empty
universe :: CharSet
universe :: CharSet
universe = IntMap Int -> CharSet
CS forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton Int
0 Int
0x10ffff
null :: CharSet -> Bool
null :: CharSet -> Bool
null (CS IntMap Int
cs) = forall a. IntMap a -> Bool
IM.null IntMap Int
cs
size :: CharSet -> Int
size :: CharSet -> Int
size (CS IntMap Int
m) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ !Int
acc (Int
lo, Int
hi) -> Int
acc forall a. Num a => a -> a -> a
+ (Int
hi forall a. Num a => a -> a -> a
- Int
lo) forall a. Num a => a -> a -> a
+ Int
1) Int
0 (forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Int
m)
singleton :: Char -> CharSet
singleton :: Char -> CharSet
singleton Char
c = IntMap Int -> CharSet
CS (forall a. Int -> a -> IntMap a
IM.singleton (Char -> Int
ord Char
c) (Char -> Int
ord Char
c))
member :: Char -> CharSet -> Bool
#if MIN_VERSION_containers(0,5,0)
member :: Char -> CharSet -> Bool
member Char
c (CS IntMap Int
m) = case forall a. Int -> IntMap a -> Maybe (Int, a)
IM.lookupLE Int
i IntMap Int
m of
Maybe (Int, Int)
Nothing -> Bool
False
Just (Int
_, Int
hi) -> Int
i forall a. Ord a => a -> a -> Bool
<= Int
hi
where
#else
member c (CS m) = go (IM.toList m)
where
go [] = False
go ((x,y):zs) = (x <= i && i <= y) || go zs
#endif
i :: Int
i = Char -> Int
ord Char
c
insert :: Char -> CharSet -> CharSet
insert :: Char -> CharSet -> CharSet
insert Char
c (CS IntMap Int
m) = IntMap Int -> CharSet
normalise (forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Char -> Int
ord Char
c) (Char -> Int
ord Char
c) IntMap Int
m)
union :: CharSet -> CharSet -> CharSet
union :: CharSet -> CharSet -> CharSet
union (CS IntMap Int
xs) (CS IntMap Int
ys) = IntMap Int -> CharSet
normalise (forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Ord a => a -> a -> a
max IntMap Int
xs IntMap Int
ys)
intersection :: CharSet -> CharSet -> CharSet
intersection :: CharSet -> CharSet -> CharSet
intersection (CS IntMap Int
xs) (CS IntMap Int
ys) = IntMap Int -> CharSet
CS forall a b. (a -> b) -> a -> b
$
forall a. [(Int, a)] -> IntMap a
IM.fromList (forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList (forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Int
xs) (forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Int
ys))
intersectRangeList :: Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList :: forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList aset :: [(a, a)]
aset@((a
x,a
y):[(a, a)]
as) bset :: [(a, a)]
bset@((a
u,a
v):[(a, a)]
bs)
| a
y forall a. Ord a => a -> a -> Bool
< a
u = forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList [(a, a)]
as [(a, a)]
bset
| a
v forall a. Ord a => a -> a -> Bool
< a
x = forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList [(a, a)]
aset [(a, a)]
bs
| a
y forall a. Ord a => a -> a -> Bool
< a
v = (forall a. Ord a => a -> a -> a
max a
x a
u, a
y) forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList [(a, a)]
as [(a, a)]
bset
| Bool
otherwise = (forall a. Ord a => a -> a -> a
max a
x a
u, a
v) forall a. a -> [a] -> [a]
: forall a. Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]
intersectRangeList [(a, a)]
aset [(a, a)]
bs
intersectRangeList [(a, a)]
_ [] = []
intersectRangeList [] [(a, a)]
_ = []
complement :: CharSet -> CharSet
complement :: CharSet -> CharSet
complement (CS IntMap Int
xs) = IntMap Int -> CharSet
CS forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [(Int, Int)]
complementRangeList (forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Int
xs)
complementRangeList' :: Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList' :: Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList' Int
x ((Int
u,Int
v):[(Int, Int)]
s) = (Int
x,forall a. Enum a => a -> a
pred Int
u) forall a. a -> [a] -> [a]
: Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList'' Int
v [(Int, Int)]
s
complementRangeList' Int
x [] = [(Int
x,Int
0x10ffff)]
complementRangeList'' :: Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList'' :: Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList'' Int
x [(Int, Int)]
s
| Int
x forall a. Eq a => a -> a -> Bool
== Int
0x10ffff = []
| Bool
otherwise = Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList' (forall a. Enum a => a -> a
succ Int
x) [(Int, Int)]
s
complementRangeList :: [(Int, Int)] -> [(Int, Int)]
complementRangeList :: [(Int, Int)] -> [(Int, Int)]
complementRangeList s :: [(Int, Int)]
s@((Int
x,Int
y):[(Int, Int)]
s')
| Int
x forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList'' Int
y [(Int, Int)]
s'
| Bool
otherwise = Int -> [(Int, Int)] -> [(Int, Int)]
complementRangeList' Int
0 [(Int, Int)]
s
complementRangeList [] = [(Int
0, Int
0x10ffff)]
difference :: CharSet -> CharSet -> CharSet
difference :: CharSet -> CharSet -> CharSet
difference CharSet
xs CharSet
ys = CharSet -> CharSet -> CharSet
intersection CharSet
xs (CharSet -> CharSet
complement CharSet
ys)
fromList :: String -> CharSet
fromList :: String -> CharSet
fromList = IntMap Int -> CharSet
normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ IntMap Int
acc Char
c -> forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Char -> Int
ord Char
c) (Char -> Int
ord Char
c) IntMap Int
acc) forall a. IntMap a
IM.empty
toList :: CharSet -> String
toList :: CharSet -> String
toList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Enum a => a -> a -> [a]
enumFromTo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharSet -> [(Char, Char)]
toIntervalList
toIntervalList :: CharSet -> [(Char, Char)]
toIntervalList :: CharSet -> [(Char, Char)]
toIntervalList (CS IntMap Int
m) = [ (Int -> Char
chr Int
lo, Int -> Char
chr Int
hi) | (Int
lo, Int
hi) <- forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Int
m ]
fromIntervalList :: [(Char,Char)] -> CharSet
fromIntervalList :: [(Char, Char)] -> CharSet
fromIntervalList [(Char, Char)]
xs = [(Int, Int)] -> CharSet
normalise' forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int, Int)
a (Int, Int)
b -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (Int, Int)
a) (forall a b. (a, b) -> a
fst (Int, Int)
b))
[ (Char -> Int
ord Char
lo, Char -> Int
ord Char
hi)
| (Char
lo, Char
hi) <- [(Char, Char)]
xs
, Char
lo forall a. Ord a => a -> a -> Bool
<= Char
hi
]
normalise :: IM.IntMap Int -> CharSet
normalise :: IntMap Int -> CharSet
normalise = [(Int, Int)] -> CharSet
normalise'forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList
normalise' :: [(Int,Int)] -> CharSet
normalise' :: [(Int, Int)] -> CharSet
normalise' = IntMap Int -> CharSet
CS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Int, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [(Int, Int)]
go where
go :: [(Int,Int)] -> [(Int,Int)]
go :: [(Int, Int)] -> [(Int, Int)]
go [] = []
go ((Int
x,Int
y):[(Int, Int)]
zs) = Int -> Int -> [(Int, Int)] -> [(Int, Int)]
go' Int
x Int
y [(Int, Int)]
zs
go' :: Int -> Int -> [(Int, Int)] -> [(Int, Int)]
go' :: Int -> Int -> [(Int, Int)] -> [(Int, Int)]
go' Int
lo Int
hi [] = [(Int
lo, Int
hi)]
go' Int
lo Int
hi ws0 :: [(Int, Int)]
ws0@((Int
u,Int
v):[(Int, Int)]
ws)
| Int
u forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> a
succ Int
hi = Int -> Int -> [(Int, Int)] -> [(Int, Int)]
go' Int
lo (forall a. Ord a => a -> a -> a
max Int
v Int
hi) [(Int, Int)]
ws
| Bool
otherwise = (Int
lo,Int
hi) forall a. a -> [a] -> [a]
: [(Int, Int)] -> [(Int, Int)]
go [(Int, Int)]
ws0