phino-0.0.114: test/RandomSpec.hs

{-# LANGUAGE LambdaCase #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

{- | Tests for the Random module that provides random string generation
with pattern substitution for unique identifier creation.
Attention! Most of the tests are generated by LLM. Consider that when refactoring
-}
module RandomSpec where

import Control.Monad (forM_)
import Data.Char (isDigit, isHexDigit)
import Data.Set qualified as Set
import Random (randomString)
import System.Timeout (timeout)
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)

spec :: Spec
spec = do
  describe "randomString passes a pattern with no specials through unchanged" $
    forM_
      [ ("empty pattern returns an empty string", "")
      , ("literal pattern returns the literal unchanged", "hello")
      , ("literal pattern with spaces returns the literal with spaces", "hello world")
      ]
      (\(desc, literal) -> it desc $ randomString literal >>= (`shouldBe` literal))

  describe "randomString called twice with the same literal pattern" $
    it "does not loop forever on the second call" $ do
      _ <- randomString "repeated"
      result <- timeout 1000000 (randomString "repeated")
      result `shouldBe` Just "repeated"

  describe "randomString with %d/%x patterns" $
    forM_
      [ ("generates numeric digits", "%d", all isDigit)
      , ("generates a fixed 4-digit number", "%d", \result -> length result == 4)
      , ("generates hex digits", "%x", all isHexDigit)
      , ("generates exactly 8 hex chars", "%x", \result -> length result == 8)
      ]
      (\(desc, pattern, predicate) -> it desc (randomString pattern >>= (`shouldSatisfy` predicate)))

  describe "randomString passes through a pattern with no recognized specials" $
    forM_
      [ ("preserves an unknown %q pattern", "%q")
      , ("preserves an unknown %z pattern", "%z")
      ]
      (\(desc, literal) -> it desc $ randomString literal >>= (`shouldBe` literal))

  describe "randomString with a prefix or suffix around %d/%x" $
    forM_
      [ ("combines prefix with digits", "id_%d", \s -> take 3 s == "id_")
      , ("combines digits with suffix", "%d_end", \s -> drop (length s - 4) s == "_end")
      , ("combines prefix with hex", "hex_%x", \s -> take 4 s == "hex_" && length s == 12)
      ]
      (\(desc, pattern, predicate) -> it desc (randomString pattern >>= (`shouldSatisfy` predicate)))

  describe "randomString with suffix and %x" $
    it "combines hex with suffix" $ do
      result <- randomString "%x_end"
      result `shouldSatisfy` (\s -> drop 8 s == "_end" && length s == 12)

  describe "randomString with multiple %d patterns" $
    it "replaces all %d patterns" $ do
      result <- randomString "%d-%d"
      result `shouldSatisfy` (\s -> '-' `elem` s)

  describe "randomString with multiple %x patterns" $
    it "replaces all %x patterns" $ do
      result <- randomString "%x-%x"
      let parts = wordsBy (== '-') result
      length parts `shouldBe` 2

  describe "randomString with mixed patterns" $
    it "handles %d and %x together" $ do
      result <- randomString "a%db%xc"
      result `shouldSatisfy` (\case [] -> False; ch : _ -> ch == 'a')

  describe "randomString generates unique strings" $
    it "produces different results on repeated calls" $ do
      results <- mapM (const (randomString "test_%d")) [1 :: Int .. 10]
      let unique = Set.fromList results
      Set.size unique `shouldBe` 10

  describe "randomString with %x generates unique strings" $
    it "produces different hex results" $ do
      results <- mapM (const (randomString "%x")) [1 :: Int .. 5]
      let unique = Set.fromList results
      Set.size unique `shouldBe` 5

  describe "randomString with complex pattern" $
    it "handles prefix_%d_middle_%x_suffix" $ do
      result <- randomString "pre_%d_mid_%x_suf"
      result `shouldSatisfy` (\s -> take 4 s == "pre_")

  describe "randomString passes through everything else that is not a recognized pattern" $
    forM_
      [ ("preserves a trailing percent", "test%")
      , ("handles %% as an unknown pattern", "%%")
      , ("preserves special characters", "a!@#b")
      , ("preserves a plain literal", "test")
      ]
      (\(desc, literal) -> it desc $ randomString literal >>= (`shouldBe` literal))

  describe "randomString %d range" $
    it "generates numbers in 0-9999 range" $ do
      result <- randomString "%d"
      let num = read result :: Int
      num `shouldSatisfy` (\n -> n >= 0 && n <= 9999)

  describe "randomString %x chars" $
    it "generates lowercase hex digits" $ do
      result <- randomString "%x"
      result `shouldSatisfy` all (\c -> isHexDigit c && (isDigit c || c `elem` "abcdef"))

  describe "randomString retries on a collision" $
    it "still returns fresh, unique 4-digit numbers well past the birthday bound of a 10000-value space" $ do
      -- Forces at least one regenerate retry (Set.member match) with
      -- overwhelming probability, without exhausting the whole space
      -- (which would loop forever).
      results <- mapM (const (randomString "%d")) [1 :: Int .. 2000]
      let unique = Set.fromList results
      Set.size unique `shouldBe` 2000

wordsBy :: (Char -> Bool) -> String -> [String]
wordsBy predicate str = case dropWhile predicate str of
  "" -> []
  str' -> let (word, rest) = break predicate str' in word : wordsBy predicate rest