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