module Data.Set.StringSet (
StringSet,
insert,
singleton,
member,
size,
fromList
) where
import Data.Binary
import Control.Monad
data StringSet = SNode !Char !StringSet !StringSet !StringSet
| SEnd
deriving (Show, Eq)
insert :: String -> StringSet -> StringSet
insert xss@(x:xs) (SNode ele l e h) =
case compare x ele of
LT -> SNode ele (insert xss l) e h
EQ -> SNode ele l (insert xs e) h
GT -> SNode ele l e (insert xss h)
insert xss@(x:xs) SEnd =
singleton xss
insert [] t@(SNode ele l e h) =
case compare '\0' ele of
EQ -> t
LT -> SNode ele (insert [] l) e h
insert [] SEnd =
SNode '\0' SEnd SEnd SEnd
singleton :: String -> StringSet
singleton (x:xs) = SNode x SEnd (singleton xs) SEnd
singleton [] = SNode '\0' SEnd SEnd SEnd
member :: String -> StringSet -> Bool
member _ SEnd = False
member [] (SNode ele l e h) = ele == '\0' || member [] l
member xss@(x:xs) (SNode ele l e h) =
case compare x ele of
LT -> member xss l
EQ -> member xs e
GT -> member xss h
treeSize :: StringSet -> Int
treeSize SEnd = 0
treeSize (SNode '\0' l e h) = treeSize l + treeSize e + treeSize h
treeSize (SNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h
size :: StringSet -> Int
size SEnd = 0
size (SNode '\0' l e h) = 1 + size l + size e + size h
size (SNode _ l e h) = size l + size e + size h
fromList :: [String] -> StringSet
fromList = foldl (flip insert) SEnd
empty :: StringSet
empty = SEnd
null :: StringSet -> Bool
null SEnd = True
null _ = False
instance Binary StringSet where
put (SNode ch SEnd SEnd SEnd) = do
putWord8 0
put ch
put (SNode ch SEnd SEnd h) = do
putWord8 1
put ch
put h
put (SNode ch SEnd e SEnd) = do
putWord8 2
put ch
put e
put (SNode ch SEnd e h) = do
putWord8 3
put ch
put e
put h
put (SNode ch l SEnd SEnd) = do
putWord8 4
put ch
put l
put (SNode ch l SEnd h) = do
putWord8 5
put ch
put l
put h
put (SNode ch l e SEnd) = do
putWord8 6
put ch
put l
put e
put (SNode ch l e h) = do
putWord8 7
put ch
put l
put e
put h
put SEnd = putWord8 8
get = do
tag <- getWord8
case tag of
8 -> return SEnd
_ -> do
ch <- get
case tag of
0 -> return (SNode ch SEnd SEnd SEnd)
1 -> do
h <- get
return (SNode ch SEnd SEnd h)
2 -> do
e <- get
return (SNode ch SEnd e SEnd)
3 -> do
e <- get
h <- get
return (SNode ch SEnd e h)
4 -> do
l <- get
return (SNode ch l SEnd SEnd)
5 -> do
l <- get
h <- get
return (SNode ch l SEnd h)
6 -> do
l <- get
e <- get
return (SNode ch l e SEnd)
7 -> do
l <- get
e <- get
h <- get
return (SNode ch l e h)