module Data.CircularList (
CList,
empty, fromList, singleton,
update,
leftElements, rightElements, toList, toInfList,
focus, insertL, insertR,
removeL, removeR,
rotR, rotL,
balance, packL, packR,
isEmpty, size,
) where
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
data CList a = Empty
| CList [a] a [a]
empty :: CList a
empty = Empty
fromList :: [a] -> CList a
fromList [] = Empty
fromList a@(i:is) = let len = length a
(r,l) = splitAt (len `div` 2) is
in CList (reverse l) i r
singleton :: a -> CList a
singleton a = CList [] a []
update :: a -> CList a -> CList a
update v Empty = CList [] v []
update v (CList l _ r) = CList l v r
leftElements :: CList a -> [a]
leftElements Empty = []
leftElements (CList l f r) = f : (l ++ (reverse r))
rightElements :: CList a -> [a]
rightElements Empty = []
rightElements (CList l f r) = f : (r ++ (reverse l))
toList :: CList a -> [a]
toList = rightElements
toInfList :: CList a -> [a]
toInfList = cycle . toList
focus :: CList a -> Maybe a
focus Empty = Nothing
focus (CList _ f _) = Just f
insertR :: a -> CList a -> CList a
insertR i Empty = CList [] i []
insertR i (CList l f r) = CList l i (f:r)
insertL :: a -> CList a -> CList a
insertL i Empty = CList [] i []
insertL i (CList l f r) = CList (f:l) i r
removeL :: CList a -> CList a
removeL Empty = Empty
removeL (CList [] _ []) = Empty
removeL (CList (l:ls) _ rs) = CList ls l rs
removeL (CList [] _ rs) = let (f:ls) = reverse rs
in CList ls f []
removeR :: CList a -> CList a
removeR Empty = Empty
removeR (CList [] _ []) = Empty
removeR (CList l _ (r:rs)) = CList l r rs
removeR (CList l _ []) = let (f:rs) = reverse l
in CList [] f rs
rotL :: CList a -> CList a
rotL Empty = Empty
rotL r@(CList [] _ []) = r
rotL (CList (l:ls) f rs) = CList ls l (f:rs)
rotL (CList [] f rs) = let (l:ls) = reverse rs
in CList ls l [f]
rotR :: CList a -> CList a
rotR Empty = Empty
rotR r@(CList [] _ []) = r
rotR (CList ls f (r:rs)) = CList (f:ls) r rs
rotR (CList ls f []) = let (r:rs) = reverse ls
in CList [f] r rs
balance :: CList a -> CList a
balance = fromList . toList
packL :: CList a -> CList a
packL Empty = Empty
packL (CList l f r) = CList (l ++ (reverse r)) f []
packR :: CList a -> CList a
packR Empty = Empty
packR (CList l f r) = CList [] f (r ++ (reverse l))
isEmpty :: CList a -> Bool
isEmpty Empty = True
isEmpty _ = False
size :: CList a -> Int
size Empty = 0
size (CList l _ r) = 1 + (length l) + (length r)
instance (Show a) => Show (CList a) where
show cl = case balance cl of
(CList l f r) -> show (reverse l,f,r)
Empty -> "Empty"
instance (Eq a) => Eq (CList a) where
a == b = (toList a) == (toList b)
instance Arbitrary a => Arbitrary (CList a) where
arbitrary = frequency [(1, return Empty), (10, arbCList)]
where arbCList = do
l <- arbitrary
f <- arbitrary
r <- arbitrary
return $ CList l f r
shrink (CList l f r) = Empty : [ CList l' f' r' | l' <- shrink l,
f' <- shrink f,
r' <- shrink r]
shrink Empty = []
instance Functor CList where
fmap _ Empty = Empty
fmap fn (CList l f r) = (CList (fmap fn l) (fn f) (fmap fn r))