-- | Description: Internal
module Exon.Combinators where

import qualified Data.List.NonEmpty as NonEmpty
import Prelude hiding (intersperse)

import Exon.Class.Exon (Exon (exonProcess))
import qualified Exon.Data.Segment as Segment

-- | Combine the elements in the list using 'Exon', interspersing the separator between each pair of elements.
intercalate1 ::
  Exon a =>
  a ->
  NonEmpty a ->
  a
intercalate1 :: forall a. Exon a => a -> NonEmpty a -> a
intercalate1 a
sep NonEmpty a
ta =
  NonEmpty (Segment a) -> a
forall result. Exon result => NonEmpty (Segment result) -> result
exonProcess (a -> Segment a
forall a. a -> Segment a
Segment.Expression (a -> Segment a) -> NonEmpty a -> NonEmpty (Segment a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse a
sep NonEmpty a
ta)

-- | Combine the elements in the list using 'Exon', interspersing the separator between each pair of elements.
--
-- Returns 'Nothing' when the list is empty.
intercalateMay ::
  Exon a =>
  Foldable t =>
  a ->
  t a ->
  Maybe a
intercalateMay :: forall a (t :: * -> *). (Exon a, Foldable t) => a -> t a -> Maybe a
intercalateMay a
sep t a
ta =
  a -> NonEmpty a -> a
forall a. Exon a => a -> NonEmpty a -> a
intercalate1 a
sep (NonEmpty a -> a) -> Maybe (NonEmpty a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
ta)

-- | Combine the elements in the list using 'Exon', interspersing the separator between each pair of elements.
--
-- Returns 'mempty' for empty lists; use 'intercalate1' for 'NonEmpty' or 'intercalateMay' to avoid the 'Monoid'
-- requirement.
intercalate ::
  Exon a =>
  Monoid a =>
  Foldable t =>
  a ->
  t a ->
  a
intercalate :: forall a (t :: * -> *).
(Exon a, Monoid a, Foldable t) =>
a -> t a -> a
intercalate a
sep t a
ta =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Monoid a => a
mempty (a -> t a -> Maybe a
forall a (t :: * -> *). (Exon a, Foldable t) => a -> t a -> Maybe a
intercalateMay a
sep t a
ta)