hegel-0.1.0: conformance/TestFloats.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Conformance binary: generates float values and writes metrics.
module Main (main) where

import qualified Data.Aeson as Aeson
import Data.Aeson (Value (..))
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.Map.Strict as Map
import Hegel
import System.Environment (getArgs)

parseParams :: IO (Map.Map String Value)
parseParams = do
  args <- getArgs
  pure $
    fromMaybe Map.empty $
      Aeson.decode . LBS.pack =<< listToMaybe args

getDoubleParam :: Map.Map String Value -> String -> Maybe Double
getDoubleParam m k = realToFrac <$> (getNumber =<< Map.lookup k m)
  where
    getNumber (Number n) = Just n
    getNumber _ = Nothing

getBoolParam :: Map.Map String Value -> String -> Maybe Bool
getBoolParam m k = getBool =<< Map.lookup k m
  where
    getBool (Bool b) = Just b
    getBool _ = Nothing

getBoolParamDefault :: Map.Map String Value -> String -> Bool -> Bool
getBoolParamDefault m k defaultValue = fromMaybe defaultValue (getBoolParam m k)

-- | Format a float for JSON output. NaN becomes "null", +Inf becomes "1e308",
-- -Inf becomes "-1e308", otherwise show the number.
formatFloat :: Double -> String
formatFloat v
  | isNaN v = "null"
  | isInfinite v = if v > 0 then "1e308" else "-1e308"
  | otherwise = show v

boolStr :: Bool -> String
boolStr True = "true"
boolStr False = "false"

main :: IO ()
main = do
  params <- parseParams
  let minVal = getDoubleParam params "min_value"
  let maxVal = getDoubleParam params "max_value"
  let excludeMin = getBoolParamDefault params "exclude_min" False
  let excludeMax = getBoolParamDefault params "exclude_max" False
  let allowNan = getBoolParam params "allow_nan"
  let allowInf = getBoolParam params "allow_infinity"
  let opts =
        def
          { floatBounds =
              RangeOpts
                { rangeMin = minVal,
                  rangeMax = maxVal
                },
            floatExcludeMin = excludeMin,
            floatExcludeMax = excludeMax,
            floatAllowNan = allowNan,
            floatAllowInfinity = allowInf
          }
  testCases <- getTestCases
  runHegelTest (\settings -> settings { settingsTestCases = testCases }) $ \tc -> do
    v <- draw tc (floats opts)
    writeMetrics
      [ ("value", formatFloat v),
        ("is_nan", boolStr (isNaN v)),
        ("is_infinite", boolStr (isInfinite v))
      ]