ReflectiveIntersperse.hs

{-# LANGUAGE RankNTypes #-}

module ReflectiveIntersperse (intersperse, intersperse') where

import Data.Reflection (Reifies, reflect, reify)
import Data.Foldable (Foldable(..))

data Between a s = Empty | Has a

instance (Reifies s a, Semigroup a) => Semigroup (Between a s) where
    Empty <> x = x
    x <> Empty = x
    ps@(Has x) <> Has y = Has (x <> reflect ps <> y)

instance (Reifies s a, Semigroup a) => Monoid (Between a s) where
    mempty = Empty

unBetween :: Monoid a => Between a s -> proxy s -> a
unBetween Empty   _ = mempty
unBetween (Has x) _ = x

baseIntersperse :: (Monoid a, Foldable f) =>
                   (forall m. Monoid m => (a -> m) -> f a -> m) ->
                   a -> f a -> a
baseIntersperse f x xs = reify x (unBetween $ f Has xs)

intersperse :: (Monoid a, Foldable f) => a -> f a -> a
intersperse = baseIntersperse foldMap

intersperse' :: (Monoid a, Foldable f) => a -> f a -> a
intersperse' = baseIntersperse foldMap'