Parse.hs

module Keiro.Ops.Parse
  ( durationReader,
    parseDuration,
    readBoundedIntegral,
    positiveIntReader,
    nonNegativeReader,
    nonNegativeIntReader,
  )
where

import Data.Char (toLower)
import Data.Time (NominalDiffTime)
import Options.Applicative (ReadM, eitherReader)
import Text.Read qualified as Read

durationReader :: ReadM NominalDiffTime
durationReader = eitherReader parseDuration

parseDuration :: String -> Either String NominalDiffTime
parseDuration input = do
  let (numberText, multiplier) =
        case reverse input of
          suffix : rest
            | Just factor <- durationFactor (toLower suffix) ->
                (reverse rest, factor)
          _ -> (input, 1)
  value <- maybe (Left malformed) Right (Read.readMaybe numberText :: Maybe Double)
  let scaled = value * multiplier
  if isNaN scaled || isInfinite scaled || scaled < 0
    then Left malformed
    else
      if scaled > maxDurationSeconds
        then Left tooLarge
        else Right (realToFrac scaled)
  where
    malformed =
      "invalid duration "
        <> show input
        <> ": expected a finite, non-negative number of seconds, optionally with an s, m, h, or d suffix"
    tooLarge =
      "invalid duration "
        <> show input
        <> ": exceeds the maximum supported duration of 9.0e12 seconds (about 285000 years)"

-- | Upper bound on any operator-supplied duration, in seconds. PostgreSQL's
-- binary timestamptz format is Int64 microseconds since 2000-01-01 (maximum
-- about 9.22e12 seconds); a larger duration wraps modulo 2^64 into an arbitrary
-- cutoff. 9.0e12 seconds is comfortably inside that range and far beyond any
-- legitimate retention.
maxDurationSeconds :: Double
maxDurationSeconds = 9.0e12

-- | Parse through unbounded 'Integer' and admit the value only when it fits the
-- requested bounded integral type. Reading directly at a bounded type silently
-- wraps oversized literals.
readBoundedIntegral :: forall a. (Integral a, Bounded a) => String -> Maybe a
readBoundedIntegral raw =
  case reads raw :: [(Integer, String)] of
    [(value, "")]
      | value >= toInteger (minBound :: a),
        value <= toInteger (maxBound :: a) ->
          Just (fromInteger value)
    _ -> Nothing

positiveIntReader :: ReadM Int
positiveIntReader = eitherReader $ \raw ->
  case readBoundedIntegral raw of
    Just n | n > 0 -> Right n
    _ -> Left "expected a positive integer"

nonNegativeIntReader :: ReadM Int
nonNegativeIntReader = nonNegativeReader "expected a non-negative integer"

-- | A bounded, non-negative integral reader whose failure message names the
-- domain concept being parsed (global position, stream version, generation).
nonNegativeReader :: forall a. (Integral a, Bounded a) => String -> ReadM a
nonNegativeReader message = eitherReader $ \raw ->
  case readBoundedIntegral raw of
    Just value | value >= 0 -> Right value
    _ -> Left message

durationFactor :: Char -> Maybe Double
durationFactor = \case
  's' -> Just 1
  'm' -> Just 60
  'h' -> Just 3600
  'd' -> Just 86400
  _ -> Nothing