content: -- Copyright 2022 Google LLC
  --
  -- Use of this source code is governed by a BSD-style
  -- license that can be found in the LICENSE file or at
  -- https://developers.google.com/open-source/licenses/bsd
  
  {-# OPTIONS_GHC -Wno-orphans #-}
  
  module RawNameSpec (spec) where
  
  import Control.Monad
  import Data.Char
  import Test.Hspec
  import Test.QuickCheck
  import RawName qualified as R
  
  newtype RawNameMap = RMap (R.RawNameMap ())
                       deriving (Show)
  
  instance Arbitrary RawNameMap where
    arbitrary = do
      s <- getSize
      RMap . R.fromList <$> (replicateM s $ (,()) <$> arbitrary)
  
  instance Arbitrary R.NameHint where
    arbitrary = do
      arbitrary >>= \case
        True  -> R.getNameHint . fromStringNameHint <$> arbitrary
        False -> return R.noHint  -- TODO: Generate more interesting non-string names
  
  instance Arbitrary R.RawName where
    arbitrary = R.rawNameFromHint <$> arbitrary
  
  newtype StringNameHint = StringNameHint { fromStringNameHint :: String }
  
  instance Show StringNameHint where
    show (StringNameHint s) = s
  
  instance Arbitrary StringNameHint where
    arbitrary = StringNameHint <$> do
      s <- chooseInt (1, 7)
      replicateM s $ arbitrary `suchThat` isNiceAscii
  
  isNiceAscii :: Char -> Bool
  isNiceAscii h = isAsciiLower h || isAsciiUpper h || isDigit h
  
  spec :: Spec
  spec = do
    describe "RawName" do
      it "generates a fresh name" do
        property \hint (RMap m) -> do
          let name = R.freshRawName hint m
          not $ name `R.member` m
  
      it "repeatedly generates fresh names from the same hint" do
        property \hint (RMap initM) -> do
          let n = 512
          let step = \(m, ok) () ->
                       let name = R.freshRawName hint m in
                       (R.insert name () m, ok && not (name `R.member` m))
          snd $ foldl step (initM, True) (replicate n ())
  
      it "string names are in a bijection with short strings" do
        property \(StringNameHint s) -> do
          let s' = show (R.rawNameFromHint (R.getNameHint s))
          counterexample s' $ s == s'
  
      it "string names with non-zero counters print correctly" do
        property \(StringNameHint s) -> do
          let hint = R.getNameHint s
          let n = R.rawNameFromHint hint
          let scope = R.singleton n ()
          show (R.freshRawName hint scope) == s ++ ".1"
  