{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Sequence.Alternating
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Type representing Alternating sequences. The sequence type itself is parameterized.
--
--------------------------------------------------------------------------------
module HGeometry.Sequence.Alternating
  ( Alternating(..)
  , fromNonEmptyWith
  , mapF
  , firstWithNeighbors
  , withNeighbours
  , mergeAlternating
  , insertBreakPoints
  , reverse

  , consElemWith
  , unconsAlt
  , snocElemWith
  , separators
  ) where

import           Control.DeepSeq
import           Control.Lens
import           Data.Bifoldable
import           Data.Bitraversable
import qualified Data.Foldable as F
import           Data.Foldable1
import           Data.Functor.Apply ((<.*>))
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Semigroup.Traversable
import           GHC.Generics (Generic)
import           HGeometry.Foldable.Util
import           Prelude hiding (reverse)

--------------------------------------------------------------------------------

-- | A (non-empty) alternating sequence of @a@\'s and @sep@'s.
data Alternating f sep a = Alternating a (f (sep, a))
                         deriving ((forall x. Alternating f sep a -> Rep (Alternating f sep a) x)
-> (forall x. Rep (Alternating f sep a) x -> Alternating f sep a)
-> Generic (Alternating f sep a)
forall x. Rep (Alternating f sep a) x -> Alternating f sep a
forall x. Alternating f sep a -> Rep (Alternating f sep a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) sep a x.
Rep (Alternating f sep a) x -> Alternating f sep a
forall (f :: * -> *) sep a x.
Alternating f sep a -> Rep (Alternating f sep a) x
$cfrom :: forall (f :: * -> *) sep a x.
Alternating f sep a -> Rep (Alternating f sep a) x
from :: forall x. Alternating f sep a -> Rep (Alternating f sep a) x
$cto :: forall (f :: * -> *) sep a x.
Rep (Alternating f sep a) x -> Alternating f sep a
to :: forall x. Rep (Alternating f sep a) x -> Alternating f sep a
Generic)

deriving instance (Show a, Show (f (sep, a))) => Show (Alternating f sep a)
deriving instance (Eq a, Eq (f (sep, a)))     => Eq (Alternating f sep a)
deriving instance (Ord a, Ord (f (sep, a)))   => Ord (Alternating f sep a)

instance (NFData a, NFData (f (sep, a))) => NFData (Alternating f sep a)


instance Functor f => Functor (Alternating f sep) where
  fmap :: forall a b. (a -> b) -> Alternating f sep a -> Alternating f sep b
fmap a -> b
f (Alternating a
x f (sep, a)
xs) = b -> f (sep, b) -> Alternating f sep b
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating (a -> b
f a
x) (f (sep, b) -> Alternating f sep b)
-> f (sep, b) -> Alternating f sep b
forall a b. (a -> b) -> a -> b
$ ((sep, a) -> (sep, b)) -> f (sep, a) -> f (sep, b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (sep, a) -> (sep, b)
forall a b. (a -> b) -> (sep, a) -> (sep, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (sep, a)
xs
instance Foldable f => Foldable (Alternating f sep) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Alternating f sep a -> m
foldMap a -> m
f (Alternating a
x f (sep, a)
xs) = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> ((sep, a) -> m) -> f (sep, a) -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((sep, a) -> a) -> (sep, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sep, a) -> a
forall a b. (a, b) -> b
snd) f (sep, a)
xs
instance Traversable f => Traversable (Alternating f sep) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Alternating f sep a -> f (Alternating f sep b)
traverse a -> f b
f (Alternating a
x f (sep, a)
xs) = b -> f (sep, b) -> Alternating f sep b
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating (b -> f (sep, b) -> Alternating f sep b)
-> f b -> f (f (sep, b) -> Alternating f sep b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (f (sep, b) -> Alternating f sep b)
-> f (f (sep, b)) -> f (Alternating f sep b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((sep, a) -> f (sep, b)) -> f (sep, a) -> f (f (sep, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((a -> f b) -> (sep, a) -> f (sep, b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (sep, a) -> f (sep, b)
traverse a -> f b
f) f (sep, a)
xs

instance Foldable f => Foldable1 (Alternating f sep) where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Alternating f sep a -> m
foldMap1 a -> m
f (Alternating a
x f (sep, a)
xs) = case ((sep, a) -> Maybe m) -> f (sep, a) -> Maybe m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> ((sep, a) -> m) -> (sep, a) -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f (a -> m) -> ((sep, a) -> a) -> (sep, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sep, a) -> a
forall a b. (a, b) -> b
snd) f (sep, a)
xs of
                                    Maybe m
Nothing -> a -> m
f a
x
                                    Just m
r  -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
r

instance Traversable f => Traversable1 (Alternating f sep) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Alternating f sep a -> f (Alternating f sep b)
traverse1 a -> f b
f (Alternating a
x f (sep, a)
xs) = b -> f (sep, b) -> Alternating f sep b
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating (b -> f (sep, b) -> Alternating f sep b)
-> f b -> f (f (sep, b) -> Alternating f sep b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (f (sep, b) -> Alternating f sep b)
-> MaybeApply f (f (sep, b)) -> f (Alternating f sep b)
forall (f :: * -> *) a b.
Apply f =>
f (a -> b) -> MaybeApply f a -> f b
<.*> ((sep, a) -> f (sep, b)) -> f (sep, a) -> MaybeApply f (f (sep, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Apply f) =>
(a -> f b) -> t a -> MaybeApply f (t b)
traverse1Maybe ((a -> f b) -> (sep, a) -> f (sep, b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> (sep, a) -> f (sep, b)
traverse1 a -> f b
f) f (sep, a)
xs

instance Functor f => Bifunctor (Alternating f) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Alternating f a c -> Alternating f b d
bimap a -> b
f c -> d
g (Alternating c
x f (a, c)
xs) = d -> f (b, d) -> Alternating f b d
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating (c -> d
g c
x) (f (b, d) -> Alternating f b d) -> f (b, d) -> Alternating f b d
forall a b. (a -> b) -> a -> b
$ ((a, c) -> (b, d)) -> f (a, c) -> f (b, d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) f (a, c)
xs

instance Foldable f => Bifoldable (Alternating f) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Alternating f a b -> m
bifoldMap a -> m
f b -> m
g (Alternating b
x f (a, b)
xs) = b -> m
g b
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> ((a, b) -> m) -> f (a, b) -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> (a, b) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> (a, b) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) f (a, b)
xs

instance Traversable f => Bitraversable (Alternating f) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Alternating f a b -> f (Alternating f c d)
bitraverse a -> f c
f b -> f d
g (Alternating b
x f (a, b)
xs) = d -> f (c, d) -> Alternating f c d
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating (d -> f (c, d) -> Alternating f c d)
-> f d -> f (f (c, d) -> Alternating f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
x f (f (c, d) -> Alternating f c d)
-> f (f (c, d)) -> f (Alternating f c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, b) -> f (c, d)) -> f (a, b) -> f (f (c, d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) f (a, b)
xs


-- | Given a separator, and some foldable structure, constructs an Alternating.
fromNonEmptyWith        :: (HasFromFoldable g, Foldable1 f) => sep -> f a -> Alternating g sep a
fromNonEmptyWith :: forall (g :: * -> *) (f :: * -> *) sep a.
(HasFromFoldable g, Foldable1 f) =>
sep -> f a -> Alternating g sep a
fromNonEmptyWith sep
sep f a
xs = let (a
x0 :| [a]
xs') = f a -> NonEmpty a
forall a. f a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f a
xs
                          in a -> g (sep, a) -> Alternating g sep a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
x0 (g (sep, a) -> Alternating g sep a)
-> g (sep, a) -> Alternating g sep a
forall a b. (a -> b) -> a -> b
$ [(sep, a)] -> g (sep, a)
forall a. [a] -> g a
forall (f :: * -> *) a. HasFromFoldable f => [a] -> f a
fromList ((a -> (sep, a)) -> [a] -> [(sep, a)]
forall a b. (a -> b) -> [a] -> [b]
map (sep
sep,) [a]
xs')


-- | map some function changing the f into a g.
mapF                      :: (f (sep, a) -> g (sep', a))
                          -> Alternating f sep a -> Alternating g sep' a
mapF :: forall (f :: * -> *) sep a (g :: * -> *) sep'.
(f (sep, a) -> g (sep', a))
-> Alternating f sep a -> Alternating g sep' a
mapF f (sep, a) -> g (sep', a)
f (Alternating a
x f (sep, a)
xs) = a -> g (sep', a) -> Alternating g sep' a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
x (g (sep', a) -> Alternating g sep' a)
-> g (sep', a) -> Alternating g sep' a
forall a b. (a -> b) -> a -> b
$ f (sep, a) -> g (sep', a)
f f (sep, a)
xs


-- | Computes a b with all its neighbours
--
-- >>> withNeighbours (Alternating 0 [('a', 1), ('b', 2), ('c',3)])
-- [(0,'a',1),(1,'b',2),(2,'c',3)]
withNeighbours                       :: Foldable f => Alternating f sep a -> [(a,sep,a)]
withNeighbours :: forall (f :: * -> *) sep a.
Foldable f =>
Alternating f sep a -> [(a, sep, a)]
withNeighbours xs :: Alternating f sep a
xs@(Alternating a
_ f (sep, a)
ys) =
  (a -> (sep, a) -> (a, sep, a))
-> [a] -> [(sep, a)] -> [(a, sep, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
a (sep
s,a
a') -> (a
a,sep
s,a
a')) (Alternating f sep a -> [a]
forall a. Alternating f sep a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Alternating f sep a
xs) (f (sep, a) -> [(sep, a)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f (sep, a)
ys)


-- | Generic merging scheme that merges two Alternating Lists and applies the function
-- '@f@', with the current/new value at every event. So note that if the alternating
-- consists of 'Alternating a0 [(t1,a2)]' then the function is applied to a1, not to a0
-- (i.e. every value ai is considered alive on the interval [ti,t(i+1))
--
-- >>> let odds  = Alternating "a" [(3,"c"), (5,"e"), (7,"g")]
-- >>> let evens = Alternating "b" [(4,"d"), (6,"f"), (8,"h")]
-- >>> mergeAlternating (\_ a b -> a <> b) odds evens
-- [(3,"cb"),(4,"cd"),(5,"ed"),(6,"ef"),(7,"gf"),(8,"gh")]
-- >>> mergeAlternating (\t a b -> if t `mod` 2 == 0 then a else b) odds evens
-- [(3,"b"),(4,"c"),(5,"d"),(6,"e"),(7,"f"),(8,"g")]
-- >>> mergeAlternating (\_ a b -> a <> b) odds (Alternating "b" [(0,"d"), (5,"e"), (8,"h")])
-- [(0,"ad"),(3,"cd"),(5,"ee"),(7,"ge"),(8,"gh")]
mergeAlternating                         :: Ord t
                                         => (t -> a -> b -> c)
                                         -> Alternating [] t a -> Alternating [] t b
                                         -> [(t,c)]
mergeAlternating :: forall t a b c.
Ord t =>
(t -> a -> b -> c)
-> Alternating [] t a -> Alternating [] t b -> [(t, c)]
mergeAlternating t -> a -> b -> c
f (Alternating a
a00 [(t, a)]
as0)
                   (Alternating b
b00 [(t, b)]
bs0) = a -> b -> [(t, a)] -> [(t, b)] -> [(t, c)]
go a
a00 b
b00 [(t, a)]
as0 [(t, b)]
bs0
  where
    go :: a -> b -> [(t, a)] -> [(t, b)] -> [(t, c)]
go a
a  b
_  []              [(t, b)]
bs               = ((t, b) -> (t, c)) -> [(t, b)] -> [(t, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(t
t,b
b) -> (t
t, t -> a -> b -> c
f t
t a
a b
b)) [(t, b)]
bs
    go a
_  b
b  [(t, a)]
as              []               = ((t, a) -> (t, c)) -> [(t, a)] -> [(t, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(t
t,a
a) -> (t
t, t -> a -> b -> c
f t
t a
a b
b)) [(t, a)]
as
    go a
a0 b
b0 as :: [(t, a)]
as@((t
t, a
a):[(t, a)]
as') bs :: [(t, b)]
bs@((t
t', b
b):[(t, b)]
bs') = case t
t t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` t
t' of
                                                      Ordering
LT -> (t
t , t -> a -> b -> c
f t
t  a
a  b
b0) (t, c) -> [(t, c)] -> [(t, c)]
forall a. a -> [a] -> [a]
: a -> b -> [(t, a)] -> [(t, b)] -> [(t, c)]
go a
a  b
b0 [(t, a)]
as' [(t, b)]
bs
                                                      Ordering
EQ -> (t
t , t -> a -> b -> c
f t
t  a
a  b
b)  (t, c) -> [(t, c)] -> [(t, c)]
forall a. a -> [a] -> [a]
: a -> b -> [(t, a)] -> [(t, b)] -> [(t, c)]
go a
a  b
b  [(t, a)]
as' [(t, b)]
bs'
                                                      Ordering
GT -> (t
t', t -> a -> b -> c
f t
t' a
a0 b
b)  (t, c) -> [(t, c)] -> [(t, c)]
forall a. a -> [a] -> [a]
: a -> b -> [(t, a)] -> [(t, b)] -> [(t, c)]
go a
a0 b
b  [(t, a)]
as  [(t, b)]
bs'

-- | Adds additional t-values in the alternating, (in sorted order). I.e. if we insert a
-- "breakpoint" at time t the current '@a@' value is used at that time.
--
-- >>> insertBreakPoints [0,2,4,6,8,10] $ Alternating "a" [(3, "c"), (5, "e"), (7,"g")]
-- Alternating "a" [(0,"a"),(2,"a"),(3,"c"),(4,"c"),(5,"e"),(6,"e"),(7,"g"),(8,"g"),(10,"g")]
insertBreakPoints                         :: Ord t
                                          => [t] -> Alternating [] t a -> Alternating [] t a
insertBreakPoints :: forall t a.
Ord t =>
[t] -> Alternating [] t a -> Alternating [] t a
insertBreakPoints [t]
ts a :: Alternating [] t a
a@(Alternating a
a0 [(t, a)]
_) =
  a -> [(t, a)] -> Alternating [] t a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
a0 ([(t, a)] -> Alternating [] t a) -> [(t, a)] -> Alternating [] t a
forall a b. (a -> b) -> a -> b
$ (t -> () -> a -> a)
-> Alternating [] t () -> Alternating [] t a -> [(t, a)]
forall t a b c.
Ord t =>
(t -> a -> b -> c)
-> Alternating [] t a -> Alternating [] t b -> [(t, c)]
mergeAlternating (\t
_ ()
_ a
a' -> a
a') (() -> [(t, ())] -> Alternating [] t ()
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating ()
forall a. HasCallStack => a
undefined ((t -> (t, ())) -> [t] -> [(t, ())]
forall a b. (a -> b) -> [a] -> [b]
map (,()) [t]
ts)) Alternating [] t a
a


-- | Reverses an alternating list.
--
-- >>> reverse $ Alternating "a" [(3, "c"), (5, "e"), (7, "g")]
-- Alternating "g" [(7,"e"),(5,"c"),(3,"a")]
reverse                      :: Alternating [] b a -> Alternating [] b a
reverse :: forall b a. Alternating [] b a -> Alternating [] b a
reverse p :: Alternating [] b a
p@(Alternating a
s [(b, a)]
xs) = case [(b, a)] -> Maybe (NonEmpty (b, a))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(b, a)]
xs of
    Maybe (NonEmpty (b, a))
Nothing               -> Alternating [] b a
p
    Just xs1 :: NonEmpty (b, a)
xs1@((b
e1,a
_):|[(b, a)]
tl) -> let ys :: [(b, a)]
ys    = (b
e1, a
s) (b, a) -> [(b, a)] -> [(b, a)]
forall a. a -> [a] -> [a]
: ((b, a) -> (b, a) -> (b, a)) -> [(b, a)] -> [(b, a)] -> [(b, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith (\(b
_, a
v) (b
e, a
_) -> (b
e, a
v)) [(b, a)]
xs [(b, a)]
tl
                                 (b
_,a
t) = NonEmpty (b, a) -> (b, a)
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (b, a)
xs1
                             in a -> [(b, a)] -> Alternating [] b a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
t ([(b, a)] -> [(b, a)]
forall a. [a] -> [a]
List.reverse [(b, a)]
ys)


--------------------------------------------------------------------------------

-- | Given a function f that takes the new element y and the (current) first element x and
-- computes the new separating element s, conses y and the the separator onto alternating
-- list.
--
-- >>> consElemWith (\_ _ -> ".") 0 (fromNonEmptyWith @[] "," (NonEmpty.fromList [1..5]))
-- Alternating 0 [(".",1),(",",2),(",",3),(",",4),(",",5)]
-- >>> consElemWith (\_ _ -> ".") 0 (fromNonEmptyWith @[] "," (NonEmpty.fromList [1]))
-- Alternating 0 [(".",1)]
consElemWith                         :: Cons (f (sep,a)) (f (sep,a)) (sep,a) (sep,a)
                                     => (a -> a -> sep)
                                     -> a
                                     -> Alternating f sep a -> Alternating f sep a
consElemWith :: forall (f :: * -> *) sep a.
Cons (f (sep, a)) (f (sep, a)) (sep, a) (sep, a) =>
(a -> a -> sep) -> a -> Alternating f sep a -> Alternating f sep a
consElemWith a -> a -> sep
f a
y (Alternating a
x0 f (sep, a)
xs) = let s :: sep
s = a -> a -> sep
f a
y a
x0 in
    a -> f (sep, a) -> Alternating f sep a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
y (f (sep, a) -> Alternating f sep a)
-> f (sep, a) -> Alternating f sep a
forall a b. (a -> b) -> a -> b
$ Getting (f (sep, a)) ((sep, a), f (sep, a)) (f (sep, a))
-> ((sep, a), f (sep, a)) -> f (sep, a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview (f (sep, a)) ((sep, a), f (sep, a))
-> Getter ((sep, a), f (sep, a)) (f (sep, a))
forall t b. AReview t b -> Getter b t
re AReview (f (sep, a)) ((sep, a), f (sep, a))
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism
  (f (sep, a))
  (f (sep, a))
  ((sep, a), f (sep, a))
  ((sep, a), f (sep, a))
_Cons) ((sep
s,a
x0), f (sep, a)
xs)
    -- a 're _Cons' is essentially something that when given a tuple (z,zs) turns it into a
    -- z `cons` zs

-- | Uncons the Alternating, getting either just the first element (if there was only one),
-- or the first element, the first separator, and the remaining alternating.
unconsAlt                     :: Cons (f (sep,a)) (f (sep,a)) (sep,a) (sep,a)
                              => Alternating f sep a -> Either a ((a,sep), Alternating f sep a)
unconsAlt :: forall (f :: * -> *) sep a.
Cons (f (sep, a)) (f (sep, a)) (sep, a) (sep, a) =>
Alternating f sep a -> Either a ((a, sep), Alternating f sep a)
unconsAlt (Alternating a
x0 f (sep, a)
xs) = case f (sep, a)
xsf (sep, a)
-> Getting
     (First ((sep, a), f (sep, a))) (f (sep, a)) ((sep, a), f (sep, a))
-> Maybe ((sep, a), f (sep, a))
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting
  (First ((sep, a), f (sep, a))) (f (sep, a)) ((sep, a), f (sep, a))
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism
  (f (sep, a))
  (f (sep, a))
  ((sep, a), f (sep, a))
  ((sep, a), f (sep, a))
_Cons of
  Maybe ((sep, a), f (sep, a))
Nothing           -> a -> Either a ((a, sep), Alternating f sep a)
forall a b. a -> Either a b
Left a
x0
  Just ((sep
s,a
x1),f (sep, a)
xs') -> ((a, sep), Alternating f sep a)
-> Either a ((a, sep), Alternating f sep a)
forall a b. b -> Either a b
Right ((a
x0,sep
s), a -> f (sep, a) -> Alternating f sep a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
x1 f (sep, a)
xs')

--------------------------------------------------------------------------------

-- | Given a function f that takes the (current) last element x, and the new element y,
-- and computes the new separating element s, snocs the separator and y onto the
-- alternating list.
--
-- >>> snocElemWith (\_ _ -> ".") (fromNonEmptyWith @[] "," (NonEmpty.fromList [1..5])) 6
-- Alternating 1 [(",",2),(",",3),(",",4),(",",5),(".",6)]
-- >>> snocElemWith (\_ _ -> ".") (fromNonEmptyWith @[] "," (NonEmpty.fromList [1])) 6
-- Alternating 1 [(".",6)]
snocElemWith                         :: Snoc (f (sep,a)) (f (sep,a)) (sep,a) (sep,a)
                                     => (a -> a -> sep)
                                     -> Alternating f sep a -> a -> Alternating f sep a
snocElemWith :: forall (f :: * -> *) sep a.
Snoc (f (sep, a)) (f (sep, a)) (sep, a) (sep, a) =>
(a -> a -> sep) -> Alternating f sep a -> a -> Alternating f sep a
snocElemWith a -> a -> sep
f (Alternating a
x0 f (sep, a)
xs) a
y = a -> f (sep, a) -> Alternating f sep a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
x0 (f (sep, a) -> Alternating f sep a)
-> f (sep, a) -> Alternating f sep a
forall a b. (a -> b) -> a -> b
$ Getting (f (sep, a)) (f (sep, a), (sep, a)) (f (sep, a))
-> (f (sep, a), (sep, a)) -> f (sep, a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview (f (sep, a)) (f (sep, a), (sep, a))
-> Getter (f (sep, a), (sep, a)) (f (sep, a))
forall t b. AReview t b -> Getter b t
re AReview (f (sep, a)) (f (sep, a), (sep, a))
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
Prism
  (f (sep, a))
  (f (sep, a))
  (f (sep, a), (sep, a))
  (f (sep, a), (sep, a))
_Snoc) (f (sep, a)
xs, (sep
s,a
y))
  -- a 're _Snoc' is essentially something that when given a tuple (zs,z) turns it into a
  -- zs `snoc` z
  where
    s :: sep
s = case f (sep, a)
xsf (sep, a)
-> Getting (First (sep, a)) (f (sep, a)) (sep, a) -> Maybe (sep, a)
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting (First (sep, a)) (f (sep, a)) (sep, a)
forall s a. Snoc s s a a => Traversal' s a
Traversal' (f (sep, a)) (sep, a)
_last of
          Maybe (sep, a)
Nothing    -> a -> a -> sep
f a
x0 a
y
          Just (sep
_,a
x) -> a -> a -> sep
f a
x  a
y


--------------------------------------------------------------------------------

-- | Map over the separators of the alterating together with the neighbours
firstWithNeighbors                       :: Traversable f
                                         => (a -> sep -> a -> sep')
                                         -> Alternating f sep a -> Alternating f sep' a
firstWithNeighbors :: forall (f :: * -> *) a sep sep'.
Traversable f =>
(a -> sep -> a -> sep')
-> Alternating f sep a -> Alternating f sep' a
firstWithNeighbors a -> sep -> a -> sep'
f (Alternating a
x0 f (sep, a)
xs) = a -> f (sep', a) -> Alternating f sep' a
forall (f :: * -> *) sep a. a -> f (sep, a) -> Alternating f sep a
Alternating a
x0 f (sep', a)
xs'
  where
    (a
_, f (sep', a)
xs') = (a -> (sep, a) -> (a, (sep', a)))
-> a -> f (sep, a) -> (a, f (sep', a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (\a
x (sep
sep,a
y) -> (a
y, (a -> sep -> a -> sep'
f a
x sep
sep a
y, a
y))) a
x0 f (sep, a)
xs


-- | Get the separators out of the alternating
separators                    :: Functor f => Alternating f sep a -> f sep
separators :: forall (f :: * -> *) sep a.
Functor f =>
Alternating f sep a -> f sep
separators (Alternating a
_ f (sep, a)
xs) = ((sep, a) -> sep) -> f (sep, a) -> f sep
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (sep, a) -> sep
forall a b. (a, b) -> a
fst f (sep, a)
xs