module Data.JoinList
(
JoinList
, fromList
, toList
, empty
, singleton
, cons
, snoc
, ( ++ )
, join
, null
, concat
, length
, map
, replicate
, repeated
, gfold
, foldr
, foldl
, unfoldl
, unfoldr
, 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, length
, map, null, replicate )
data JoinList a = Empty
| Single a
| JoinList a :++: JoinList a
deriving (Eq,Show)
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
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 = (++)
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)
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'
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'