caliper-0.1.0.0: app/Main.hs

module Main where

import Control.Monad
import Data.Maybe
import Data.Text.IO qualified as TIO
import Data.Time.Format
import Options.Applicative qualified as Cli
import System.Exit
import Text.Megaparsec (errorBundlePretty)

import Caliper.Cli
import Caliper.Syntax

main :: IO ()
main = do
  args@(CliArgs {filepaths, action}) <- Cli.execParser cliParser
  parseResults <- traverse parseAndResolve filepaths

  let (parseFailures, parseOkWithSemErrs) = foldr g ([], []) parseResults
        where
          g (src, Right ok) (bad, good) = (bad, (src, ok) : good)
          g (_, Left err) (bad, good) = (err : bad, good)

  unless (null parseFailures) $ do
    forM_ parseFailures $ putStrLn . errorBundlePretty
    exitWith $ ExitFailure 1

  let (semErrs, outputs) = foldr g ([], []) parseOkWithSemErrs
        where
          g (_, ([], out)) (bad, good) = (bad, out : good)
          g (src, (errs, _)) (bad, good) = ((src, errs) : bad, good)

  unless (null semErrs) $ do
    forM_ semErrs $ \(src, errs) ->
      forM_ errs $ \err ->
        TIO.putStrLn $ resolutionErrorPretty src err
    exitWith $ ExitFailure 1

  let mergedOutputs =
        applyCliArgs args $
          sortResolvedEntriesAbsolute $
            mconcat $
              outputs
  ( case action of
      Summation sumArgs -> handleSummation sumArgs
      Histogram -> handleHistogram
    )
    mergedOutputs

handleSummation :: SummationArgs -> [ResolvedEntry] -> IO ()
handleSummation (SummationArgs {summationFormat}) output = do
  let durationFormat = fromMaybe "%hh %Mm %Ss" summationFormat
      duration = sumDuration output
  putStrLn $ formatTime defaultTimeLocale durationFormat duration

handleHistogram :: [ResolvedEntry] -> IO ()
handleHistogram output = do
  let dailyEntries' = groupEntriesByDay output

  forM_ dailyEntries' $ \entriesOfDay -> do
    putStrLn $ histogramLine entriesOfDay

applyCliArgs :: CliArgs -> [ResolvedEntry] -> [ResolvedEntry]
applyCliArgs (CliArgs {filters, begin, end}) =
  maybe id entriesAfter begin
    . maybe id entriesBefore end
    . filterByTags filters