-- Copyright 2019 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-- | EList is a stream of elements, which may either carry a value, or be
-- some kind of metadata, and functions to process values and ignore the
-- metadata.
module Util.EList where
import           Prelude hiding (concatMap, either, map, zip, zip3)
import qualified Control.Monad.Identity as Identity
import qualified Data.Bifunctor as Bifunctor
import           Data.Bifunctor (first, second)


-- TODO I don't like the Elt and Meta names.
-- TODO implement Derive.LEvent and Derive.Call.Post with this.

data Elt e a = Meta !e | Elt !a
    deriving (Elt e a -> Elt e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Elt e a -> Elt e a -> Bool
/= :: Elt e a -> Elt e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Elt e a -> Elt e a -> Bool
== :: Elt e a -> Elt e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Elt e a -> Elt e a -> Bool
Eq, Int -> Elt e a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Elt e a -> ShowS
forall e a. (Show e, Show a) => [Elt e a] -> ShowS
forall e a. (Show e, Show a) => Elt e a -> String
showList :: [Elt e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Elt e a] -> ShowS
show :: Elt e a -> String
$cshow :: forall e a. (Show e, Show a) => Elt e a -> String
showsPrec :: Int -> Elt e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Elt e a -> ShowS
Show, forall a b. a -> Elt e b -> Elt e a
forall a b. (a -> b) -> Elt e a -> Elt e b
forall e a b. a -> Elt e b -> Elt e a
forall e a b. (a -> b) -> Elt e a -> Elt e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Elt e b -> Elt e a
$c<$ :: forall e a b. a -> Elt e b -> Elt e a
fmap :: forall a b. (a -> b) -> Elt e a -> Elt e b
$cfmap :: forall e a b. (a -> b) -> Elt e a -> Elt e b
Functor, forall a. Elt e a -> Bool
forall e a. Eq a => a -> Elt e a -> Bool
forall e a. Num a => Elt e a -> a
forall e a. Ord a => Elt e a -> a
forall e m. Monoid m => Elt e m -> m
forall m a. Monoid m => (a -> m) -> Elt e a -> m
forall e a. Elt e a -> Bool
forall e a. Elt e a -> Int
forall e a. Elt e a -> [a]
forall a b. (a -> b -> b) -> b -> Elt e a -> b
forall e a. (a -> a -> a) -> Elt e a -> a
forall e m a. Monoid m => (a -> m) -> Elt e a -> m
forall e b a. (b -> a -> b) -> b -> Elt e a -> b
forall e a b. (a -> b -> b) -> b -> Elt e a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Elt e a -> a
$cproduct :: forall e a. Num a => Elt e a -> a
sum :: forall a. Num a => Elt e a -> a
$csum :: forall e a. Num a => Elt e a -> a
minimum :: forall a. Ord a => Elt e a -> a
$cminimum :: forall e a. Ord a => Elt e a -> a
maximum :: forall a. Ord a => Elt e a -> a
$cmaximum :: forall e a. Ord a => Elt e a -> a
elem :: forall a. Eq a => a -> Elt e a -> Bool
$celem :: forall e a. Eq a => a -> Elt e a -> Bool
length :: forall a. Elt e a -> Int
$clength :: forall e a. Elt e a -> Int
null :: forall a. Elt e a -> Bool
$cnull :: forall e a. Elt e a -> Bool
toList :: forall a. Elt e a -> [a]
$ctoList :: forall e a. Elt e a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Elt e a -> a
$cfoldl1 :: forall e a. (a -> a -> a) -> Elt e a -> a
foldr1 :: forall a. (a -> a -> a) -> Elt e a -> a
$cfoldr1 :: forall e a. (a -> a -> a) -> Elt e a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Elt e a -> b
$cfoldl' :: forall e b a. (b -> a -> b) -> b -> Elt e a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Elt e a -> b
$cfoldl :: forall e b a. (b -> a -> b) -> b -> Elt e a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Elt e a -> b
$cfoldr' :: forall e a b. (a -> b -> b) -> b -> Elt e a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Elt e a -> b
$cfoldr :: forall e a b. (a -> b -> b) -> b -> Elt e a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Elt e a -> m
$cfoldMap' :: forall e m a. Monoid m => (a -> m) -> Elt e a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Elt e a -> m
$cfoldMap :: forall e m a. Monoid m => (a -> m) -> Elt e a -> m
fold :: forall m. Monoid m => Elt e m -> m
$cfold :: forall e m. Monoid m => Elt e m -> m
Foldable, forall e. Functor (Elt e)
forall e. Foldable (Elt e)
forall e (m :: * -> *) a. Monad m => Elt e (m a) -> m (Elt e a)
forall e (f :: * -> *) a.
Applicative f =>
Elt e (f a) -> f (Elt e a)
forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elt e a -> m (Elt e b)
forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elt e a -> f (Elt e b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elt e a -> f (Elt e b)
sequence :: forall (m :: * -> *) a. Monad m => Elt e (m a) -> m (Elt e a)
$csequence :: forall e (m :: * -> *) a. Monad m => Elt e (m a) -> m (Elt e a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elt e a -> m (Elt e b)
$cmapM :: forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elt e a -> m (Elt e b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Elt e (f a) -> f (Elt e a)
$csequenceA :: forall e (f :: * -> *) a.
Applicative f =>
Elt e (f a) -> f (Elt e a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elt e a -> f (Elt e b)
$ctraverse :: forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elt e a -> f (Elt e b)
Traversable)

instance Bifunctor.Bifunctor Elt where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Elt a c -> Elt b d
bimap a -> b
f c -> d
_ (Meta a
e) = forall e a. e -> Elt e a
Meta (a -> b
f a
e)
    bimap a -> b
_ c -> d
g (Elt c
a) = forall e a. a -> Elt e a
Elt (c -> d
g c
a)

metas :: [Elt e a] -> [e]
metas :: forall e a. [Elt e a] -> [e]
metas [] = []
metas (Meta e
e : [Elt e a]
as) = e
e forall a. a -> [a] -> [a]
: forall e a. [Elt e a] -> [e]
metas [Elt e a]
as
metas (Elt a
_ : [Elt e a]
as) = forall e a. [Elt e a] -> [e]
metas [Elt e a]
as

elts :: [Elt e a] -> [a]
elts :: forall e a. [Elt e a] -> [a]
elts [] = []
elts (Meta e
_ : [Elt e a]
as) = forall e a. [Elt e a] -> [a]
elts [Elt e a]
as
elts (Elt a
a : [Elt e a]
as) = a
a forall a. a -> [a] -> [a]
: forall e a. [Elt e a] -> [a]
elts [Elt e a]
as

partition :: [Elt e a] -> ([e], [a])
partition :: forall e a. [Elt e a] -> ([e], [a])
partition [] = ([], [])
partition (Meta e
e : [Elt e a]
as) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (e
e:) (forall e a. [Elt e a] -> ([e], [a])
partition [Elt e a]
as)
partition (Elt a
a : [Elt e a]
as) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
a:) (forall e a. [Elt e a] -> ([e], [a])
partition [Elt e a]
as)

either :: (e -> b) -> (a -> b) -> Elt e a -> b
either :: forall e b a. (e -> b) -> (a -> b) -> Elt e a -> b
either e -> b
f a -> b
_ (Meta e
e) = e -> b
f e
e
either e -> b
_ a -> b
g (Elt a
a) = a -> b
g a
a

fromEither :: Either e a -> Elt e a
fromEither :: forall e a. Either e a -> Elt e a
fromEither (Left e
e) = forall e a. e -> Elt e a
Meta e
e
fromEither (Right a
a) = forall e a. a -> Elt e a
Elt a
a

toEither :: Elt e a -> Either e a
toEither :: forall e a. Elt e a -> Either e a
toEither (Meta e
e) = forall a b. a -> Either a b
Left e
e
toEither (Elt a
a) = forall a b. b -> Either a b
Right a
a

map :: (a -> b) -> [Elt e a] -> [Elt e b]
map :: forall a b e. (a -> b) -> [Elt e a] -> [Elt e b]
map = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

mapM :: Applicative m => (a -> m b) -> [Elt e a] -> m [Elt e b]
mapM :: forall (m :: * -> *) a b e.
Applicative m =>
(a -> m b) -> [Elt e a] -> m [Elt e b]
mapM = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

-- | Like 'traverse', but the function can return Meta.
apply :: Applicative m => (a -> m (Elt e b)) -> Elt e a -> m (Elt e b)
apply :: forall (m :: * -> *) a e b.
Applicative m =>
(a -> m (Elt e b)) -> Elt e a -> m (Elt e b)
apply a -> m (Elt e b)
_ (Meta e
e) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. e -> Elt e a
Meta e
e
apply a -> m (Elt e b)
f (Elt a
a) = a -> m (Elt e b)
f a
a

-- | Like 'map', except the function can also return Meta.
mapE :: (a -> Elt e b) -> [Elt e a] -> [Elt e b]
mapE :: forall a e b. (a -> Elt e b) -> [Elt e a] -> [Elt e b]
mapE a -> Elt e b
f = forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a e b.
Applicative m =>
(a -> m (Elt e b)) -> [Elt e a] -> m [Elt e b]
mapEM (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Elt e b
f)

mapEM :: Applicative m => (a -> m (Elt e b)) -> [Elt e a] -> m [Elt e b]
mapEM :: forall (m :: * -> *) a e b.
Applicative m =>
(a -> m (Elt e b)) -> [Elt e a] -> m [Elt e b]
mapEM a -> m (Elt e b)
f = [Elt e a] -> m [Elt e b]
go
    where
    go :: [Elt e a] -> m [Elt e b]
go (Meta e
e : [Elt e a]
as) = (forall e a. e -> Elt e a
Meta e
e :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Elt e a] -> m [Elt e b]
go [Elt e a]
as
    go (Elt a
a : [Elt e a]
as) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Elt e b)
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Elt e a] -> m [Elt e b]
go [Elt e a]
as
    go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

concatMapE :: (a -> [Elt e b]) -> [Elt e a] -> [Elt e b]
concatMapE :: forall a e b. (a -> [Elt e b]) -> [Elt e a] -> [Elt e b]
concatMapE a -> [Elt e b]
f = forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a e b.
Applicative m =>
(a -> m [Elt e b]) -> [Elt e a] -> m [Elt e b]
concatMapEM (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Elt e b]
f)

concatMapEM :: Applicative m => (a -> m [Elt e b]) -> [Elt e a] -> m [Elt e b]
concatMapEM :: forall (m :: * -> *) a e b.
Applicative m =>
(a -> m [Elt e b]) -> [Elt e a] -> m [Elt e b]
concatMapEM a -> m [Elt e b]
f = [Elt e a] -> m [Elt e b]
go
    where
    go :: [Elt e a] -> m [Elt e b]
go (Meta e
e : [Elt e a]
as) = (forall e a. e -> Elt e a
Meta e
e :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Elt e a] -> m [Elt e b]
go [Elt e a]
as
    go (Elt a
a : [Elt e a]
as) = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m [Elt e b]
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Elt e a] -> m [Elt e b]
go [Elt e a]
as
    go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

mapAccumLE :: (state -> a -> (state, Elt e b)) -> state -> [Elt e a]
    -> (state, [Elt e b])
mapAccumLE :: forall state a e b.
(state -> a -> (state, Elt e b))
-> state -> [Elt e a] -> (state, [Elt e b])
mapAccumLE state -> a -> (state, Elt e b)
f = state -> [Elt e a] -> (state, [Elt e b])
go
    where
    go :: state -> [Elt e a] -> (state, [Elt e b])
go state
state (Meta e
e : [Elt e a]
as) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall e a. e -> Elt e a
Meta e
e :) (state -> [Elt e a] -> (state, [Elt e b])
go state
state [Elt e a]
as)
    go state
state (Elt a
a : [Elt e a]
as) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Elt e b
b:) (state -> [Elt e a] -> (state, [Elt e b])
go state
state2 [Elt e a]
as)
        where (state
state2, Elt e b
b) = state -> a -> (state, Elt e b)
f state
state a
a
    go state
state [] = (state
state, [])

zip :: [a] -> [Elt e b] -> [Elt e (a, b)]
zip :: forall a e b. [a] -> [Elt e b] -> [Elt e (a, b)]
zip [a]
as (Meta e
b : [Elt e b]
bs) = forall e a. e -> Elt e a
Meta e
b forall a. a -> [a] -> [a]
: forall a e b. [a] -> [Elt e b] -> [Elt e (a, b)]
zip [a]
as [Elt e b]
bs
zip (a
a:[a]
as) (Elt b
b : [Elt e b]
bs) = forall e a. a -> Elt e a
Elt (a
a, b
b) forall a. a -> [a] -> [a]
: forall a e b. [a] -> [Elt e b] -> [Elt e (a, b)]
zip [a]
as [Elt e b]
bs
zip [a]
_ [Elt e b]
_ = []

zipPaddedSnd :: [a] -> [Elt e b] -> [Elt e (a, Maybe b)]
zipPaddedSnd :: forall a e b. [a] -> [Elt e b] -> [Elt e (a, Maybe b)]
zipPaddedSnd [a]
as (Meta e
b : [Elt e b]
bs) = forall e a. e -> Elt e a
Meta e
b forall a. a -> [a] -> [a]
: forall a e b. [a] -> [Elt e b] -> [Elt e (a, Maybe b)]
zipPaddedSnd [a]
as [Elt e b]
bs
zipPaddedSnd (a
a:[a]
as) (Elt b
b : [Elt e b]
bs) = forall e a. a -> Elt e a
Elt (a
a, forall a. a -> Maybe a
Just b
b) forall a. a -> [a] -> [a]
: forall a e b. [a] -> [Elt e b] -> [Elt e (a, Maybe b)]
zipPaddedSnd [a]
as [Elt e b]
bs
zipPaddedSnd (a
a:[a]
as) [] = forall e a. a -> Elt e a
Elt (a
a, forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: forall a e b. [a] -> [Elt e b] -> [Elt e (a, Maybe b)]
zipPaddedSnd [a]
as []
zipPaddedSnd [] [Elt e b]
_ = []

zip3 :: [a] -> [b] -> [Elt e c] -> [Elt e (a, b, c)]
zip3 :: forall a b e c. [a] -> [b] -> [Elt e c] -> [Elt e (a, b, c)]
zip3 [a]
as [b]
bs (Meta e
c : [Elt e c]
cs) = forall e a. e -> Elt e a
Meta e
c forall a. a -> [a] -> [a]
: forall a b e c. [a] -> [b] -> [Elt e c] -> [Elt e (a, b, c)]
zip3 [a]
as [b]
bs [Elt e c]
cs
zip3 (a
a:[a]
as) (b
b:[b]
bs) (Elt c
c : [Elt e c]
cs) = forall e a. a -> Elt e a
Elt (a
a, b
b, c
c) forall a. a -> [a] -> [a]
: forall a b e c. [a] -> [b] -> [Elt e c] -> [Elt e (a, b, c)]
zip3 [a]
as [b]
bs [Elt e c]
cs
zip3 [a]
_ [b]
_ [Elt e c]
_ = []

zip4 :: [a] -> [b] -> [c] -> [Elt e d] -> [Elt e (a, b, c, d)]
zip4 :: forall a b c e d.
[a] -> [b] -> [c] -> [Elt e d] -> [Elt e (a, b, c, d)]
zip4 [a]
as [b]
bs [c]
cs (Meta e
d : [Elt e d]
ds) = forall e a. e -> Elt e a
Meta e
d forall a. a -> [a] -> [a]
: forall a b c e d.
[a] -> [b] -> [c] -> [Elt e d] -> [Elt e (a, b, c, d)]
zip4 [a]
as [b]
bs [c]
cs [Elt e d]
ds
zip4 (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (Elt d
d : [Elt e d]
ds) = forall e a. a -> Elt e a
Elt (a
a, b
b, c
c, d
d) forall a. a -> [a] -> [a]
: forall a b c e d.
[a] -> [b] -> [c] -> [Elt e d] -> [Elt e (a, b, c, d)]
zip4 [a]
as [b]
bs [c]
cs [Elt e d]
ds
zip4 [a]
_ [b]
_ [c]
_ [Elt e d]
_ = []

zipNexts :: [Elt e a] -> [Elt e (a, [a])]
zipNexts :: forall e a. [Elt e a] -> [Elt e (a, [a])]
zipNexts (Meta e
e : [Elt e a]
as) = forall e a. e -> Elt e a
Meta e
e forall a. a -> [a] -> [a]
: forall e a. [Elt e a] -> [Elt e (a, [a])]
zipNexts [Elt e a]
as
zipNexts (Elt a
a : [Elt e a]
as) = forall e a. a -> Elt e a
Elt (a
a, forall e a. [Elt e a] -> [a]
elts [Elt e a]
as) forall a. a -> [a] -> [a]
: forall e a. [Elt e a] -> [Elt e (a, [a])]
zipNexts [Elt e a]
as
zipNexts [] = []