--------------------------------------------------------------------------------
-- |
-- Module      :  Data.List.Alternating
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.List.Alternating(
    Alternating(..)
  , withNeighbours
  , mergeAlternating
  , insertBreakPoints
  , reverse
  ) where

import Prelude hiding (reverse)
import Control.Lens
import Data.Bifoldable
import Data.Bitraversable
import Data.Ext
import qualified Data.List as List

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

-- | A (non-empty) alternating list of @a@\'s and @b@\'s
data Alternating a b = Alternating a [b :+ a] deriving (Int -> Alternating a b -> ShowS
[Alternating a b] -> ShowS
Alternating a b -> String
(Int -> Alternating a b -> ShowS)
-> (Alternating a b -> String)
-> ([Alternating a b] -> ShowS)
-> Show (Alternating a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Alternating a b -> ShowS
forall a b. (Show a, Show b) => [Alternating a b] -> ShowS
forall a b. (Show a, Show b) => Alternating a b -> String
showList :: [Alternating a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Alternating a b] -> ShowS
show :: Alternating a b -> String
$cshow :: forall a b. (Show a, Show b) => Alternating a b -> String
showsPrec :: Int -> Alternating a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Alternating a b -> ShowS
Show,Alternating a b -> Alternating a b -> Bool
(Alternating a b -> Alternating a b -> Bool)
-> (Alternating a b -> Alternating a b -> Bool)
-> Eq (Alternating a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
Alternating a b -> Alternating a b -> Bool
/= :: Alternating a b -> Alternating a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
Alternating a b -> Alternating a b -> Bool
== :: Alternating a b -> Alternating a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
Alternating a b -> Alternating a b -> Bool
Eq,Eq (Alternating a b)
Eq (Alternating a b)
-> (Alternating a b -> Alternating a b -> Ordering)
-> (Alternating a b -> Alternating a b -> Bool)
-> (Alternating a b -> Alternating a b -> Bool)
-> (Alternating a b -> Alternating a b -> Bool)
-> (Alternating a b -> Alternating a b -> Bool)
-> (Alternating a b -> Alternating a b -> Alternating a b)
-> (Alternating a b -> Alternating a b -> Alternating a b)
-> Ord (Alternating a b)
Alternating a b -> Alternating a b -> Bool
Alternating a b -> Alternating a b -> Ordering
Alternating a b -> Alternating a b -> Alternating a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (Alternating a b)
forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Bool
forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Ordering
forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Alternating a b
min :: Alternating a b -> Alternating a b -> Alternating a b
$cmin :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Alternating a b
max :: Alternating a b -> Alternating a b -> Alternating a b
$cmax :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Alternating a b
>= :: Alternating a b -> Alternating a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Bool
> :: Alternating a b -> Alternating a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Bool
<= :: Alternating a b -> Alternating a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Bool
< :: Alternating a b -> Alternating a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Bool
compare :: Alternating a b -> Alternating a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
Alternating a b -> Alternating a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (Alternating a b)
Ord)

instance Bifunctor Alternating where
  bimap :: (a -> b) -> (c -> d) -> Alternating a c -> Alternating b d
bimap = (a -> b) -> (c -> d) -> Alternating a c -> Alternating b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifoldable Alternating where
  bifoldMap :: (a -> m) -> (b -> m) -> Alternating a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Alternating a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Bitraversable Alternating where
  bitraverse :: (a -> f c) -> (b -> f d) -> Alternating a b -> f (Alternating c d)
bitraverse a -> f c
f b -> f d
g (Alternating a
a [b :+ a]
xs) = c -> [d :+ c] -> Alternating c d
forall a b. a -> [b :+ a] -> Alternating a b
Alternating (c -> [d :+ c] -> Alternating c d)
-> f c -> f ([d :+ c] -> Alternating c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f ([d :+ c] -> Alternating c d)
-> f [d :+ c] -> f (Alternating c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((b :+ a) -> f (d :+ c)) -> [b :+ a] -> f [d :+ c]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((b -> f d) -> (a -> f c) -> (b :+ a) -> f (d :+ c)
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 b -> f d
g a -> f c
f) [b :+ 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                     :: Alternating a b -> [(a,b :+ a)]
withNeighbours :: Alternating a b -> [(a, b :+ a)]
withNeighbours (Alternating a
a0 [b :+ a]
xs) = let as :: [a]
as = a
a0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((b :+ a) -> a) -> [b :+ a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((b :+ a) -> Getting a (b :+ a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (b :+ a) a
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) [b :+ a]
xs
                                     in [a] -> [b :+ a] -> [(a, b :+ a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [b :+ a]
xs



-- | Generic merging scheme that merges two Alternatings and applies
-- the function '@f@', with the current/new value at every event. So
-- note that if the alternating consists of 'Alternating a0 [t1 :+
-- a1]' 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 a t -> Alternating b t -> [t :+ c]
mergeAlternating :: (t -> a -> b -> c)
-> Alternating a t -> Alternating b t -> [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 -> c -> t :+ c
forall core extra. core -> extra -> core :+ extra
:+ 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 -> c -> t :+ c
forall core extra. core -> extra -> core :+ extra
:+ 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 -> c -> t :+ c
forall core extra. core -> extra -> core :+ extra
:+ 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 -> c -> t :+ c
forall core extra. core -> extra -> core :+ extra
:+ 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 -> c -> t :+ c
forall core extra. core -> extra -> core :+ extra
:+ 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 a t -> Alternating a t
insertBreakPoints :: [t] -> Alternating a t -> Alternating a t
insertBreakPoints [t]
ts a :: Alternating a t
a@(Alternating a
a0 [t :+ a]
_) =
  a -> [t :+ a] -> Alternating a t
forall a b. a -> [b :+ a] -> Alternating a b
Alternating a
a0 ([t :+ a] -> Alternating a t) -> [t :+ a] -> Alternating a t
forall a b. (a -> b) -> a -> b
$ (t -> () -> a -> a)
-> Alternating () t -> Alternating a t -> [t :+ a]
forall t a b c.
Ord t =>
(t -> a -> b -> c)
-> Alternating a t -> Alternating b t -> [t :+ c]
mergeAlternating (\t
_ ()
_ a
a' -> a
a') (() -> [t :+ ()] -> Alternating () t
forall a b. a -> [b :+ a] -> Alternating a b
Alternating ()
forall a. HasCallStack => a
undefined (t -> t :+ ()
forall a. a -> a :+ ()
ext (t -> t :+ ()) -> [t] -> [t :+ ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [t]
ts)) Alternating a t
a


-- | Reverses an alternating list.
--
-- >>> reverse $ Alternating "a" [3 :+ "c", 5 :+ "e", 7 :+ "g"]
-- Alternating "g" [7 :+ "e",5 :+ "c",3 :+ "a"]
reverse                      :: Alternating a b -> Alternating a b
reverse :: Alternating a b -> Alternating a b
reverse p :: Alternating a b
p@(Alternating a
s [b :+ a]
xs) = case [b :+ a]
xs of
    []             -> Alternating a b
p
    ((b
e1 :+ a
_):[b :+ a]
tl) -> let ys :: [b :+ a]
ys = (b
e1 b -> a -> b :+ a
forall core extra. core -> extra -> core :+ extra
:+ 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 b -> a -> b :+ a
forall core extra. core -> extra -> core :+ extra
:+ a
v) [b :+ a]
xs [b :+ a]
tl
                          t :: a
t  = [b :+ a] -> b :+ a
forall a. [a] -> a
last [b :+ a]
xs (b :+ a) -> Getting a (b :+ a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (b :+ a) a
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra
                      in a -> [b :+ a] -> Alternating a b
forall a b. a -> [b :+ a] -> Alternating a b
Alternating a
t ([b :+ a] -> [b :+ a]
forall a. [a] -> [a]
List.reverse [b :+ a]
ys)