Alternate.hs

-- | Alternate between @a@s and @b@s, starting and ending on a @a@
data Alternate a b =
    AltDone a
  | AltCons a b (Alternate a b)

instance Bifunctor Alternate where
  bimap :: forall a a' b b'. (a -> a') -> (b -> b') -> Alternate a b -> Alternate a' b'
  bimap f g = go
    where
      go :: Alternate a b -> Alternate a' b'
      go (AltDone a)      = AltDone (f a)
      go (AltCons a b xs) = AltCons (f a) (g b) (go xs)

alternate :: forall a b. (a -> a -> b) -> NonEmpty a -> Alternate a b
alternate f (x :| xs) = go x xs
  where
    go :: a -> [a] -> Alternate a b
    go a []      = AltDone a
    go a (a':as) = AltCons a (f a a') (go a' as)

join :: forall a b. (a -> a -> b) -> Alternate a b -> Alternate a b -> Alternate a b
join f = go
  where
    go :: Alternate a b -> Alternate a b -> Alternate a b
    go (AltDone a)         (AltDone a')     = AltCons a (f a a') (AltDone a')
    go (AltDone a)      ys@(AltCons a' _ _) = AltCons a (f a a') ys
    go (AltCons a b xs) ys                  = AltCons a b (go xs ys) 

joinMany :: forall a b. (a -> a -> b) -> NonEmpty (Alternate a b) -> Alternate a b
joinMany = foldr1 . join