Parsing.hs

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}

module Caliper.Cli.Parsing where

import Control.Applicative
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Options.Applicative qualified as Cli
import Text.Read

import Caliper.Syntax

data CliArgs = CliArgs
  { action :: CliAction
  , filepaths :: NE.NonEmpty String
  , filters :: [TagPredicate]
  , begin :: Maybe LocalTime
  , end :: Maybe LocalTime
  }

data CliAction
  = Summation SummationArgs
  | Histogram

newtype SummationArgs = SummationArgs
  { summationFormat :: Maybe String
  }

cliParser :: Cli.ParserInfo CliArgs
cliParser = Cli.info subcommands (Cli.progDesc "Track the amount of work time you have done")
  where
    subcommands :: Cli.Parser CliArgs
    subcommands =
      (Cli.helper <*>) $
        Cli.subparser
          ( Cli.command
              "sum"
              (Cli.info (parseCommonCommandWith summationArgsP) (Cli.progDesc "Sum the amount of work time"))
              <> Cli.command
                "histogram"
                (Cli.info (parseCommonCommandWith (pure Histogram)) (Cli.progDesc "Show a histogram"))
          )

    summationArgsP :: Cli.Parser CliAction
    summationArgsP = do
      fmt <- optional formatP
      pure $ Summation (SummationArgs fmt)

    formatP :: Cli.Parser String
    formatP =
      Cli.strOption $
        Cli.long "format"
          <> Cli.metavar "FORMAT"
          <> Cli.help "Format of the output time, defaults to \"%hh %Mm %Ss\""

    parseCommonCommandWith :: Cli.Parser CliAction -> Cli.Parser CliArgs
    parseCommonCommandWith actionP =
      Cli.helper <*> do
        filepaths <-
          NE.some1 $
            Cli.strArgument $
              Cli.metavar "FILE"
                <> Cli.help "Path to the timetrack file"

        action <- actionP

        begin <-
          optional $
            Cli.option localTimeReader $
              Cli.long "begin"
                <> Cli.short 'b'
                <> Cli.metavar "BEGIN"
                <> Cli.help "Truncate operation from a given moment"

        end <-
          optional $
            Cli.option localTimeReader $
              Cli.long "end"
                <> Cli.short 'e'
                <> Cli.metavar "END"
                <> Cli.help "Truncate operation to a given moment"

        filters <-
          many . Cli.option keyValueReader $
            Cli.metavar "QUERY"
              <> Cli.short 'q'
              <> Cli.long "query"
              <> Cli.help "A \"key:value\" pair to constraint the result"

        pure $ CliArgs {..}

    localTimeReader :: Cli.ReadM LocalTime
    localTimeReader = Cli.maybeReader $ \x ->
      let readDay :: Maybe Day
          readDay = readMaybe x
          readLocalTime :: Maybe LocalTime
          readLocalTime = readMaybe x
      in  readLocalTime <|> (LocalTime <$> readDay <*> pure (TimeOfDay 0 0 0))

    keyValueReader :: Cli.ReadM TagPredicate
    keyValueReader =
      let f s = case break (== ':') s of
            ("not", ':' : s') -> Negate <$> f s'
            (k, ':' : v) -> Just $ HasKeyValue (T.pack k) (T.pack v)
            _ -> Nothing
      in  Cli.maybeReader f