{- |
Module                  : DrCabal.Profile
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

@dr-cabal profile@ command.
-}

module DrCabal.Profile
    ( runProfile
    ) where

import DrCabal.Cli (FileMode (..), ProfileArgs (..))
import DrCabal.Json (readEntries, writeEntries)
import DrCabal.Model (Entry (..), Style (..))
import DrCabal.Profile.Stacked (createStackedChart)
import DrCabal.Terminal (getTerminalWidth, withAlternateBuffer)
import DrCabal.Watch (watchBuild)


runProfile :: ProfileArgs -> IO ()
runProfile :: ProfileArgs -> IO ()
runProfile ProfileArgs{Style
FileMode
profileArgsFileMode :: ProfileArgs -> FileMode
profileArgsStyle :: ProfileArgs -> Style
profileArgsFileMode :: FileMode
profileArgsStyle :: Style
..} = case FileMode
profileArgsFileMode of
     FileMode
None ->
         Style -> IO ()
profileInteractive Style
profileArgsStyle
     Output FilePath
outputFile ->
         Style -> FilePath -> IO ()
profileWithOutput Style
profileArgsStyle FilePath
outputFile
     Input FilePath
inputFile ->
         Style -> FilePath -> IO ()
profileFromInput Style
profileArgsStyle FilePath
inputFile

profileInteractive :: Style -> IO ()
profileInteractive :: Style -> IO ()
profileInteractive Style
chartStyle = do
    -- draw profiling chart interactively and get all the entries after that
    [Entry]
entries <- Style -> IO [Entry]
withInteractiveProfiling Style
chartStyle

    -- draw the chart in the normal terminal screen buffer now
    [Entry] -> Text
drawChart <- Style -> IO ([Entry] -> Text)
getChartDrawer Style
chartStyle
    forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn forall a b. (a -> b) -> a -> b
$ [Entry] -> Text
drawChart [Entry]
entries

    forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ forall t. IsText t "unlines" => [t] -> t
unlines
        [ Text
"✨  Done!"
        , Text
"🆙  Scroll up to view full profiling chart."
        , Text
"💾  To save the results in a file (to view later without recompilation), run:"
        , Text
""
        , Text
"    cabal build ... | dr-cabal profile --output=my_file.json"
        ]

profileWithOutput :: Style -> FilePath -> IO ()
profileWithOutput :: Style -> FilePath -> IO ()
profileWithOutput Style
chartStyle FilePath
outputFile = do
    -- draw profiling chart interactively and get all the entries after that
    [Entry]
entries <- Style -> IO [Entry]
withInteractiveProfiling Style
chartStyle
    FilePath -> [Entry] -> IO ()
writeEntries FilePath
outputFile [Entry]
entries

    forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ forall t. IsText t "unlines" => [t] -> t
unlines
        [ Text
"✨  Done!"
        , Text
"💾  Profiling entries are saved in the file: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
outputFile
        , Text
"👀  To view the results from the saved file, run:"
        , Text
""
        , Text
"    dr-cabal profile --input=" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
outputFile
        ]

profileFromInput :: Style -> FilePath -> IO ()
profileFromInput :: Style -> FilePath -> IO ()
profileFromInput Style
chartStyle FilePath
inputFile = do
    Int
terminalWidth <- IO Int
getTerminalWidth
    [Entry]
entries <- FilePath -> IO [Entry]
readEntries FilePath
inputFile
    let chart :: Text
chart = Style -> Int -> [Entry] -> Text
createChart Style
chartStyle Int
terminalWidth [Entry]
entries
    forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
chart

-------------
-- HELPERS --
-------------

withInteractiveProfiling :: Style -> IO [Entry]
withInteractiveProfiling :: Style -> IO [Entry]
withInteractiveProfiling Style
chartStyle = forall a. IO a -> IO a
withAlternateBuffer forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
stdout (Maybe Int -> BufferMode
BlockBuffering forall a. Maybe a
Nothing)
    [Entry] -> Text
drawChart <- Style -> IO ([Entry] -> Text)
getChartDrawer Style
chartStyle
    ([Entry] -> Text) -> IO [Entry]
watchBuild [Entry] -> Text
drawChart

getChartDrawer :: Style -> IO ([Entry] -> Text)
getChartDrawer :: Style -> IO ([Entry] -> Text)
getChartDrawer Style
chartStyle = do
    Int
terminalWidth <- IO Int
getTerminalWidth
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Style -> Int -> [Entry] -> Text
createChart Style
chartStyle Int
terminalWidth

createChart
    :: Style
    -- ^ Chart type
    -> Int
    -- ^ Terminal width
    -> [Entry]
    -- ^ Time entries
    -> Text
createChart :: Style -> Int -> [Entry] -> Text
createChart = \case
    Style
Stacked -> Int -> [Entry] -> Text
createStackedChart