{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}

module Test.Sandwich.TestTimer where

import Control.Concurrent
import Control.Exception.Safe
import Control.Lens
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.State
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as L
import qualified Data.Sequence as S
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock.POSIX
import System.Directory
import System.FilePath
import System.IO
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Test.Sandwich.Types.TestTimer
import Test.Sandwich.Util (whenJust)


type EventName = T.Text
type ProfileName = T.Text

-- * User functions

-- | Time a given action with a given event name. This name will be the "stack frame" of the given action in the profiling results. This function will use the current timing profile name.
timeAction :: (MonadMask m, MonadIO m, MonadReader context m, HasBaseContext context, HasTestTimer context) => EventName -> m a -> m a
timeAction :: EventName -> m a -> m a
timeAction EventName
eventName m a
action = do
  TestTimer
tt <- (context -> TestTimer) -> m TestTimer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks context -> TestTimer
forall context. HasTestTimer context => context -> TestTimer
getTestTimer
  BaseContext {EventName
baseContextTestTimerProfile :: BaseContext -> EventName
baseContextTestTimerProfile :: EventName
baseContextTestTimerProfile} <- (context -> BaseContext) -> m BaseContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks context -> BaseContext
forall a. HasBaseContext a => a -> BaseContext
getBaseContext
  TestTimer -> EventName -> EventName -> m a -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
TestTimer -> EventName -> EventName -> m a -> m a
timeAction' TestTimer
tt EventName
baseContextTestTimerProfile EventName
eventName m a
action

-- | Time a given action with a given profile name and event name. Use when you want to manually specify the profile name.
timeActionByProfile :: (MonadMask m, MonadIO m, MonadReader context m, HasTestTimer context) => ProfileName -> EventName -> m a -> m a
timeActionByProfile :: EventName -> EventName -> m a -> m a
timeActionByProfile EventName
profileName EventName
eventName m a
action = do
  TestTimer
tt <- (context -> TestTimer) -> m TestTimer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks context -> TestTimer
forall context. HasTestTimer context => context -> TestTimer
getTestTimer
  TestTimer -> EventName -> EventName -> m a -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
TestTimer -> EventName -> EventName -> m a -> m a
timeAction' TestTimer
tt EventName
profileName EventName
eventName m a
action

-- | Introduce a new timing profile name.
withTimingProfile :: (Monad m) => ProfileName -> SpecFree (LabelValue "testTimerProfile" TestTimerProfile :> context) m () -> SpecFree context m ()
withTimingProfile :: EventName
-> SpecFree
     (LabelValue "testTimerProfile" TestTimerProfile :> context) m ()
-> SpecFree context m ()
withTimingProfile EventName
name = NodeOptions
-> String
-> Label "testTimerProfile" TestTimerProfile
-> ExampleT context m TestTimerProfile
-> (TestTimerProfile -> ExampleT context m ())
-> SpecFree
     (LabelValue "testTimerProfile" TestTimerProfile :> context) m ()
-> SpecFree context m ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
timingNodeOptions [i|Switch test timer profile to '#{name}'|] Label "testTimerProfile" TestTimerProfile
testTimerProfile (TestTimerProfile -> ExampleT context m TestTimerProfile
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTimerProfile -> ExampleT context m TestTimerProfile)
-> TestTimerProfile -> ExampleT context m TestTimerProfile
forall a b. (a -> b) -> a -> b
$ EventName -> TestTimerProfile
TestTimerProfile EventName
name) (\TestTimerProfile
_ -> () -> ExampleT context m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Introduce a new timing profile name dynamically. The given 'ExampleT' should come up with the name and return it.
withTimingProfile' :: (Monad m) => ExampleT context m ProfileName -> SpecFree (LabelValue "testTimerProfile" TestTimerProfile :> context) m () -> SpecFree context m ()
withTimingProfile' :: ExampleT context m EventName
-> SpecFree
     (LabelValue "testTimerProfile" TestTimerProfile :> context) m ()
-> SpecFree context m ()
withTimingProfile' ExampleT context m EventName
getName = NodeOptions
-> String
-> Label "testTimerProfile" TestTimerProfile
-> ExampleT context m TestTimerProfile
-> (TestTimerProfile -> ExampleT context m ())
-> SpecFree
     (LabelValue "testTimerProfile" TestTimerProfile :> context) m ()
-> SpecFree context m ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
timingNodeOptions [i|Switch test timer profile to dynamic value|] Label "testTimerProfile" TestTimerProfile
testTimerProfile (EventName -> TestTimerProfile
TestTimerProfile (EventName -> TestTimerProfile)
-> ExampleT context m EventName
-> ExampleT context m TestTimerProfile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExampleT context m EventName
getName) (\TestTimerProfile
_ -> () -> ExampleT context m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- * Core

timingNodeOptions :: NodeOptions
timingNodeOptions :: NodeOptions
timingNodeOptions = NodeOptions
defaultNodeOptions { nodeOptionsRecordTime :: Bool
nodeOptionsRecordTime = Bool
False
                                       , nodeOptionsCreateFolder :: Bool
nodeOptionsCreateFolder = Bool
False
                                       , nodeOptionsVisibilityThreshold :: Int
nodeOptionsVisibilityThreshold = Int
systemVisibilityThreshold }

newSpeedScopeTestTimer :: FilePath -> Bool -> IO TestTimer
newSpeedScopeTestTimer :: String -> Bool -> IO TestTimer
newSpeedScopeTestTimer String
path Bool
writeRawTimings = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
path

  Maybe Handle
maybeHandle <- case Bool
writeRawTimings of
    Bool
False -> Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing
    Bool
True -> do
      Handle
h <- String -> IOMode -> IO Handle
openFile (String
path String -> String -> String
</> String
"timings_raw.txt") IOMode
AppendMode
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
      Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle -> IO (Maybe Handle))
-> Maybe Handle -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h

  MVar SpeedScopeFile
speedScopeFile <- SpeedScopeFile -> IO (MVar SpeedScopeFile)
forall a. a -> IO (MVar a)
newMVar SpeedScopeFile
emptySpeedScopeFile
  TestTimer -> IO TestTimer
forall (m :: * -> *) a. Monad m => a -> m a
return (TestTimer -> IO TestTimer) -> TestTimer -> IO TestTimer
forall a b. (a -> b) -> a -> b
$ String -> Maybe Handle -> MVar SpeedScopeFile -> TestTimer
SpeedScopeTestTimer String
path Maybe Handle
maybeHandle MVar SpeedScopeFile
speedScopeFile

finalizeSpeedScopeTestTimer :: TestTimer -> IO ()
finalizeSpeedScopeTestTimer :: TestTimer -> IO ()
finalizeSpeedScopeTestTimer TestTimer
NullTestTimer = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
finalizeSpeedScopeTestTimer (SpeedScopeTestTimer {String
Maybe Handle
MVar SpeedScopeFile
$sel:testTimerSpeedScopeFile:SpeedScopeTestTimer :: TestTimer -> MVar SpeedScopeFile
$sel:testTimerHandle:SpeedScopeTestTimer :: TestTimer -> Maybe Handle
$sel:testTimerBasePath:SpeedScopeTestTimer :: TestTimer -> String
testTimerSpeedScopeFile :: MVar SpeedScopeFile
testTimerHandle :: Maybe Handle
testTimerBasePath :: String
..}) = do
  Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe Handle
testTimerHandle Handle -> IO ()
hClose
  MVar SpeedScopeFile -> IO SpeedScopeFile
forall a. MVar a -> IO a
readMVar MVar SpeedScopeFile
testTimerSpeedScopeFile IO SpeedScopeFile -> (SpeedScopeFile -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
BL.writeFile (String
testTimerBasePath String -> String -> String
</> String
"speedscope.json") (ByteString -> IO ())
-> (SpeedScopeFile -> ByteString) -> SpeedScopeFile -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeedScopeFile -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode

timeAction' :: (MonadMask m, MonadIO m) => TestTimer -> T.Text -> T.Text -> m a -> m a
timeAction' :: TestTimer -> EventName -> EventName -> m a -> m a
timeAction' TestTimer
NullTestTimer EventName
_ EventName
_ = m a -> m a
forall a. a -> a
id
timeAction' (SpeedScopeTestTimer {String
Maybe Handle
MVar SpeedScopeFile
testTimerSpeedScopeFile :: MVar SpeedScopeFile
testTimerHandle :: Maybe Handle
testTimerBasePath :: String
$sel:testTimerSpeedScopeFile:SpeedScopeTestTimer :: TestTimer -> MVar SpeedScopeFile
$sel:testTimerHandle:SpeedScopeTestTimer :: TestTimer -> Maybe Handle
$sel:testTimerBasePath:SpeedScopeTestTimer :: TestTimer -> String
..}) EventName
profileName EventName
eventName = m () -> m () -> m a -> m a
forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracket_
  (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar SpeedScopeFile
-> (SpeedScopeFile -> IO SpeedScopeFile) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar SpeedScopeFile
testTimerSpeedScopeFile ((SpeedScopeFile -> IO SpeedScopeFile) -> IO ())
-> (SpeedScopeFile -> IO SpeedScopeFile) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SpeedScopeFile
file -> do
    POSIXTime
now <- IO POSIXTime
getPOSIXTime
    SpeedScopeFile -> POSIXTime -> IO SpeedScopeFile
handleStartEvent SpeedScopeFile
file POSIXTime
now
  )
  (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar SpeedScopeFile
-> (SpeedScopeFile -> IO SpeedScopeFile) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar SpeedScopeFile
testTimerSpeedScopeFile ((SpeedScopeFile -> IO SpeedScopeFile) -> IO ())
-> (SpeedScopeFile -> IO SpeedScopeFile) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SpeedScopeFile
file -> do
    POSIXTime
now <- IO POSIXTime
getPOSIXTime
    SpeedScopeFile -> POSIXTime -> IO SpeedScopeFile
handleEndEvent SpeedScopeFile
file POSIXTime
now
  )
  where
    handleStartEvent :: SpeedScopeFile -> POSIXTime -> IO SpeedScopeFile
handleStartEvent SpeedScopeFile
file POSIXTime
time = do
      Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe Handle
testTimerHandle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> EventName -> IO ()
T.hPutStrLn Handle
h [i|#{time} START #{show profileName} #{eventName}|]
      SpeedScopeFile -> IO SpeedScopeFile
forall (m :: * -> *) a. Monad m => a -> m a
return (SpeedScopeFile -> IO SpeedScopeFile)
-> SpeedScopeFile -> IO SpeedScopeFile
forall a b. (a -> b) -> a -> b
$ SpeedScopeFile
-> POSIXTime -> SpeedScopeEventType -> SpeedScopeFile
handleSpeedScopeEvent SpeedScopeFile
file POSIXTime
time SpeedScopeEventType
SpeedScopeEventTypeOpen

    handleEndEvent :: SpeedScopeFile -> POSIXTime -> IO SpeedScopeFile
handleEndEvent SpeedScopeFile
file POSIXTime
time = do
      Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe Handle
testTimerHandle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> EventName -> IO ()
T.hPutStrLn Handle
h [i|#{time} END #{show profileName} #{eventName}|]
      SpeedScopeFile -> IO SpeedScopeFile
forall (m :: * -> *) a. Monad m => a -> m a
return (SpeedScopeFile -> IO SpeedScopeFile)
-> SpeedScopeFile -> IO SpeedScopeFile
forall a b. (a -> b) -> a -> b
$ SpeedScopeFile
-> POSIXTime -> SpeedScopeEventType -> SpeedScopeFile
handleSpeedScopeEvent SpeedScopeFile
file POSIXTime
time SpeedScopeEventType
SpeedScopeEventTypeClose

    -- | TODO: maybe use an intermediate format so the frames (and possibly profiles) aren't stored as lists,
    -- so we don't have to do O(N) L.length and S.findIndexL
    handleSpeedScopeEvent :: SpeedScopeFile -> POSIXTime -> SpeedScopeEventType -> SpeedScopeFile
    handleSpeedScopeEvent :: SpeedScopeFile
-> POSIXTime -> SpeedScopeEventType -> SpeedScopeFile
handleSpeedScopeEvent SpeedScopeFile
initialFile POSIXTime
time SpeedScopeEventType
typ = (State SpeedScopeFile () -> SpeedScopeFile -> SpeedScopeFile)
-> SpeedScopeFile -> State SpeedScopeFile () -> SpeedScopeFile
forall a b c. (a -> b -> c) -> b -> a -> c
flip State SpeedScopeFile () -> SpeedScopeFile -> SpeedScopeFile
forall s a. State s a -> s -> s
execState SpeedScopeFile
initialFile (State SpeedScopeFile () -> SpeedScopeFile)
-> State SpeedScopeFile () -> SpeedScopeFile
forall a b. (a -> b) -> a -> b
$ do
      Int
frameID <- StateT SpeedScopeFile Identity SpeedScopeFile
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT SpeedScopeFile Identity SpeedScopeFile
-> (SpeedScopeFile -> StateT SpeedScopeFile Identity Int)
-> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SpeedScopeFile
f -> case (SpeedScopeFrame -> Bool) -> Seq SpeedScopeFrame -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
S.findIndexL (SpeedScopeFrame -> SpeedScopeFrame -> Bool
forall a. Eq a => a -> a -> Bool
== EventName -> SpeedScopeFrame
SpeedScopeFrame EventName
eventName) (SpeedScopeFile
f SpeedScopeFile
-> Getting
     (Seq SpeedScopeFrame) SpeedScopeFile (Seq SpeedScopeFrame)
-> Seq SpeedScopeFrame
forall s a. s -> Getting a s a -> a
^. (SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
-> SpeedScopeFile -> Const (Seq SpeedScopeFrame) SpeedScopeFile
forall s a. HasShared s a => Lens' s a
shared ((SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
 -> SpeedScopeFile -> Const (Seq SpeedScopeFrame) SpeedScopeFile)
-> ((Seq SpeedScopeFrame
     -> Const (Seq SpeedScopeFrame) (Seq SpeedScopeFrame))
    -> SpeedScopeShared
    -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
-> Getting
     (Seq SpeedScopeFrame) SpeedScopeFile (Seq SpeedScopeFrame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq SpeedScopeFrame
 -> Const (Seq SpeedScopeFrame) (Seq SpeedScopeFrame))
-> SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared
forall s a. HasFrames s a => Lens' s a
frames) of
        Just Int
j -> Int -> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j
        Maybe Int
Nothing -> do
          (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ())
-> (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall a b. (a -> b) -> a -> b
$ ASetter
  SpeedScopeFile
  SpeedScopeFile
  (Seq SpeedScopeFrame)
  (Seq SpeedScopeFrame)
-> (Seq SpeedScopeFrame -> Seq SpeedScopeFrame)
-> SpeedScopeFile
-> SpeedScopeFile
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((SpeedScopeShared -> Identity SpeedScopeShared)
-> SpeedScopeFile -> Identity SpeedScopeFile
forall s a. HasShared s a => Lens' s a
shared ((SpeedScopeShared -> Identity SpeedScopeShared)
 -> SpeedScopeFile -> Identity SpeedScopeFile)
-> ((Seq SpeedScopeFrame -> Identity (Seq SpeedScopeFrame))
    -> SpeedScopeShared -> Identity SpeedScopeShared)
-> ASetter
     SpeedScopeFile
     SpeedScopeFile
     (Seq SpeedScopeFrame)
     (Seq SpeedScopeFrame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq SpeedScopeFrame -> Identity (Seq SpeedScopeFrame))
-> SpeedScopeShared -> Identity SpeedScopeShared
forall s a. HasFrames s a => Lens' s a
frames) (Seq SpeedScopeFrame -> SpeedScopeFrame -> Seq SpeedScopeFrame
forall a. Seq a -> a -> Seq a
S.|> (EventName -> SpeedScopeFrame
SpeedScopeFrame EventName
eventName))
          Int -> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> StateT SpeedScopeFile Identity Int)
-> Int -> StateT SpeedScopeFile Identity Int
forall a b. (a -> b) -> a -> b
$ Seq SpeedScopeFrame -> Int
forall a. Seq a -> Int
S.length (Seq SpeedScopeFrame -> Int) -> Seq SpeedScopeFrame -> Int
forall a b. (a -> b) -> a -> b
$ SpeedScopeFile
f SpeedScopeFile
-> Getting
     (Seq SpeedScopeFrame) SpeedScopeFile (Seq SpeedScopeFrame)
-> Seq SpeedScopeFrame
forall s a. s -> Getting a s a -> a
^. (SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
-> SpeedScopeFile -> Const (Seq SpeedScopeFrame) SpeedScopeFile
forall s a. HasShared s a => Lens' s a
shared ((SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
 -> SpeedScopeFile -> Const (Seq SpeedScopeFrame) SpeedScopeFile)
-> ((Seq SpeedScopeFrame
     -> Const (Seq SpeedScopeFrame) (Seq SpeedScopeFrame))
    -> SpeedScopeShared
    -> Const (Seq SpeedScopeFrame) SpeedScopeShared)
-> Getting
     (Seq SpeedScopeFrame) SpeedScopeFile (Seq SpeedScopeFrame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq SpeedScopeFrame
 -> Const (Seq SpeedScopeFrame) (Seq SpeedScopeFrame))
-> SpeedScopeShared -> Const (Seq SpeedScopeFrame) SpeedScopeShared
forall s a. HasFrames s a => Lens' s a
frames

      Int
profileIndex <- StateT SpeedScopeFile Identity SpeedScopeFile
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT SpeedScopeFile Identity SpeedScopeFile
-> (SpeedScopeFile -> StateT SpeedScopeFile Identity Int)
-> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SpeedScopeFile
f -> case (SpeedScopeProfile -> Bool) -> [SpeedScopeProfile] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex ((EventName -> EventName -> Bool
forall a. Eq a => a -> a -> Bool
== EventName
profileName) (EventName -> Bool)
-> (SpeedScopeProfile -> EventName) -> SpeedScopeProfile -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpeedScopeProfile
-> Getting EventName SpeedScopeProfile EventName -> EventName
forall s a. s -> Getting a s a -> a
^. Getting EventName SpeedScopeProfile EventName
forall s a. HasName s a => Lens' s a
name)) (SpeedScopeFile
f SpeedScopeFile
-> Getting [SpeedScopeProfile] SpeedScopeFile [SpeedScopeProfile]
-> [SpeedScopeProfile]
forall s a. s -> Getting a s a -> a
^. Getting [SpeedScopeProfile] SpeedScopeFile [SpeedScopeProfile]
forall s a. HasProfiles s a => Lens' s a
profiles) of
        Just Int
j -> Int -> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j
        Maybe Int
Nothing -> do
          (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ())
-> (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall a b. (a -> b) -> a -> b
$ ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
-> ([SpeedScopeProfile] -> [SpeedScopeProfile])
-> SpeedScopeFile
-> SpeedScopeFile
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
forall s a. HasProfiles s a => Lens' s a
profiles (\[SpeedScopeProfile]
x -> [SpeedScopeProfile]
x [SpeedScopeProfile] -> [SpeedScopeProfile] -> [SpeedScopeProfile]
forall a. Semigroup a => a -> a -> a
<> [EventName -> POSIXTime -> SpeedScopeProfile
newProfile EventName
profileName POSIXTime
time])
          Int -> StateT SpeedScopeFile Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> StateT SpeedScopeFile Identity Int)
-> Int -> StateT SpeedScopeFile Identity Int
forall a b. (a -> b) -> a -> b
$ [SpeedScopeProfile] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (SpeedScopeFile
f SpeedScopeFile
-> Getting [SpeedScopeProfile] SpeedScopeFile [SpeedScopeProfile]
-> [SpeedScopeProfile]
forall s a. s -> Getting a s a -> a
^. Getting [SpeedScopeProfile] SpeedScopeFile [SpeedScopeProfile]
forall s a. HasProfiles s a => Lens' s a
profiles)

      (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ())
-> (SpeedScopeFile -> SpeedScopeFile) -> State SpeedScopeFile ()
forall a b. (a -> b) -> a -> b
$ ASetter
  SpeedScopeFile
  SpeedScopeFile
  (Seq SpeedScopeEvent)
  (Seq SpeedScopeEvent)
-> (Seq SpeedScopeEvent -> Seq SpeedScopeEvent)
-> SpeedScopeFile
-> SpeedScopeFile
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
forall s a. HasProfiles s a => Lens' s a
profiles ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
-> ((Seq SpeedScopeEvent -> Identity (Seq SpeedScopeEvent))
    -> [SpeedScopeProfile] -> Identity [SpeedScopeProfile])
-> ASetter
     SpeedScopeFile
     SpeedScopeFile
     (Seq SpeedScopeEvent)
     (Seq SpeedScopeEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [SpeedScopeProfile]
-> Traversal' [SpeedScopeProfile] (IxValue [SpeedScopeProfile])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [SpeedScopeProfile]
profileIndex ((SpeedScopeProfile -> Identity SpeedScopeProfile)
 -> [SpeedScopeProfile] -> Identity [SpeedScopeProfile])
-> ((Seq SpeedScopeEvent -> Identity (Seq SpeedScopeEvent))
    -> SpeedScopeProfile -> Identity SpeedScopeProfile)
-> (Seq SpeedScopeEvent -> Identity (Seq SpeedScopeEvent))
-> [SpeedScopeProfile]
-> Identity [SpeedScopeProfile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq SpeedScopeEvent -> Identity (Seq SpeedScopeEvent))
-> SpeedScopeProfile -> Identity SpeedScopeProfile
forall s a. HasEvents s a => Lens' s a
events) (Seq SpeedScopeEvent -> SpeedScopeEvent -> Seq SpeedScopeEvent
forall a. Seq a -> a -> Seq a
S.|> (SpeedScopeEventType -> Int -> POSIXTime -> SpeedScopeEvent
SpeedScopeEvent SpeedScopeEventType
typ Int
frameID POSIXTime
time))
              (SpeedScopeFile -> SpeedScopeFile)
-> (SpeedScopeFile -> SpeedScopeFile)
-> SpeedScopeFile
-> SpeedScopeFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter SpeedScopeFile SpeedScopeFile POSIXTime POSIXTime
-> (POSIXTime -> POSIXTime) -> SpeedScopeFile -> SpeedScopeFile
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
forall s a. HasProfiles s a => Lens' s a
profiles ASetter
  SpeedScopeFile
  SpeedScopeFile
  [SpeedScopeProfile]
  [SpeedScopeProfile]
-> ((POSIXTime -> Identity POSIXTime)
    -> [SpeedScopeProfile] -> Identity [SpeedScopeProfile])
-> ASetter SpeedScopeFile SpeedScopeFile POSIXTime POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [SpeedScopeProfile]
-> Traversal' [SpeedScopeProfile] (IxValue [SpeedScopeProfile])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [SpeedScopeProfile]
profileIndex ((SpeedScopeProfile -> Identity SpeedScopeProfile)
 -> [SpeedScopeProfile] -> Identity [SpeedScopeProfile])
-> ((POSIXTime -> Identity POSIXTime)
    -> SpeedScopeProfile -> Identity SpeedScopeProfile)
-> (POSIXTime -> Identity POSIXTime)
-> [SpeedScopeProfile]
-> Identity [SpeedScopeProfile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> Identity POSIXTime)
-> SpeedScopeProfile -> Identity SpeedScopeProfile
forall s a. HasEndValue s a => Lens' s a
endValue) (POSIXTime -> POSIXTime -> POSIXTime
forall a. Ord a => a -> a -> a
max POSIXTime
time)