-- 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

-- | Debugging utilities.
module Cmd.Repl.LDebug where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified System.IO as IO

import qualified Util.Log as Log
import qualified Util.Memory as Memory
import qualified Util.Num as Num
import qualified Util.PPrint as PPrint
import qualified Util.Pretty as Pretty
import qualified Util.Texts as Texts

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Play as Play
import qualified Cmd.PlayUtil as PlayUtil
import qualified Cmd.Repl.LPerf as LPerf
import qualified Cmd.Selection as Selection
import qualified Cmd.Simple as Simple

import qualified Derive.Cache as Cache
import qualified Derive.Derive as Derive
import qualified Derive.LEvent as LEvent
import qualified Derive.Stack as Stack
import qualified Derive.TrackWarp as TrackWarp
import qualified Derive.Warp as Warp

import qualified Perform.Midi.Types as Types
import qualified Ui.Id as Id
import qualified Ui.Track as Track
import qualified Ui.Ui as Ui

import           Global
import           Types


-- | GHC's opinion on allocated memory.
rtsAllocated :: MonadIO m => m Memory.Size
rtsAllocated :: forall (m :: * -> *). MonadIO m => m Size
rtsAllocated = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Size
Memory.rtsAllocated

-- | OS opinion on RSS and VSIZE.
rssVsize :: MonadIO m => m (Memory.Size, Memory.Size)
rssVsize :: forall (m :: * -> *). MonadIO m => m (Size, Size)
rssVsize = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Size, Size)
Memory.rssVsize

-- Also see 'LPerf.extract_debug' and similar functions.

-- * block

-- | Save state in a format that can be copy-pasted into a test, and loaded
-- with 'Derive.DeriveTest.derive_dump'.
dump_blocks :: FilePath -> Cmd.CmdL ()
dump_blocks :: FilePath -> CmdL ()
dump_blocks FilePath
fname = do
    State
state <- forall (m :: * -> *). M m => m State
Simple.dump_state
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> State -> IO ()
write_dump FilePath
fname State
state

-- | Like 'dump_blocks', but only dump a single block.
dump_block :: FilePath -> BlockId -> Cmd.CmdL ()
dump_block :: FilePath -> BlockId -> CmdL ()
dump_block FilePath
fname BlockId
block_id = do
    State
state <- forall (m :: * -> *). M m => m State
Ui.get
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
    State
state <- forall (m :: * -> *) a. M m => Text -> State -> StateId a -> m a
Ui.eval_rethrow Text
"dump_block"
        (State
state { state_blocks :: Map BlockId Block
Ui.state_blocks = forall k a. k -> a -> Map k a
Map.singleton BlockId
block_id Block
block })
        forall (m :: * -> *). M m => m State
Simple.dump_state
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> State -> IO ()
write_dump FilePath
fname State
state

write_dump :: FilePath -> Simple.State -> IO ()
write_dump :: FilePath -> State -> IO ()
write_dump FilePath
fname = FilePath -> FilePath -> IO ()
writeFile FilePath
fname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
PPrint.pshow

-- * perf events

dump_block_perf_events :: FilePath -> BlockId -> Cmd.CmdL ()
dump_block_perf_events :: FilePath -> BlockId -> CmdL ()
dump_block_perf_events FilePath
fname BlockId
block_id = do
    [LEvent Event]
events <- forall (m :: * -> *). M m => [Event] -> m [LEvent Event]
LPerf.midi_convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. [LEvent d] -> [d]
LEvent.events_of
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
LPerf.block_events BlockId
block_id
    FilePath -> [Event] -> CmdL ()
dump_perf_events FilePath
fname (forall d. [LEvent d] -> [d]
LEvent.events_of [LEvent Event]
events)

dump_perf_events :: FilePath -> [Types.Event] -> Cmd.CmdL ()
dump_perf_events :: FilePath -> [Event] -> CmdL ()
dump_perf_events FilePath
fname [Event]
events = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.writeFile FilePath
fname forall a b. (a -> b) -> a -> b
$
    forall a. Show a => a -> FilePath
PPrint.pshow (forall a b. (a -> b) -> [a] -> [b]
map Event -> ExactPerfEvent
Simple.dump_exact_perf_event [Event]
events)

-- * undo

show_history :: Cmd.CmdL Text
show_history :: CmdL Text
show_history = do
    Text
save_file <- (Text
"save file: "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> Maybe (Writable, SaveFile)
Cmd.state_save_file
    Text
hist <- forall a. Pretty a => a -> Text
Pretty.formatted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> History
Cmd.state_history
    Text
config <- forall a. Pretty a => a -> Text
Pretty.formatted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> HistoryConfig
Cmd.state_history_config
    Text
collect <- forall a. Pretty a => a -> Text
Pretty.formatted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> HistoryCollect
Cmd.state_history_collect
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip [Text
save_file, Text
hist, Text
config, Text
collect]

-- * extract from Performance

track_signal :: Cmd.CmdL (Maybe Track.TrackSignal)
track_signal :: CmdL (Maybe TrackSignal)
track_signal = do
    (BlockId
block_id, Int
_, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
    Performance
perf <- forall (m :: * -> *). M m => BlockId -> m Performance
LPerf.get BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (BlockId
block_id, TrackId
track_id) (Performance -> TrackSignals
Cmd.perf_track_signals Performance
perf)

-- | Get collected warps of a specific track.
get_warps :: Cmd.M m => BlockId -> TrackId -> m [TrackWarp.TrackWarp]
get_warps :: forall (m :: * -> *). M m => BlockId -> TrackId -> m [TrackWarp]
get_warps BlockId
block_id TrackId
track_id = do
    Performance
perf <- forall (m :: * -> *). M m => m Performance
LPerf.get_root
    let track_warps :: [TrackWarp]
track_warps = Performance -> [TrackWarp]
Cmd.perf_warps Performance
perf
        warps :: [TrackWarp]
warps = [TrackWarp
tw | TrackWarp
tw <- [TrackWarp]
track_warps, TrackWarp -> BlockId
TrackWarp.tw_block TrackWarp
tw forall a. Eq a => a -> a -> Bool
== BlockId
block_id,
            forall a. Ord a => a -> Set a -> Bool
Set.member TrackId
track_id (TrackWarp -> Set TrackId
TrackWarp.tw_tracks TrackWarp
tw)]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\TrackWarp
w -> TrackWarp
w { tw_warp :: Warp
TrackWarp.tw_warp = Warp
Warp.identity }) [TrackWarp]
warps

-- | Get all raw uncollected TrackWarps from the root, and strip out the
-- signals so they don't take up tons of space.
get_track_warps :: Cmd.M m => m (Map Stack.Stack TrackWarp.Track)
get_track_warps :: forall (m :: * -> *). M m => m (Map Stack Track)
get_track_warps = do
    Result
result <- forall (m :: * -> *). M m => BlockId -> m Result
LPerf.derive forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Ui.get_root_id
    let wmap :: Map Stack Track
wmap = Collect -> Map Stack Track
Derive.collect_warp_map forall a b. (a -> b) -> a -> b
$ State -> Collect
Derive.state_collect forall a b. (a -> b) -> a -> b
$
            Result -> State
Derive.r_state Result
result
    let strip :: Track -> Track
strip (TrackWarp.Track RealTime
s RealTime
e Warp
_warp BlockId
bid Maybe TrackId
tid) =
            RealTime -> RealTime -> Warp -> BlockId -> Maybe TrackId -> Track
TrackWarp.Track RealTime
s RealTime
e Warp
Warp.identity BlockId
bid Maybe TrackId
tid
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Track -> Track
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Stack Track
wmap

-- ** cache

-- | Extract the cache logs, with no summarizing.
cache_logs :: BlockId -> Cmd.CmdL Text
cache_logs :: BlockId -> CmdL Text
cache_logs BlockId
block_id = do
    Performance
perf <- forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id
    let logs :: [Msg]
logs = forall a. (a -> Bool) -> [a] -> [a]
filter Msg -> Bool
wanted forall a b. (a -> b) -> a -> b
$ Performance -> [Msg]
Cmd.perf_logs Performance
perf
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines
        [ forall a. Textlike a => a -> a -> a -> a
Texts.join2 Text
": " (Msg -> Text
format_stack Msg
msg) (Msg -> Text
Log.msg_text Msg
msg)
        | Msg
msg <- [Msg]
logs
        ]
    where
    wanted :: Msg -> Bool
wanted Msg
log = Msg -> Bool
Cache.is_cache_log Msg
log Bool -> Bool -> Bool
|| Msg -> Bool
PlayUtil.is_score_damage_log Msg
log
    format_stack :: Msg -> Text
format_stack = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Stack -> Text
Stack.pretty_ui_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Maybe Stack
Log.msg_stack

-- | Stats for both block and track caches from the given block.
cache_stats :: BlockId -> Cmd.CmdL String
cache_stats :: BlockId -> CmdL FilePath
cache_stats BlockId
block_id = do
    ([(Text, [BlockId])], [(BlockId, Int)])
block <- BlockId -> CmdL ([(Text, [BlockId])], [(BlockId, Int)])
block_cache BlockId
block_id
    ([(Text, [TrackId])], [(TrackId, Int)])
track <- BlockId -> CmdL ([(Text, [TrackId])], [(TrackId, Int)])
track_cache BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
        [FilePath
"block:", forall id. Ident id => ([(Text, [id])], [(id, Int)]) -> FilePath
format_stats ([(Text, [BlockId])], [(BlockId, Int)])
block, FilePath
"track:", forall id. Ident id => ([(Text, [id])], [(id, Int)]) -> FilePath
format_stats ([(Text, [TrackId])], [(TrackId, Int)])
track]

-- | Get summarized stats for cached blocks.
block_cache :: BlockId -> Cmd.CmdL ([(Text, [BlockId])], [(BlockId, Int)])
block_cache :: BlockId -> CmdL ([(Text, [BlockId])], [(BlockId, Int)])
block_cache BlockId
block_id =
    forall k. (Msg -> Maybe k) -> [Msg] -> ([(Text, [k])], [(k, Int)])
Play.extract_cache_stats Msg -> Maybe BlockId
Play.get_block_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Performance -> [Msg]
Cmd.perf_logs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id

-- | Get summarized stats for cached tracks on the given block.
track_cache :: BlockId -> Cmd.CmdL ([(Text, [TrackId])], [(TrackId, Int)])
track_cache :: BlockId -> CmdL ([(Text, [TrackId])], [(TrackId, Int)])
track_cache BlockId
block_id = do
    ([(Text, [TrackId])]
rederived, [(TrackId, Int)]
cached) <- (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall {a} {b}. [(a, [(BlockId, b)])] -> [(a, [b])]
rederived_block forall {b} {c}. [((BlockId, b), c)] -> [(b, c)]
cached_block)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. (Msg -> Maybe k) -> [Msg] -> ([(Text, [k])], [(k, Int)])
Play.extract_cache_stats Msg -> Maybe (BlockId, TrackId)
Play.get_track_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Performance -> [Msg]
Cmd.perf_logs
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, [TrackId])]
rederived, [(TrackId, Int)]
cached)
    where
    rederived_block :: [(a, [(BlockId, b)])] -> [(a, [b])]
rederived_block = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==BlockId
block_id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))
    cached_block :: [((BlockId, b), c)] -> [(b, c)]
cached_block = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==BlockId
block_id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

format_stats :: Id.Ident id => ([(Text, [id])], [(id, Int)]) -> String
format_stats :: forall id. Ident id => ([(Text, [id])], [(id, Int)]) -> FilePath
format_stats ([(Text, [id])]
rederived, [(id, Int)]
cached) =
    FilePath
"cached: " forall a. Semigroup a => a -> a -> a
<> forall {b} {b}. (Show b, Num b, Ident b) => [(b, b)] -> FilePath
format_cached [(id, Int)]
cached forall a. Semigroup a => a -> a -> a
<> FilePath
"\n"
        forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Ident a => (Text, [a]) -> FilePath
format_rederived [(Text, [id])]
rederived)
    where
    format_rederived :: (Text, [a]) -> FilePath
format_rederived (Text
because, [a]
ids) =
        Text -> FilePath
untxt Text
because forall a. Semigroup a => a -> a -> a
<> FilePath
": [" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ids) forall a. Semigroup a => a -> a -> a
<> FilePath
"] "
        forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
untxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Text
Id.ident_name) [a]
ids)
    format_cached :: [(b, b)] -> FilePath
format_cached [(b, b)]
cached =
        forall a. Show a => a -> FilePath
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(b, b)]
cached) forall a. Semigroup a => a -> a -> a
<> FilePath
" [" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(b, b)]
cached)) forall a. Semigroup a => a -> a -> a
<> FilePath
"] "
        forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
untxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Text
Id.ident_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(b, b)]
cached)