module Data.JoinList
(
JoinList
, ViewL(..)
, ViewR(..)
, fromList
, toList
, empty
, singleton
, cons
, snoc
, ( ++ )
, join
, head
, last
, tail
, init
, null
, concat
, length
, map
, reverse
, replicate
, repeated
, gfold
, foldr
, foldl
, unfoldl
, unfoldr
, viewl
, viewr
, takeLeft
, takeRight
, dropLeft
, dropRight
, xzip
, xzipWith
) where
import Control.Applicative hiding ( empty )
import Data.Foldable ( Foldable )
import qualified Data.Foldable as F
import Data.Monoid
import Data.Traversable ( Traversable(..) )
import Prelude hiding ( (++), concat, foldl, foldr, head,
init, last, length,
map, null, replicate, reverse,
tail )
data JoinList a = Empty
| Single a
| JoinList a :++: JoinList a
deriving (Eq)
data ViewL a = EmptyL | a :< (JoinList a)
deriving (Eq,Show)
data ViewR a = EmptyR | (JoinList a) :> a
deriving (Eq,Show)
instance Show a => Show (JoinList a) where
showsPrec _ xs = showString "fromList " . shows (toList xs)
instance Monoid (JoinList a) where
mempty = Empty
mappend = (++)
instance Functor JoinList where
fmap = map
instance Monad JoinList where
return = Single
Empty >>= _ = Empty
Single a >>= k = k a
(t :++: u) >>= k = (concat $ fmap k t) :++: (concat $ fmap k u)
instance Foldable JoinList where
foldMap _ Empty = mempty
foldMap f (Single a) = f a
foldMap f (t :++: u) = F.foldMap f t `mappend` F.foldMap f u
foldr = foldr
foldl = foldl
instance Traversable JoinList where
traverse _ Empty = pure Empty
traverse f (Single a) = Single <$> f a
traverse f (t :++: u) = (:++:) <$> traverse f t <*> traverse f u
instance Functor ViewL where
fmap _ EmptyL = EmptyL
fmap f (a :< as) = f a :< fmap f as
instance Functor ViewR where
fmap _ EmptyR = EmptyR
fmap f (as :> a) = fmap f as :> f a
toList :: JoinList a -> [a]
toList = foldl (flip (:)) []
fromList :: [a] -> JoinList a
fromList [] = Empty
fromList [x] = Single x
fromList (x:xs) = x `cons` fromList xs
empty :: JoinList a
empty = Empty
singleton :: a -> JoinList a
singleton = Single
cons :: a -> JoinList a -> JoinList a
cons a xs = singleton a ++ xs
snoc :: JoinList a -> a -> JoinList a
snoc xs a = xs ++ singleton a
infixr 5 ++
(++) :: JoinList a -> JoinList a -> JoinList a
Empty ++ ys = ys
xs ++ Empty = xs
xs ++ ys = xs :++: ys
infixr 5 `join`
join :: JoinList a -> JoinList a -> JoinList a
join = (++)
head :: JoinList a -> a
head Empty = error "Data.JoinList.head: empty list"
head (Single a) = a
head (t :++: _) = head t
last :: JoinList a -> a
last Empty = error "Data.JoinList.head: empty list"
last (Single a) = a
last (_ :++: u) = last u
tail :: JoinList a -> JoinList a
tail Empty = error "Data.JoinList.tail: empty list"
tail (Single _) = Empty
tail (Single _ :++: u) = u
tail (t :++: u) = tail t :++: u
init :: JoinList a -> JoinList a
init Empty = error "Data.JoinList.init: empty list"
init (Single _) = Empty
init (t :++: Single _) = t
init (t :++: u) = t :++: init u
null :: JoinList a -> Bool
null Empty = True
null _ = False
concat :: JoinList (JoinList a) -> JoinList a
concat = foldl mappend mempty
length :: JoinList a -> Int
length = gfold 0 (const 1) (+)
map :: (a -> b) -> JoinList a -> JoinList b
map _ Empty = Empty
map f (Single a) = Single (f a)
map f (a :++: b) = (map f a) :++: (map f b)
reverse :: JoinList a -> JoinList a
reverse l = step l Empty where
step Empty acc = acc
step (Single a) acc = acc `snoc` a
step (t :++: u) acc = step t (step u acc)
replicate :: Int -> a -> JoinList a
replicate n a | n > 0 = step (n1) (Single a)
| otherwise = Empty
where
step 0 xs = xs
step i xs = step (i1) $ Single a :++: xs
repeated :: Int -> JoinList a -> JoinList a
repeated n xs | n > 0 = step (n1) xs
| otherwise = Empty
where
step 0 ys = ys
step i ys = step (i1) $ xs :++: ys
gfold :: b
-> (a -> b)
-> (b -> b -> b)
-> JoinList a
-> b
gfold e _ _ Empty = e
gfold _ f _ (Single a) = f a
gfold e f g (t :++: u) = g (gfold e f g t) (gfold e f g u)
foldr :: (a -> b -> b) -> b -> JoinList a -> b
foldr _ e Empty = e
foldr f e (Single a) = f a e
foldr f e (t :++: u) = foldr f (foldr f e t) u
foldl :: (b -> a -> b) -> b -> JoinList a -> b
foldl _ e Empty = e
foldl f e (Single a) = f e a
foldl f e (t :++: u) = foldl f (foldl f e u) t
unfoldl :: (b -> Maybe (a, b)) -> b -> JoinList a
unfoldl f = step where
step st = case f st of
Nothing -> Empty
Just (a,st') -> step st' `snoc` a
unfoldr :: (b -> Maybe (a, b)) -> b -> JoinList a
unfoldr f = step where
step st = case f st of
Nothing -> Empty
Just (a,st') -> a `cons` step st'
viewl :: JoinList a -> ViewL a
viewl Empty = EmptyL
viewl (Single a) = a :< Empty
viewl (t :++: u) = step t u where
step Empty r = viewl r
step (Single a) r = a :< r
step (t' :++: u') r = step t' (u' :++: r)
viewr :: JoinList a -> ViewR a
viewr Empty = EmptyR
viewr (Single a) = Empty :> a
viewr (t :++: u) = step t u where
step l Empty = viewr l
step l (Single a) = l :> a
step l (t' :++: u') = step (l :++: t') u'
takeLeft :: Int -> JoinList a -> JoinList a
takeLeft i _ | i <= 0 = Empty
takeLeft i xs = case viewl xs of
EmptyL -> Empty
a :< t -> a `cons` takeLeft (i1) t
takeRight :: Int -> JoinList a -> JoinList a
takeRight i _ | i <= 0 = Empty
takeRight i xs = case viewr xs of
EmptyR -> Empty
t :> a -> takeRight (i1) t `snoc` a
dropLeft :: Int -> JoinList a -> JoinList a
dropLeft i xs | i <= 0 = xs
dropLeft i xs = case viewl xs of
EmptyL -> Empty
_ :< t -> dropLeft (i1) t
dropRight :: Int -> JoinList a -> JoinList a
dropRight i xs | i <= 0 = xs
dropRight i xs = case viewr xs of
EmptyR -> Empty
t :> _ -> dropRight (i1) t
xzip :: JoinList a -> [b] -> JoinList (a,b)
xzip = xzipWith (,)
xzipWith :: (a -> b -> c) -> JoinList a -> [b] -> JoinList c
xzipWith fn xs0 ys0 = fst $ step xs0 ys0
where
step Empty xs = (Empty,xs)
step (Single a) (x:xs) = (Single (fn a x),xs)
step (Single _) [] = (Empty,[])
step (t :++: u) xs = (t' :++: u',xs'') where
(t',xs') = step t xs
(u',xs'') = step u xs'