-- Copyright 2015 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 #-}
-- | A Stream is a collection of 'LEvent.LEvent's which is hopefully sorted in
-- time order.
module Derive.Stream (
    Stream
    -- * construct
    , empty, from_logs, from_event_logs, from_events, from_sorted_list
    , from_event, from_sorted_events
    -- * extract
    , to_list, write_logs, partition, logs_of, events_of, length
    -- * transform
    , take_while, drop_while, cat_maybes
    , sort
    , merge_asc_lists
    , merge_log, merge_logs
    , levent_key
    -- ** specific transformations
    , first, first_last
    -- ** zip
    , zip, zip_on, zip3, zip3_on, zip4
    -- * misc util
    , pretty_short_events, short_events
) where
import Prelude hiding (length, zip, zip3)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.List as List

import qualified Util.Log as Log
import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq

import qualified Derive.LEvent as LEvent
import qualified Derive.PSignal as PSignal
import qualified Derive.Score as Score

import qualified Perform.Signal as Signal
import Global hiding (first)
import Types


{- | A list seems inefficient, since each call appends to the stream.  A block
    call will then append a bunch of events which need to be copied, and
    recopied as part of the larger chunk for the next block call up.  It's
    possible the head of the stream will also be copied every time something
    is appended to it, but I'm not sure about that.  It could also be that the
    number of events is low enough that all the inefficiency doesnt actually
    matter, but I'm not sure.  I need to understand profiling to tell.

    TODO one possibility is a MergeList:

    data MergeList a = Chunk [a] | Merge (MergeList a) (MergeList a)

    This way I don't need to copy large chunks multiple times.  Also, if I make
    sure there is no data dependency between the merge branches, I can evaluate
    them in parallel.

    Each call generates a chunk [Event], and the chunks are then joined with
    (<>).  This means every cons is copied once, but I think this is hard
    to avoid if I want to merge streams.

    TODO the Functor and Traversable can destroy the order, but this isn't
    checked.  Maybe I shouldn't have them?
-}
-- data Stream a = Stream !Sorted ![LEvent.LEvent a]
--     deriving (Show, Functor, Foldable.Foldable, Traversable.Traversable)

-- | Currently I don't actually track order, and just trust the callers.
newtype Stream a = Stream [LEvent.LEvent a]
    deriving (Int -> Stream a -> ShowS
[Stream a] -> ShowS
Stream a -> String
(Int -> Stream a -> ShowS)
-> (Stream a -> String) -> ([Stream a] -> ShowS) -> Show (Stream a)
forall a. Show a => Int -> Stream a -> ShowS
forall a. Show a => [Stream a] -> ShowS
forall a. Show a => Stream a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stream a] -> ShowS
$cshowList :: forall a. Show a => [Stream a] -> ShowS
show :: Stream a -> String
$cshow :: forall a. Show a => Stream a -> String
showsPrec :: Int -> Stream a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stream a -> ShowS
Show, (forall a b. (a -> b) -> Stream a -> Stream b)
-> (forall a b. a -> Stream b -> Stream a) -> Functor Stream
forall a b. a -> Stream b -> Stream a
forall a b. (a -> b) -> Stream a -> Stream 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 -> Stream b -> Stream a
$c<$ :: forall a b. a -> Stream b -> Stream a
fmap :: forall a b. (a -> b) -> Stream a -> Stream b
$cfmap :: forall a b. (a -> b) -> Stream a -> Stream b
Functor)

data Sorted = Unsorted | Sorted deriving (Int -> Sorted -> ShowS
[Sorted] -> ShowS
Sorted -> String
(Int -> Sorted -> ShowS)
-> (Sorted -> String) -> ([Sorted] -> ShowS) -> Show Sorted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sorted] -> ShowS
$cshowList :: [Sorted] -> ShowS
show :: Sorted -> String
$cshow :: Sorted -> String
showsPrec :: Int -> Sorted -> ShowS
$cshowsPrec :: Int -> Sorted -> ShowS
Show, Sorted -> Sorted -> Bool
(Sorted -> Sorted -> Bool)
-> (Sorted -> Sorted -> Bool) -> Eq Sorted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sorted -> Sorted -> Bool
$c/= :: Sorted -> Sorted -> Bool
== :: Sorted -> Sorted -> Bool
$c== :: Sorted -> Sorted -> Bool
Eq)

instance Semigroup Sorted where
    Sorted
Sorted <> :: Sorted -> Sorted -> Sorted
<> Sorted
Sorted = Sorted
Sorted
    Sorted
_ <> Sorted
_ = Sorted
Unsorted
instance Monoid Sorted where
    mempty :: Sorted
mempty = Sorted
Sorted
    mappend :: Sorted -> Sorted -> Sorted
mappend = Sorted -> Sorted -> Sorted
forall a. Semigroup a => a -> a -> a
(<>)

emap :: ([LEvent.LEvent a] -> [LEvent.LEvent b]) -> Stream a -> Stream b
emap :: forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap [LEvent a] -> [LEvent b]
f = [LEvent b] -> Stream b
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent b] -> Stream b)
-> (Stream a -> [LEvent b]) -> Stream a -> Stream b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent b]
f ([LEvent a] -> [LEvent b])
-> (Stream a -> [LEvent a]) -> Stream a -> [LEvent b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

instance Semigroup (Stream Score.Event) where
    Stream Event
s1 <> :: Stream Event -> Stream Event -> Stream Event
<> Stream Event
s2 =
        [LEvent Event] -> Stream Event
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent Event] -> Stream Event) -> [LEvent Event] -> Stream Event
forall a b. (a -> b) -> a -> b
$ (LEvent Event -> RealTime)
-> [LEvent Event] -> [LEvent Event] -> [LEvent Event]
forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
Seq.merge_on LEvent Event -> RealTime
levent_key (Stream Event -> [LEvent Event]
forall a. Stream a -> [LEvent a]
to_list Stream Event
s1) (Stream Event -> [LEvent Event]
forall a. Stream a -> [LEvent a]
to_list Stream Event
s2)
    -- Stream s1 e1 <> Stream s2 e2 = case (s1, s2) of
    --     (Sorted, Sorted) -> from_sorted_list $ Seq.merge_on levent_key e1 e2
    --     _ -> from_list (e1 <> e2)
instance Monoid (Stream Score.Event) where
    mempty :: Stream Event
mempty = [LEvent Event] -> Stream Event
forall a. [LEvent a] -> Stream a
from_sorted_list [LEvent Event]
forall a. Monoid a => a
mempty
    mappend :: Stream Event -> Stream Event -> Stream Event
mappend = Stream Event -> Stream Event -> Stream Event
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Stream Event] -> Stream Event
mconcat = [LEvent Event] -> Stream Event
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent Event] -> Stream Event)
-> ([Stream Event] -> [LEvent Event])
-> [Stream Event]
-> Stream Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEvent Event -> RealTime) -> [[LEvent Event]] -> [LEvent Event]
forall k a. Ord k => (a -> k) -> [[a]] -> [a]
Seq.merge_lists LEvent Event -> RealTime
levent_key ([[LEvent Event]] -> [LEvent Event])
-> ([Stream Event] -> [[LEvent Event]])
-> [Stream Event]
-> [LEvent Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream Event -> [LEvent Event])
-> [Stream Event] -> [[LEvent Event]]
forall a b. (a -> b) -> [a] -> [b]
map Stream Event -> [LEvent Event]
forall a. Stream a -> [LEvent a]
to_list
    -- mconcat streams = from_sorted_list groups
    --     where
    --     groups = Seq.merge_lists levent_key
    --         [events | Stream _ events <- map sort streams]

-- To my surprise, GHC will accept an overlapping instance Monoid (Stream a).
-- Maybe it's ok because it's unambiguous, but I still like specific instances.
-- This means calls have to use Stream.empty instead of mempty, but that's not
-- such a big deal.

instance Semigroup (Stream Signal.Control) where
    Stream Control
s1 <> :: Stream Control -> Stream Control -> Stream Control
<> Stream Control
s2 = [LEvent Control] -> Stream Control
forall a. [LEvent a] -> Stream a
from_sorted_list (Stream Control -> [LEvent Control]
forall a. Stream a -> [LEvent a]
to_list Stream Control
s1 [LEvent Control] -> [LEvent Control] -> [LEvent Control]
forall a. Semigroup a => a -> a -> a
<> Stream Control -> [LEvent Control]
forall a. Stream a -> [LEvent a]
to_list Stream Control
s2)

-- | Signal.Control streams don't need sorted order.
instance Monoid (Stream Signal.Control) where
    mempty :: Stream Control
mempty = Stream Control
forall a. Stream a
empty
    mappend :: Stream Control -> Stream Control -> Stream Control
mappend = Stream Control -> Stream Control -> Stream Control
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup (Stream PSignal.PSignal) where
    Stream PSignal
s1 <> :: Stream PSignal -> Stream PSignal -> Stream PSignal
<> Stream PSignal
s2 = [LEvent PSignal] -> Stream PSignal
forall a. [LEvent a] -> Stream a
from_sorted_list (Stream PSignal -> [LEvent PSignal]
forall a. Stream a -> [LEvent a]
to_list Stream PSignal
s1 [LEvent PSignal] -> [LEvent PSignal] -> [LEvent PSignal]
forall a. Semigroup a => a -> a -> a
<> Stream PSignal -> [LEvent PSignal]
forall a. Stream a -> [LEvent a]
to_list Stream PSignal
s2)
instance Monoid (Stream PSignal.PSignal) where
    mempty :: Stream PSignal
mempty = Stream PSignal
forall a. Stream a
empty
    mappend :: Stream PSignal -> Stream PSignal -> Stream PSignal
mappend = Stream PSignal -> Stream PSignal -> Stream PSignal
forall a. Semigroup a => a -> a -> a
(<>)

instance DeepSeq.NFData a => DeepSeq.NFData (Stream a) where
    rnf :: Stream a -> ()
rnf = [LEvent a] -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf ([LEvent a] -> ()) -> (Stream a -> [LEvent a]) -> Stream a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

instance Pretty a => Pretty (Stream a) where
    -- format (Stream sorted events) =
    --     Pretty.text (showt sorted) Pretty.<+> Pretty.format events
    format :: Stream a -> Doc
format (Stream [LEvent a]
events) = [LEvent a] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [LEvent a]
events

-- * construct

empty :: Stream a
empty :: forall a. Stream a
empty = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list []

from_logs :: [Log.Msg] -> Stream a
from_logs :: forall a. [Msg] -> Stream a
from_logs = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent a] -> Stream a)
-> ([Msg] -> [LEvent a]) -> [Msg] -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Msg -> LEvent a) -> [Msg] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log

from_event_logs :: a -> [Log.Msg] -> Stream a
from_event_logs :: forall a. a -> [Msg] -> Stream a
from_event_logs a
e [Msg]
logs = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list (a -> LEvent a
forall a. a -> LEvent a
LEvent.Event a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: (Msg -> LEvent a) -> [Msg] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs)

from_sorted_list :: [LEvent.LEvent a] -> Stream a
from_sorted_list :: forall a. [LEvent a] -> Stream a
from_sorted_list = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
Stream -- Sorted

from_list :: [LEvent.LEvent a] -> Stream a
from_list :: forall a. [LEvent a] -> Stream a
from_list = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
Stream -- Unsorted

from_events :: [a] -> Stream a
from_events :: forall a. [a] -> Stream a
from_events = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_list ([LEvent a] -> Stream a) -> ([a] -> [LEvent a]) -> [a] -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LEvent a) -> [a] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LEvent a
forall a. a -> LEvent a
LEvent.Event

from_event :: a -> Stream a
from_event :: forall a. a -> Stream a
from_event = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent a] -> Stream a) -> (a -> [LEvent a]) -> a -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
:[]) (LEvent a -> [LEvent a]) -> (a -> LEvent a) -> a -> [LEvent a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LEvent a
forall a. a -> LEvent a
LEvent.Event

-- | Promise that the stream is really sorted.
from_sorted_events :: [a] -> Stream a
from_sorted_events :: forall a. [a] -> Stream a
from_sorted_events = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent a] -> Stream a) -> ([a] -> [LEvent a]) -> [a] -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LEvent a) -> [a] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LEvent a
forall a. a -> LEvent a
LEvent.Event

-- * extract

to_list :: Stream a -> [LEvent.LEvent a]
to_list :: forall a. Stream a -> [LEvent a]
to_list (Stream [LEvent a]
events) = [LEvent a]
events

write_logs :: Log.LogMonad m => Stream a -> m [a]
write_logs :: forall (m :: * -> *) a. LogMonad m => Stream a -> m [a]
write_logs = [LEvent a] -> m [a]
forall (m :: * -> *) d. LogMonad m => [LEvent d] -> m [d]
LEvent.write_logs ([LEvent a] -> m [a])
-> (Stream a -> [LEvent a]) -> Stream a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

partition :: Stream a -> ([a], [Log.Msg])
partition :: forall a. Stream a -> ([a], [Msg])
partition = [LEvent a] -> ([a], [Msg])
forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition ([LEvent a] -> ([a], [Msg]))
-> (Stream a -> [LEvent a]) -> Stream a -> ([a], [Msg])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

logs_of :: Stream a -> [Log.Msg]
logs_of :: forall a. Stream a -> [Msg]
logs_of = [LEvent a] -> [Msg]
forall d. [LEvent d] -> [Msg]
LEvent.logs_of ([LEvent a] -> [Msg])
-> (Stream a -> [LEvent a]) -> Stream a -> [Msg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

events_of :: Stream a -> [a]
events_of :: forall a. Stream a -> [a]
events_of = [LEvent a] -> [a]
forall d. [LEvent d] -> [d]
LEvent.events_of ([LEvent a] -> [a]) -> (Stream a -> [LEvent a]) -> Stream a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

length :: Stream a -> Int
length :: forall a. Stream a -> Int
length = [LEvent a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length ([LEvent a] -> Int) -> (Stream a -> [LEvent a]) -> Stream a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list

-- * transform

take_while :: (a -> Bool) -> Stream a -> Stream a
take_while :: forall a. (a -> Bool) -> Stream a -> Stream a
take_while = ([LEvent a] -> [LEvent a]) -> Stream a -> Stream a
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent a] -> [LEvent a]) -> Stream a -> Stream a)
-> ((a -> Bool) -> [LEvent a] -> [LEvent a])
-> (a -> Bool)
-> Stream a
-> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEvent a -> Bool) -> [LEvent a] -> [LEvent a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((LEvent a -> Bool) -> [LEvent a] -> [LEvent a])
-> ((a -> Bool) -> LEvent a -> Bool)
-> (a -> Bool)
-> [LEvent a]
-> [LEvent a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> LEvent a -> Bool
forall d. (d -> Bool) -> LEvent d -> Bool
LEvent.log_or

drop_while :: (a -> Bool) -> Stream a -> Stream a
drop_while :: forall a. (a -> Bool) -> Stream a -> Stream a
drop_while = ([LEvent a] -> [LEvent a]) -> Stream a -> Stream a
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent a] -> [LEvent a]) -> Stream a -> Stream a)
-> ((a -> Bool) -> [LEvent a] -> [LEvent a])
-> (a -> Bool)
-> Stream a
-> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEvent a -> Bool) -> [LEvent a] -> [LEvent a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((LEvent a -> Bool) -> [LEvent a] -> [LEvent a])
-> ((a -> Bool) -> LEvent a -> Bool)
-> (a -> Bool)
-> [LEvent a]
-> [LEvent a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> LEvent a -> Bool
forall d. (d -> Bool) -> LEvent d -> Bool
LEvent.log_or

-- | 'Data.Maybe.catMaybes' for Stream.
cat_maybes :: Stream (Maybe a) -> Stream a
cat_maybes :: forall a. Stream (Maybe a) -> Stream a
cat_maybes = ([LEvent (Maybe a)] -> [LEvent a]) -> Stream (Maybe a) -> Stream a
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap [LEvent (Maybe a)] -> [LEvent a]
forall {a}. [LEvent (Maybe a)] -> [LEvent a]
go
    where
    go :: [LEvent (Maybe a)] -> [LEvent a]
go [] = []
    go (LEvent (Maybe a)
x : [LEvent (Maybe a)]
xs) = case LEvent (Maybe a)
x of
        LEvent.Log Msg
log -> Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log Msg
log LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent (Maybe a)] -> [LEvent a]
go [LEvent (Maybe a)]
xs
        LEvent.Event (Just a
e) -> a -> LEvent a
forall a. a -> LEvent a
LEvent.Event a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent (Maybe a)] -> [LEvent a]
go [LEvent (Maybe a)]
xs
        LEvent.Event Maybe a
Nothing -> [LEvent (Maybe a)] -> [LEvent a]
go [LEvent (Maybe a)]
xs

sort :: Stream Score.Event -> Stream Score.Event
-- sort s@(Stream Sorted _) = s
-- sort (Stream Unsorted events) =
--     from_sorted_list $ Seq.sort_on levent_key events
sort :: Stream Event -> Stream Event
sort (Stream [LEvent Event]
events) = [LEvent Event] -> Stream Event
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent Event] -> Stream Event) -> [LEvent Event] -> Stream Event
forall a b. (a -> b) -> a -> b
$ (LEvent Event -> RealTime) -> [LEvent Event] -> [LEvent Event]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Seq.sort_on LEvent Event -> RealTime
levent_key [LEvent Event]
events

-- | Merge sorted lists of events.  If the lists themselves are also sorted,
-- I can produce output without scanning the entire input list, so this should
-- be more efficient for a large input list than (<>).
--
-- This assumes all the streams are sorted.  I could check first, but this
-- would destroy the laziness.  Instead, let it be out of order, and Convert
-- will complain about it.
merge_asc_lists :: [Stream Score.Event] -> Stream Score.Event
merge_asc_lists :: [Stream Event] -> Stream Event
merge_asc_lists [Stream Event]
streams = [LEvent Event] -> Stream Event
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent Event] -> Stream Event) -> [LEvent Event] -> Stream Event
forall a b. (a -> b) -> a -> b
$
    (LEvent Event -> RealTime) -> [[LEvent Event]] -> [LEvent Event]
forall k a. Ord k => (a -> k) -> [[a]] -> [a]
Seq.merge_asc_lists LEvent Event -> RealTime
levent_key ((Stream Event -> [LEvent Event])
-> [Stream Event] -> [[LEvent Event]]
forall a b. (a -> b) -> [a] -> [b]
map Stream Event -> [LEvent Event]
forall a. Stream a -> [LEvent a]
to_list [Stream Event]
streams)

-- | This will make logs always merge ahead of score events, but that should
-- be ok.
levent_key :: LEvent.LEvent Score.Event -> RealTime
levent_key :: LEvent Event -> RealTime
levent_key (LEvent.Log Msg
_) = -RealTime
1RealTime -> RealTime -> RealTime
forall a. Fractional a => a -> a -> a
/RealTime
0 -- -Infinity
levent_key (LEvent.Event Event
event) = Event -> RealTime
Score.event_start Event
event

merge_log :: Log.Msg -> Stream a -> Stream a
merge_log :: forall a. Msg -> Stream a -> Stream a
merge_log Msg
log = ([LEvent a] -> [LEvent a]) -> Stream a -> Stream a
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log Msg
log :)

merge_logs :: [Log.Msg] -> Stream e -> Stream e
merge_logs :: forall e. [Msg] -> Stream e -> Stream e
merge_logs [Msg]
logs = ([LEvent e] -> [LEvent e]) -> Stream e -> Stream e
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap ((Msg -> LEvent e) -> [Msg] -> [LEvent e]
forall a b. (a -> b) -> [a] -> [b]
map Msg -> LEvent e
forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs ++)

-- ** specific transformations

-- | Apply to the first Event that matches the predicate.
first :: (a -> Bool) -> (a -> a) -> Stream a -> Stream a
first :: forall a. (a -> Bool) -> (a -> a) -> Stream a -> Stream a
first a -> Bool
matches a -> a
f = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent a] -> Stream a)
-> (Stream a -> [LEvent a]) -> Stream a -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent a]
go ([LEvent a] -> [LEvent a])
-> (Stream a -> [LEvent a]) -> Stream a -> [LEvent a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list
    where
    go :: [LEvent a] -> [LEvent a]
go [] = []
    go (LEvent a
e : [LEvent a]
es) = case LEvent a
e of
        LEvent.Event a
e | a -> Bool
matches a
e -> a -> LEvent a
forall a. a -> LEvent a
LEvent.Event (a -> a
f a
e) LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a]
es
        LEvent a
_ -> LEvent a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
go [LEvent a]
es

-- | Apply to the first and last Event that matches the predicate.  If there
-- are fewer than 2 such events, do nothing.
first_last :: (a -> Bool) -> (a -> a) -> (a -> a) -> Stream a -> Stream a
first_last :: forall a.
(a -> Bool) -> (a -> a) -> (a -> a) -> Stream a -> Stream a
first_last a -> Bool
matches a -> a
start a -> a
end = [LEvent a] -> Stream a
forall a. [LEvent a] -> Stream a
from_sorted_list ([LEvent a] -> Stream a)
-> (Stream a -> [LEvent a]) -> Stream a -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent a]
at_start ([LEvent a] -> [LEvent a])
-> (Stream a -> [LEvent a]) -> Stream a -> [LEvent a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [LEvent a]
forall a. Stream a -> [LEvent a]
to_list
    where
    at_start :: [LEvent a] -> [LEvent a]
at_start [] = []
    at_start (LEvent a
e : [LEvent a]
es) = case LEvent a
e of
        LEvent.Event a
e | a -> Bool
matches a
e ->
            if (LEvent a -> Bool) -> [LEvent a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((a -> Bool) -> (Msg -> Bool) -> LEvent a -> Bool
forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a
LEvent.either a -> Bool
matches (Bool -> Msg -> Bool
forall a b. a -> b -> a
const Bool
False)) [LEvent a]
es
                then a -> LEvent a
forall a. a -> LEvent a
LEvent.Event (a -> a
start a
e) LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
at_end [LEvent a]
es
                else a -> LEvent a
forall a. a -> LEvent a
LEvent.Event a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a]
es
        LEvent a
_ -> LEvent a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
at_start [LEvent a]
es
    at_end :: [LEvent a] -> [LEvent a]
at_end [] = []
    at_end (LEvent a
e : [LEvent a]
es) = case LEvent a
e of
        LEvent.Event a
e | a -> Bool
matches a
e
                Bool -> Bool -> Bool
&& [LEvent a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((LEvent a -> Bool) -> [LEvent a] -> [LEvent a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((a -> Bool) -> LEvent a -> Bool
forall d. (d -> Bool) -> LEvent d -> Bool
LEvent.log_or (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
matches)) [LEvent a]
es) ->
            a -> LEvent a
forall a. a -> LEvent a
LEvent.Event (a -> a
end a
e) LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a]
es
        LEvent a
_ -> LEvent a
e LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
at_end [LEvent a]
es

-- ** zip

zip :: [a] -> Stream x -> Stream (a, x)
zip :: forall a x. [a] -> Stream x -> Stream (a, x)
zip [a]
as = ([LEvent x] -> [LEvent (a, x)]) -> Stream x -> Stream (a, x)
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent x] -> [LEvent (a, x)]) -> Stream x -> Stream (a, x))
-> ([LEvent x] -> [LEvent (a, x)]) -> Stream x -> Stream (a, x)
forall a b. (a -> b) -> a -> b
$ [a] -> [LEvent x] -> [LEvent (a, x)]
forall a x. [a] -> [LEvent x] -> [LEvent (a, x)]
LEvent.zip [a]
as

zip_on :: ([a] -> [b]) -> Stream a -> Stream (b, a)
zip_on :: forall a b. ([a] -> [b]) -> Stream a -> Stream (b, a)
zip_on [a] -> [b]
key = ([LEvent a] -> [LEvent (b, a)]) -> Stream a -> Stream (b, a)
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent a] -> [LEvent (b, a)]) -> Stream a -> Stream (b, a))
-> ([LEvent a] -> [LEvent (b, a)]) -> Stream a -> Stream (b, a)
forall a b. (a -> b) -> a -> b
$ \[LEvent a]
xs -> [b] -> [LEvent a] -> [LEvent (b, a)]
forall a x. [a] -> [LEvent x] -> [LEvent (a, x)]
LEvent.zip ([a] -> [b]
key ([LEvent a] -> [a]
forall d. [LEvent d] -> [d]
LEvent.events_of [LEvent a]
xs)) [LEvent a]
xs

zip3 :: [a] -> [b] -> Stream x -> Stream (a, b, x)
zip3 :: forall a b x. [a] -> [b] -> Stream x -> Stream (a, b, x)
zip3 [a]
as [b]
bs = ([LEvent x] -> [LEvent (a, b, x)]) -> Stream x -> Stream (a, b, x)
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent x] -> [LEvent (a, b, x)])
 -> Stream x -> Stream (a, b, x))
-> ([LEvent x] -> [LEvent (a, b, x)])
-> Stream x
-> Stream (a, b, x)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)]
forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)]
LEvent.zip3 [a]
as [b]
bs

zip3_on :: ([a] -> [b]) -> ([a] -> [c]) -> Stream a -> Stream (b, c, a)
zip3_on :: forall a b c.
([a] -> [b]) -> ([a] -> [c]) -> Stream a -> Stream (b, c, a)
zip3_on [a] -> [b]
key1 [a] -> [c]
key2 = ([LEvent a] -> [LEvent (b, c, a)]) -> Stream a -> Stream (b, c, a)
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent a] -> [LEvent (b, c, a)])
 -> Stream a -> Stream (b, c, a))
-> ([LEvent a] -> [LEvent (b, c, a)])
-> Stream a
-> Stream (b, c, a)
forall a b. (a -> b) -> a -> b
$ \[LEvent a]
xs ->
    [b] -> [c] -> [LEvent a] -> [LEvent (b, c, a)]
forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)]
LEvent.zip3 ([a] -> [b]
key1 ([LEvent a] -> [a]
forall d. [LEvent d] -> [d]
LEvent.events_of [LEvent a]
xs)) ([a] -> [c]
key2 ([LEvent a] -> [a]
forall d. [LEvent d] -> [d]
LEvent.events_of [LEvent a]
xs)) [LEvent a]
xs

zip4 :: [a] -> [b] -> [c] -> Stream x -> Stream (a, b, c, x)
zip4 :: forall a b c x.
[a] -> [b] -> [c] -> Stream x -> Stream (a, b, c, x)
zip4 [a]
as [b]
bs [c]
cs = ([LEvent x] -> [LEvent (a, b, c, x)])
-> Stream x -> Stream (a, b, c, x)
forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (([LEvent x] -> [LEvent (a, b, c, x)])
 -> Stream x -> Stream (a, b, c, x))
-> ([LEvent x] -> [LEvent (a, b, c, x)])
-> Stream x
-> Stream (a, b, c, x)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> [c] -> [LEvent x] -> [LEvent (a, b, c, x)]
forall a b c x.
[a] -> [b] -> [c] -> [LEvent x] -> [LEvent (a, b, c, x)]
LEvent.zip4 [a]
as [b]
bs [c]
cs

-- * misc util

-- | Like 'Score.short_events', but works on a Stream.
pretty_short_events :: Stream Score.Event -> Text
pretty_short_events :: Stream Event -> Text
pretty_short_events = Doc -> Text
forall a. Pretty a => a -> Text
pretty (Doc -> Text) -> (Stream Event -> Doc) -> Stream Event -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> [Text] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
Pretty.formattedList Char
'[' Char
']' ([Text] -> Doc) -> (Stream Event -> [Text]) -> Stream Event -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Event -> [Text]
short_events

short_events :: Stream Score.Event -> [Text]
short_events :: Stream Event -> [Text]
short_events = (LEvent Event -> Text) -> [LEvent Event] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Event -> Text) -> (Msg -> Text) -> LEvent Event -> Text
forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a
LEvent.either Event -> Text
Score.short_event Msg -> Text
forall a. Pretty a => a -> Text
pretty) ([LEvent Event] -> [Text])
-> (Stream Event -> [LEvent Event]) -> Stream Event -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Event -> [LEvent Event]
forall a. Stream a -> [LEvent a]
to_list