-- Copyright 2013 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 #-} module Derive.LEvent where import Prelude hiding (length, either, log, zip, zip3) import qualified Control.DeepSeq as DeepSeq import qualified Data.Either as Either import qualified Data.List as List import qualified Data.Text as Text import qualified Util.CallStack as CallStack import qualified Util.Log as Log import qualified Util.Pretty as Pretty import Util.Pretty ((<+>)) import qualified Derive.Stack as Stack import Global -- * LEvent data LEvent a = Event !a | Log !Log.Msg deriving (LEvent a -> LEvent a -> Bool (LEvent a -> LEvent a -> Bool) -> (LEvent a -> LEvent a -> Bool) -> Eq (LEvent a) forall a. Eq a => LEvent a -> LEvent a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: LEvent a -> LEvent a -> Bool $c/= :: forall a. Eq a => LEvent a -> LEvent a -> Bool == :: LEvent a -> LEvent a -> Bool $c== :: forall a. Eq a => LEvent a -> LEvent a -> Bool Eq, Int -> LEvent a -> ShowS [LEvent a] -> ShowS LEvent a -> String (Int -> LEvent a -> ShowS) -> (LEvent a -> String) -> ([LEvent a] -> ShowS) -> Show (LEvent a) forall a. Show a => Int -> LEvent a -> ShowS forall a. Show a => [LEvent a] -> ShowS forall a. Show a => LEvent a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [LEvent a] -> ShowS $cshowList :: forall a. Show a => [LEvent a] -> ShowS show :: LEvent a -> String $cshow :: forall a. Show a => LEvent a -> String showsPrec :: Int -> LEvent a -> ShowS $cshowsPrec :: forall a. Show a => Int -> LEvent a -> ShowS Show, (forall a b. (a -> b) -> LEvent a -> LEvent b) -> (forall a b. a -> LEvent b -> LEvent a) -> Functor LEvent forall a b. a -> LEvent b -> LEvent a forall a b. (a -> b) -> LEvent a -> LEvent 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 -> LEvent b -> LEvent a $c<$ :: forall a b. a -> LEvent b -> LEvent a fmap :: forall a b. (a -> b) -> LEvent a -> LEvent b $cfmap :: forall a b. (a -> b) -> LEvent a -> LEvent b Functor, (forall m. Monoid m => LEvent m -> m) -> (forall m a. Monoid m => (a -> m) -> LEvent a -> m) -> (forall m a. Monoid m => (a -> m) -> LEvent a -> m) -> (forall a b. (a -> b -> b) -> b -> LEvent a -> b) -> (forall a b. (a -> b -> b) -> b -> LEvent a -> b) -> (forall b a. (b -> a -> b) -> b -> LEvent a -> b) -> (forall b a. (b -> a -> b) -> b -> LEvent a -> b) -> (forall a. (a -> a -> a) -> LEvent a -> a) -> (forall a. (a -> a -> a) -> LEvent a -> a) -> (forall a. LEvent a -> [a]) -> (forall a. LEvent a -> Bool) -> (forall a. LEvent a -> Int) -> (forall a. Eq a => a -> LEvent a -> Bool) -> (forall a. Ord a => LEvent a -> a) -> (forall a. Ord a => LEvent a -> a) -> (forall a. Num a => LEvent a -> a) -> (forall a. Num a => LEvent a -> a) -> Foldable LEvent forall a. Eq a => a -> LEvent a -> Bool forall a. Num a => LEvent a -> a forall a. Ord a => LEvent a -> a forall m. Monoid m => LEvent m -> m forall a. LEvent a -> Bool forall a. LEvent a -> Int forall a. LEvent a -> [a] forall a. (a -> a -> a) -> LEvent a -> a forall m a. Monoid m => (a -> m) -> LEvent a -> m forall b a. (b -> a -> b) -> b -> LEvent a -> b forall a b. (a -> b -> b) -> b -> LEvent 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 => LEvent a -> a $cproduct :: forall a. Num a => LEvent a -> a sum :: forall a. Num a => LEvent a -> a $csum :: forall a. Num a => LEvent a -> a minimum :: forall a. Ord a => LEvent a -> a $cminimum :: forall a. Ord a => LEvent a -> a maximum :: forall a. Ord a => LEvent a -> a $cmaximum :: forall a. Ord a => LEvent a -> a elem :: forall a. Eq a => a -> LEvent a -> Bool $celem :: forall a. Eq a => a -> LEvent a -> Bool length :: forall a. LEvent a -> Int $clength :: forall a. LEvent a -> Int null :: forall a. LEvent a -> Bool $cnull :: forall a. LEvent a -> Bool toList :: forall a. LEvent a -> [a] $ctoList :: forall a. LEvent a -> [a] foldl1 :: forall a. (a -> a -> a) -> LEvent a -> a $cfoldl1 :: forall a. (a -> a -> a) -> LEvent a -> a foldr1 :: forall a. (a -> a -> a) -> LEvent a -> a $cfoldr1 :: forall a. (a -> a -> a) -> LEvent a -> a foldl' :: forall b a. (b -> a -> b) -> b -> LEvent a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> LEvent a -> b foldl :: forall b a. (b -> a -> b) -> b -> LEvent a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> LEvent a -> b foldr' :: forall a b. (a -> b -> b) -> b -> LEvent a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> LEvent a -> b foldr :: forall a b. (a -> b -> b) -> b -> LEvent a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> LEvent a -> b foldMap' :: forall m a. Monoid m => (a -> m) -> LEvent a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> LEvent a -> m foldMap :: forall m a. Monoid m => (a -> m) -> LEvent a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> LEvent a -> m fold :: forall m. Monoid m => LEvent m -> m $cfold :: forall m. Monoid m => LEvent m -> m Foldable, Functor LEvent Foldable LEvent Functor LEvent -> Foldable LEvent -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> LEvent a -> f (LEvent b)) -> (forall (f :: * -> *) a. Applicative f => LEvent (f a) -> f (LEvent a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> LEvent a -> m (LEvent b)) -> (forall (m :: * -> *) a. Monad m => LEvent (m a) -> m (LEvent a)) -> Traversable LEvent 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 (m :: * -> *) a. Monad m => LEvent (m a) -> m (LEvent a) forall (f :: * -> *) a. Applicative f => LEvent (f a) -> f (LEvent a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> LEvent a -> m (LEvent b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> LEvent a -> f (LEvent b) sequence :: forall (m :: * -> *) a. Monad m => LEvent (m a) -> m (LEvent a) $csequence :: forall (m :: * -> *) a. Monad m => LEvent (m a) -> m (LEvent a) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> LEvent a -> m (LEvent b) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> LEvent a -> m (LEvent b) sequenceA :: forall (f :: * -> *) a. Applicative f => LEvent (f a) -> f (LEvent a) $csequenceA :: forall (f :: * -> *) a. Applicative f => LEvent (f a) -> f (LEvent a) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> LEvent a -> f (LEvent b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> LEvent a -> f (LEvent b) Traversable) instance Pretty d => Pretty (LEvent d) where format :: LEvent d -> Doc format = (d -> Doc) -> (Msg -> Doc) -> LEvent d -> Doc forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a either d -> Doc forall a. Pretty a => a -> Doc Pretty.format Msg -> Doc format_log instance DeepSeq.NFData a => DeepSeq.NFData (LEvent a) where rnf :: LEvent a -> () rnf = (a -> ()) -> (Msg -> ()) -> LEvent a -> () forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a either a -> () forall a. NFData a => a -> () DeepSeq.rnf Msg -> () forall a. NFData a => a -> () DeepSeq.rnf -- | A variation on 'Log.format_msg', except this can format the stack nicely. format_log :: Log.Msg -> Pretty.Doc format_log :: Msg -> Doc format_log Msg msg = Text -> Doc Pretty.text Text stars Doc -> Doc -> Doc <+> Text -> Doc Pretty.text Text caller Doc -> Doc -> Doc <+> Doc -> Doc forall a. Pretty a => a -> Doc Pretty.format Doc stack Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Doc -> Doc Pretty.indent_ (Text -> Doc Pretty.text (Msg -> Text Log.msg_text Msg msg)) where stars :: Text stars = Int -> Text -> Text Text.replicate (Priority -> Int forall a. Enum a => a -> Int fromEnum (Msg -> Priority Log.msg_priority Msg msg)) Text "*" caller :: Text caller = Caller -> Text CallStack.showCaller (Msg -> Caller Log.msg_caller Msg msg) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ": " stack :: Doc stack = case Msg -> Maybe Stack Log.msg_stack Msg msg of Maybe Stack Nothing -> Text -> Doc Pretty.text Text "[]" Just Stack stack -> Stack -> Doc Stack.format_ui Stack stack event :: LEvent a -> Maybe a event :: forall a. LEvent a -> Maybe a event (Event a d) = a -> Maybe a forall a. a -> Maybe a Just a d event LEvent a _ = Maybe a forall a. Maybe a Nothing is_event :: LEvent a -> Bool is_event :: forall a. LEvent a -> Bool is_event (Event {}) = Bool True is_event LEvent a _ = Bool False is_log :: LEvent a -> Bool is_log :: forall a. LEvent a -> Bool is_log (Log {}) = Bool True is_log LEvent a _ = Bool False -- | Always true for logs. Useful for take and drop on events. log_or :: (d -> Bool) -> LEvent d -> Bool log_or :: forall d. (d -> Bool) -> LEvent d -> Bool log_or d -> Bool f = (d -> Bool) -> (Msg -> Bool) -> LEvent d -> Bool forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a either d -> Bool f (Bool -> Msg -> Bool forall a b. a -> b -> a const Bool True) event_or :: (Log.Msg -> Bool) -> LEvent d -> Bool event_or :: forall d. (Msg -> Bool) -> LEvent d -> Bool event_or = (d -> Bool) -> (Msg -> Bool) -> LEvent d -> Bool forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a either (Bool -> d -> Bool forall a b. a -> b -> a const Bool True) -- | Drop while the predicate is true, but keep preceding logs. drop_while :: (a -> Bool) -> [LEvent a] -> [LEvent a] drop_while :: forall a. (a -> Bool) -> [LEvent a] -> [LEvent a] drop_while a -> Bool f = [LEvent a] -> [LEvent a] -> [LEvent a] go [] where go :: [LEvent a] -> [LEvent a] -> [LEvent a] go [LEvent a] accum [] = [LEvent a] -> [LEvent a] forall a. [a] -> [a] reverse [LEvent a] accum go [LEvent a] accum es :: [LEvent a] es@(Event a event : [LEvent a] rest) | a -> Bool f a event = [LEvent a] -> [LEvent a] -> [LEvent a] go [] [LEvent a] rest | Bool otherwise = [LEvent a] -> [LEvent a] forall a. [a] -> [a] reverse [LEvent a] accum [LEvent a] -> [LEvent a] -> [LEvent a] forall a. [a] -> [a] -> [a] ++ [LEvent a] es go [LEvent a] accum (log :: LEvent a log@(Log Msg _) : [LEvent a] rest) = [LEvent a] -> [LEvent a] -> [LEvent a] go (LEvent a logLEvent a -> [LEvent a] -> [LEvent a] forall a. a -> [a] -> [a] :[LEvent a] accum) [LEvent a] rest take_while :: (a -> Bool) -> [LEvent a] -> [LEvent a] take_while :: forall a. (a -> Bool) -> [LEvent a] -> [LEvent a] take_while a -> Bool f = (LEvent a -> Bool) -> [LEvent a] -> [LEvent a] forall a. (a -> Bool) -> [a] -> [a] takeWhile ((a -> Bool) -> LEvent a -> Bool forall d. (d -> Bool) -> LEvent d -> Bool log_or a -> Bool f) either :: (d -> a) -> (Log.Msg -> a) -> LEvent d -> a either :: forall d a. (d -> a) -> (Msg -> a) -> LEvent d -> a either d -> a f1 Msg -> a _ (Event d event) = d -> a f1 d event either d -> a _ Msg -> a f2 (Log Msg log) = Msg -> a f2 Msg log map_log :: (Log.Msg -> Log.Msg) -> LEvent a -> LEvent a map_log :: forall a. (Msg -> Msg) -> LEvent a -> LEvent a map_log Msg -> Msg f (Log Msg log) = Msg -> LEvent a forall a. Msg -> LEvent a Log (Msg -> Msg f Msg log) map_log Msg -> Msg _ LEvent a event = LEvent a event find_event :: (a -> Bool) -> [LEvent a] -> Maybe a find_event :: forall a. (a -> Bool) -> [LEvent a] -> Maybe a find_event a -> Bool _ [] = Maybe a forall a. Maybe a Nothing find_event a -> Bool f (Log Msg _ : [LEvent a] rest) = (a -> Bool) -> [LEvent a] -> Maybe a forall a. (a -> Bool) -> [LEvent a] -> Maybe a find_event a -> Bool f [LEvent a] rest find_event a -> Bool f (Event a event : [LEvent a] rest) | a -> Bool f a event = a -> Maybe a forall a. a -> Maybe a Just a event | Bool otherwise = (a -> Bool) -> [LEvent a] -> Maybe a forall a. (a -> Bool) -> [LEvent a] -> Maybe a find_event a -> Bool f [LEvent a] rest events_of :: [LEvent d] -> [d] events_of :: forall d. [LEvent d] -> [d] events_of [] = [] events_of (Event d e : [LEvent d] rest) = d e d -> [d] -> [d] forall a. a -> [a] -> [a] : [LEvent d] -> [d] forall d. [LEvent d] -> [d] events_of [LEvent d] rest events_of (Log Msg _ : [LEvent d] rest) = [LEvent d] -> [d] forall d. [LEvent d] -> [d] events_of [LEvent d] rest logs_of :: [LEvent d] -> [Log.Msg] logs_of :: forall d. [LEvent d] -> [Msg] logs_of [] = [] logs_of (Log Msg log : [LEvent d] rest) = Msg log Msg -> [Msg] -> [Msg] forall a. a -> [a] -> [a] : [LEvent d] -> [Msg] forall d. [LEvent d] -> [Msg] logs_of [LEvent d] rest logs_of (LEvent d _ : [LEvent d] rest) = [LEvent d] -> [Msg] forall d. [LEvent d] -> [Msg] logs_of [LEvent d] rest write_logs :: Log.LogMonad m => [LEvent d] -> m [d] write_logs :: forall (m :: * -> *) d. LogMonad m => [LEvent d] -> m [d] write_logs [LEvent d] events = (Msg -> m ()) -> [Msg] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Msg -> m () forall (m :: * -> *). LogMonad m => Msg -> m () Log.write [Msg] logs m () -> m [d] -> m [d] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [d] -> m [d] forall (m :: * -> *) a. Monad m => a -> m a return [d] vals where ([d] vals, [Msg] logs) = [LEvent d] -> ([d], [Msg]) forall d. [LEvent d] -> ([d], [Msg]) partition [LEvent d] events write_snd :: Log.LogMonad m => (a, [Log.Msg]) -> m a write_snd :: forall (m :: * -> *) a. LogMonad m => (a, [Msg]) -> m a write_snd (a result, [Msg] logs) = (Msg -> m ()) -> [Msg] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Msg -> m () forall (m :: * -> *). LogMonad m => Msg -> m () Log.write [Msg] logs m () -> m a -> m a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> a -> m a forall (m :: * -> *) a. Monad m => a -> m a return a result write_snd_prefix :: Log.LogMonad m => Text -> (a, [Log.Msg]) -> m a write_snd_prefix :: forall (m :: * -> *) a. LogMonad m => Text -> (a, [Msg]) -> m a write_snd_prefix Text prefix (a result, [Msg] logs) = (Msg -> m ()) -> [Msg] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Msg -> m () forall (m :: * -> *). LogMonad m => Msg -> m () Log.write ((Msg -> Msg) -> [Msg] -> [Msg] forall a b. (a -> b) -> [a] -> [b] map (Text -> Msg -> Msg Log.add_prefix Text prefix) [Msg] logs) m () -> m a -> m a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> a -> m a forall (m :: * -> *) a. Monad m => a -> m a return a result partition :: [LEvent d] -> ([d], [Log.Msg]) partition :: forall d. [LEvent d] -> ([d], [Msg]) partition = [Either d Msg] -> ([d], [Msg]) forall a b. [Either a b] -> ([a], [b]) Either.partitionEithers ([Either d Msg] -> ([d], [Msg])) -> ([LEvent d] -> [Either d Msg]) -> [LEvent d] -> ([d], [Msg]) forall b c a. (b -> c) -> (a -> b) -> a -> c . (LEvent d -> Either d Msg) -> [LEvent d] -> [Either d Msg] forall a b. (a -> b) -> [a] -> [b] map LEvent d -> Either d Msg forall {a}. LEvent a -> Either a Msg to_either where to_either :: LEvent a -> Either a Msg to_either (Event a d) = a -> Either a Msg forall a b. a -> Either a b Left a d to_either (Log Msg msg) = Msg -> Either a Msg forall a b. b -> Either a b Right Msg msg -- | This is similar to 'List.mapAccumL', but lifted into LEvents. It also -- passes future events to the function. map_accum :: (state -> a -> [a] -> (state, [b])) -> state -> [LEvent a] -> (state, [[LEvent b]]) map_accum :: forall state a b. (state -> a -> [a] -> (state, [b])) -> state -> [LEvent a] -> (state, [[LEvent b]]) map_accum state -> a -> [a] -> (state, [b]) f state state [LEvent a] events = (state -> (LEvent a, [LEvent a]) -> (state, [LEvent b])) -> state -> [(LEvent a, [LEvent a])] -> (state, [[LEvent b]]) forall (t :: * -> *) s a b. Traversable t => (s -> a -> (s, b)) -> s -> t a -> (s, t b) List.mapAccumL state -> (LEvent a, [LEvent a]) -> (state, [LEvent b]) process state state ([LEvent a] -> [[LEvent a]] -> [(LEvent a, [LEvent a])] forall a b. [a] -> [b] -> [(a, b)] List.zip [LEvent a] events (Int -> [[LEvent a]] -> [[LEvent a]] forall a. Int -> [a] -> [a] drop Int 1 ([LEvent a] -> [[LEvent a]] forall a. [a] -> [[a]] List.tails [LEvent a] events))) where process :: state -> (LEvent a, [LEvent a]) -> (state, [LEvent b]) process state st (Event a event, [LEvent a] future_events) = ([b] -> [LEvent b]) -> (state, [b]) -> (state, [LEvent b]) forall (p :: * -> * -> *) b c a. Bifunctor p => (b -> c) -> p a b -> p a c second ((b -> LEvent b) -> [b] -> [LEvent b] forall a b. (a -> b) -> [a] -> [b] map b -> LEvent b forall a. a -> LEvent a Event) (state -> a -> [a] -> (state, [b]) f state st a event ([LEvent a] -> [a] forall d. [LEvent d] -> [d] events_of [LEvent a] future_events)) process state st (Log Msg log, [LEvent a] _) = (state st, [Msg -> LEvent b forall a. Msg -> LEvent a Log Msg log]) -- | Like 'map_accum', but provide past and future events to the function. map_around :: ([a] -> a -> [a] -> [b]) -> [LEvent a] -> [[LEvent b]] map_around :: forall a b. ([a] -> a -> [a] -> [b]) -> [LEvent a] -> [[LEvent b]] map_around [a] -> a -> [a] -> [b] f = ([a], [[LEvent b]]) -> [[LEvent b]] forall a b. (a, b) -> b snd (([a], [[LEvent b]]) -> [[LEvent b]]) -> ([LEvent a] -> ([a], [[LEvent b]])) -> [LEvent a] -> [[LEvent b]] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([a] -> a -> [a] -> ([a], [b])) -> [a] -> [LEvent a] -> ([a], [[LEvent b]]) forall state a b. (state -> a -> [a] -> (state, [b])) -> state -> [LEvent a] -> (state, [[LEvent b]]) map_accum (\[a] prev a event [a] next -> (a event a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] prev, [a] -> a -> [a] -> [b] f [a] prev a event [a] next)) [] zip :: [a] -> [LEvent x] -> [LEvent (a, x)] zip :: forall a x. [a] -> [LEvent x] -> [LEvent (a, x)] zip [a] as (Log Msg x : [LEvent x] xs) = Msg -> LEvent (a, x) forall a. Msg -> LEvent a Log Msg x LEvent (a, x) -> [LEvent (a, x)] -> [LEvent (a, x)] forall a. a -> [a] -> [a] : [a] -> [LEvent x] -> [LEvent (a, x)] forall a x. [a] -> [LEvent x] -> [LEvent (a, x)] zip [a] as [LEvent x] xs zip (a a:[a] as) (Event x x : [LEvent x] xs) = (a, x) -> LEvent (a, x) forall a. a -> LEvent a Event (a a, x x) LEvent (a, x) -> [LEvent (a, x)] -> [LEvent (a, x)] forall a. a -> [a] -> [a] : [a] -> [LEvent x] -> [LEvent (a, x)] forall a x. [a] -> [LEvent x] -> [LEvent (a, x)] zip [a] as [LEvent x] xs zip [a] _ [LEvent x] _ = [] zip3 :: [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] zip3 :: forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] zip3 [a] as [b] bs (Log Msg x : [LEvent x] xs) = Msg -> LEvent (a, b, x) forall a. Msg -> LEvent a Log Msg x LEvent (a, b, x) -> [LEvent (a, b, x)] -> [LEvent (a, b, x)] forall a. a -> [a] -> [a] : [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] zip3 [a] as [b] bs [LEvent x] xs zip3 (a a:[a] as) (b b:[b] bs) (Event x x : [LEvent x] xs) = (a, b, x) -> LEvent (a, b, x) forall a. a -> LEvent a Event (a a, b b, x x) LEvent (a, b, x) -> [LEvent (a, b, x)] -> [LEvent (a, b, x)] forall a. a -> [a] -> [a] : [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] forall a b x. [a] -> [b] -> [LEvent x] -> [LEvent (a, b, x)] zip3 [a] as [b] bs [LEvent x] xs zip3 [a] _ [b] _ [LEvent x] _ = [] zip4 :: [a] -> [b] -> [c] -> [LEvent x] -> [LEvent (a, b, c, x)] zip4 :: forall a b c x. [a] -> [b] -> [c] -> [LEvent x] -> [LEvent (a, b, c, x)] zip4 [a] as [b] bs [c] cs (Log Msg x : [LEvent x] xs) = Msg -> LEvent (a, b, c, x) forall a. Msg -> LEvent a Log Msg x LEvent (a, b, c, x) -> [LEvent (a, b, c, x)] -> [LEvent (a, b, c, x)] forall a. a -> [a] -> [a] : [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)] zip4 [a] as [b] bs [c] cs [LEvent x] xs zip4 (a a:[a] as) (b b:[b] bs) (c c:[c] cs) (Event x x : [LEvent x] xs) = (a, b, c, x) -> LEvent (a, b, c, x) forall a. a -> LEvent a Event (a a, b b, c c, x x) LEvent (a, b, c, x) -> [LEvent (a, b, c, x)] -> [LEvent (a, b, c, x)] forall a. a -> [a] -> [a] : [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)] zip4 [a] as [b] bs [c] cs [LEvent x] xs zip4 [a] _ [b] _ [c] _ [LEvent x] _ = []