{-# LANGUAGE DeriveFunctor #-}
module Derive.Stream (
Stream
, empty, from_logs, from_event_logs, from_events, from_sorted_list
, from_event, from_sorted_events
, to_list, write_logs, partition, logs_of, events_of, length
, take_while, drop_while, cat_maybes
, sort
, merge_asc_lists
, merge_log, merge_logs
, levent_key
, first, first_last
, zip, zip_on, zip3, zip3_on, zip4
, 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.Lists as Lists
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
newtype Stream a = Stream [LEvent.LEvent a]
deriving (Int -> Stream a -> ShowS
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 -> 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
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
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 = 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 = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent b]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a. [LEvent a] -> Stream a
from_sorted_list forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
Lists.mergeOn LEvent Event -> RealTime
levent_key (forall a. Stream a -> [LEvent a]
to_list Stream Event
s1) (forall a. Stream a -> [LEvent a]
to_list Stream Event
s2)
instance Monoid (Stream Score.Event) where
mempty :: Stream Event
mempty = forall a. [LEvent a] -> Stream a
from_sorted_list forall a. Monoid a => a
mempty
mappend :: Stream Event -> Stream Event -> Stream Event
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [Stream Event] -> Stream Event
mconcat = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> k) -> [[a]] -> [a]
Lists.mergeLists LEvent Event -> RealTime
levent_key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Stream a -> [LEvent a]
to_list
instance Semigroup (Stream Signal.Control) where
Stream Control
s1 <> :: Stream Control -> Stream Control -> Stream Control
<> Stream Control
s2 = forall a. [LEvent a] -> Stream a
from_sorted_list (forall a. Stream a -> [LEvent a]
to_list Stream Control
s1 forall a. Semigroup a => a -> a -> a
<> forall a. Stream a -> [LEvent a]
to_list Stream Control
s2)
instance Monoid (Stream Signal.Control) where
mempty :: Stream Control
mempty = forall a. Stream a
empty
mappend :: Stream Control -> Stream Control -> Stream Control
mappend = 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 = forall a. [LEvent a] -> Stream a
from_sorted_list (forall a. Stream a -> [LEvent a]
to_list Stream PSignal
s1 forall a. Semigroup a => a -> a -> a
<> forall a. Stream a -> [LEvent a]
to_list Stream PSignal
s2)
instance Monoid (Stream PSignal.PSignal) where
mempty :: Stream PSignal
mempty = forall a. Stream a
empty
mappend :: Stream PSignal -> Stream PSignal -> Stream PSignal
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance DeepSeq.NFData a => DeepSeq.NFData (Stream a) where
rnf :: Stream a -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
instance Pretty a => Pretty (Stream a) where
format :: Stream a -> Doc
format (Stream [LEvent a]
events) = forall a. Pretty a => a -> Doc
Pretty.format [LEvent a]
events
empty :: Stream a
empty :: forall a. Stream a
empty = forall a. [LEvent a] -> Stream a
from_sorted_list []
from_logs :: [Log.Msg] -> Stream a
from_logs :: forall a. [Msg] -> Stream a
from_logs = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a. [LEvent a] -> Stream a
from_sorted_list (forall a. a -> LEvent a
LEvent.Event a
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a. [LEvent a] -> Stream a
Stream
from_list :: [LEvent.LEvent a] -> Stream a
from_list :: forall a. [LEvent a] -> Stream a
from_list = forall a. [LEvent a] -> Stream a
Stream
from_events :: [a] -> Stream a
from_events :: forall a. [a] -> Stream a
from_events = forall a. [LEvent a] -> Stream a
from_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> LEvent a
LEvent.Event
from_event :: a -> Stream a
from_event :: forall a. a -> Stream a
from_event = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> LEvent a
LEvent.Event
from_sorted_events :: [a] -> Stream a
from_sorted_events :: forall a. [a] -> Stream a
from_sorted_events = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> LEvent a
LEvent.Event
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 = forall (m :: * -> *) d. LogMonad m => [LEvent d] -> m [d]
LEvent.write_logs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
partition :: Stream a -> ([a], [Log.Msg])
partition :: forall a. Stream a -> ([a], [Msg])
partition = forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
logs_of :: Stream a -> [Log.Msg]
logs_of :: forall a. Stream a -> [Msg]
logs_of = forall d. [LEvent d] -> [Msg]
LEvent.logs_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
events_of :: Stream a -> [a]
events_of :: forall a. Stream a -> [a]
events_of = forall d. [LEvent d] -> [d]
LEvent.events_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
length :: Stream a -> Int
length :: forall a. Stream a -> Int
length = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list
take_while :: (a -> Bool) -> Stream a -> Stream a
take_while :: forall a. (a -> Bool) -> Stream a -> Stream a
take_while = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. (d -> Bool) -> LEvent d -> Bool
LEvent.log_or
cat_maybes :: Stream (Maybe a) -> Stream a
cat_maybes :: forall a. Stream (Maybe a) -> Stream a
cat_maybes = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap 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 -> forall a. Msg -> LEvent a
LEvent.Log Msg
log forall a. a -> [a] -> [a]
: [LEvent (Maybe a)] -> [LEvent a]
go [LEvent (Maybe a)]
xs
LEvent.Event (Just a
e) -> forall a. a -> LEvent a
LEvent.Event a
e 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 :: Stream Event -> Stream Event
sort (Stream [LEvent Event]
events) = forall a. [LEvent a] -> Stream a
from_sorted_list forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn LEvent Event -> RealTime
levent_key [LEvent Event]
events
merge_asc_lists :: [Stream Score.Event] -> Stream Score.Event
merge_asc_lists :: [Stream Event] -> Stream Event
merge_asc_lists [Stream Event]
streams = forall a. [LEvent a] -> Stream a
from_sorted_list forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> k) -> [[a]] -> [a]
Lists.mergeAscLists LEvent Event -> RealTime
levent_key (forall a b. (a -> b) -> [a] -> [b]
map forall a. Stream a -> [LEvent a]
to_list [Stream Event]
streams)
levent_key :: LEvent.LEvent Score.Event -> RealTime
levent_key :: LEvent Event -> RealTime
levent_key (LEvent.Log Msg
_) = -RealTime
1forall a. Fractional a => a -> a -> a
/RealTime
0
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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap (forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs ++)
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 = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent a]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. a -> LEvent a
LEvent.Event (a -> a
f a
e) forall a. a -> [a] -> [a]
: [LEvent a]
es
LEvent a
_ -> LEvent a
e forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
go [LEvent a]
es
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 = forall a. [LEvent a] -> Stream a
from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent a] -> [LEvent a]
at_start forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a
LEvent.either a -> Bool
matches (forall a b. a -> b -> a
const Bool
False)) [LEvent a]
es
then forall a. a -> LEvent a
LEvent.Event (a -> a
start a
e) forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
at_end [LEvent a]
es
else forall a. a -> LEvent a
LEvent.Event a
e forall a. a -> [a] -> [a]
: [LEvent a]
es
LEvent a
_ -> LEvent a
e 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
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall d. (d -> Bool) -> LEvent d -> Bool
LEvent.log_or (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
matches)) [LEvent a]
es) ->
forall a. a -> LEvent a
LEvent.Event (a -> a
end a
e) forall a. a -> [a] -> [a]
: [LEvent a]
es
LEvent a
_ -> LEvent a
e forall a. a -> [a] -> [a]
: [LEvent a] -> [LEvent a]
at_end [LEvent a]
es
zip :: [a] -> Stream x -> Stream (a, x)
zip :: forall a x. [a] -> Stream x -> Stream (a, x)
zip [a]
as = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall a b. (a -> b) -> a -> b
$ 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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall a b. (a -> b) -> a -> b
$ \[LEvent a]
xs -> forall a x. [a] -> [LEvent x] -> [LEvent (a, x)]
LEvent.zip ([a] -> [b]
key (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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall a b. (a -> b) -> a -> b
$ 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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall a b. (a -> b) -> a -> b
$ \[LEvent a]
xs ->
forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)]
LEvent.zip3 ([a] -> [b]
key1 (forall d. [LEvent d] -> [d]
LEvent.events_of [LEvent a]
xs)) ([a] -> [c]
key2 (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 = forall a b. ([LEvent a] -> [LEvent b]) -> Stream a -> Stream b
emap forall a b. (a -> b) -> a -> b
$ forall a b c x.
[a] -> [b] -> [c] -> [LEvent x] -> [LEvent (a, b, c, x)]
LEvent.zip4 [a]
as [b]
bs [c]
cs
pretty_short_events :: Stream Score.Event -> Text
pretty_short_events :: Stream Event -> Text
pretty_short_events = forall a. Pretty a => a -> Text
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => Char -> Char -> [a] -> Doc
Pretty.formattedList Char
'[' Char
']' 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a
LEvent.either Event -> Text
Score.short_event forall a. Pretty a => a -> Text
pretty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
to_list