module Data.AbList where
import Prelude
infixr 5 :/
data AbList a b = AbNil | a :/ AbList b a
deriving (Eq, Ord, Show)
abSingle :: a -> AbList a b
abSingle a = a :/ AbNil
abShallowFold :: t -> (a -> AbList b a -> t) -> (AbList a b) -> t
abShallowFold t _ AbNil = t
abShallowFold _ t (a :/ ba) = t a ba
abToListEither :: AbList a b -> [Either a b]
abToListEither AbNil = []
abToListEither (a :/ AbNil) = [Left a]
abToListEither (a :/ b :/ abz) = (Left a) : (Right b) : abToListEither abz
abFromListEither :: [Either a b] -> Maybe (AbList a b)
abFromListEither [] = Just AbNil
abFromListEither (Left a : []) = Just $ a :/ AbNil
abFromListEither (Left a : Right b : xs) = fmap (\t -> a :/ b :/ t) (abFromListEither xs)
abFromListEither _ = Nothing
abHead :: AbList a b -> Maybe a
abHead = abShallowFold Nothing $ const . Just
abTail :: AbList a b -> Maybe (AbList b a)
abTail = abShallowFold Nothing $ const Just
abInit :: AbList a b -> Maybe (AbList a b)
abInit AbNil = Nothing
abInit (a :/ as) = Just $ q a as
where
q :: a -> AbList b a -> AbList a b
q _ AbNil = AbNil
q x (y :/ zs) = x :/ q y zs
aaToList :: AbList a a -> [a]
aaToList AbNil = []
aaToList (a :/ as) = a : (aaToList as)
aaMap :: (a -> b) -> AbList a a -> AbList b b
aaMap _ AbNil = AbNil
aaMap f (a :/ as) = f a :/ (aaMap f as)
aaFromList :: [a] -> AbList a a
aaFromList = foldr (:/) AbNil
abFoldr :: (Either a b -> t -> t) -> t -> (AbList a b) -> t
abFoldr f = abFoldr' (f . Left) (f . Right)
abFoldr' :: (a -> t -> t) -> (b -> t -> t) -> t -> (AbList a b) -> t
abFoldr' _ _ t AbNil = t
abFoldr' f _ t (a :/ AbNil) = f a t
abFoldr' f g t (a :/ b :/ cs) = f a (g b (abFoldr' f g t cs))
abFoldl :: (t -> Either a b -> t) -> t -> (AbList a b) -> t
abFoldl f = abFoldl' ((. Left) . f) ((. Right) . f)
abFoldl' :: (t -> a -> t) -> (t -> b -> t) -> t -> (AbList a b) -> t
abFoldl' _ _ t AbNil = t
abFoldl' f _ t (a :/ AbNil) = f t a
abFoldl' f g t (a :/ b :/ cs) = abFoldl' f g (f (g t b) a) cs
abZip :: [a] -> [b] -> AbList a b
abZip [] _ = AbNil
abZip (a:_) [] = a :/ AbNil
abZip (a:as) (b:bs) = a :/ b :/ (abZip as bs)
abFromPairs :: [(a, b)] -> AbList a b
abFromPairs = foldr (\(a, b) cs -> a :/ b :/ cs) AbNil
abToPairs :: AbList a b -> [(a, b)]
abToPairs AbNil = []
abToPairs (_ :/ AbNil) = []
abToPairs (a :/ b :/ cs) = (a,b) : abToPairs cs
abMap :: (a -> a') -> (b -> b') -> AbList a b -> AbList a' b'
abMap _ _ AbNil = AbNil
abMap fa _ (a :/ AbNil) = fa a :/ AbNil
abMap fa fb (a :/ b :/ cs) = fa a :/ fb b :/ (abMap fa fb cs)
abMerge :: (a -> t) -> (b -> t) -> AbList a b -> [t]
abMerge f g = aaToList . (abMap f g)
abReverse :: AbList a b -> Either (AbList a b) (AbList b a)
abReverse = goAB AbNil
where
goAB :: AbList b a -> AbList a b -> Either (AbList a b) (AbList b a)
goAB acc AbNil = Right acc
goAB acc (x :/ xs) = goBA (x :/ acc) xs
goBA :: AbList a b -> AbList b a -> Either (AbList a b) (AbList b a)
goBA acc AbNil = Left acc
goBA acc (x :/ xs) = goAB (x :/ acc) xs
abMapLefts :: (a -> a') -> AbList a b -> AbList a' b
abMapLefts = flip abMap id
abMapRights :: (b -> b') -> AbList a b -> AbList a b'
abMapRights = abMap id
instance Functor (AbList a) where
fmap = abMapRights