module Props.HTTPClientProps (tests) where

-- base
import Data.Char (isAsciiLower, isAsciiUpper, toUpper)
import Data.List (nub)

-- hedgehog
import Hedgehog
import qualified Hedgehog.Gen as Gen

-- tasty / tasty-hedgehog
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testProperty)

-- restman
import HTTP.Client (UseDefaultHeaders(..), knownMethods)

tests :: TestTree
tests = testGroup "Props.HTTP.Client"
  [ useDefaultHeadersProps
  , knownMethodsProps
  ]

-- ---------------------------------------------------------------------------
-- UseDefaultHeaders properties
--
-- data UseDefaultHeaders = ReplaceDefaultHeaders | AppendCustomToDefaultHeaders
--   deriving (Eq, Ord, Enum, Bounded, Show, Read)
-- ---------------------------------------------------------------------------

genUseDefaultHeaders :: Gen UseDefaultHeaders
genUseDefaultHeaders = Gen.element [minBound .. maxBound]

-- Read . Show is the identity (roundtrip).
prop_useDefaultHeaders_readshow_roundtrip :: Property
prop_useDefaultHeaders_readshow_roundtrip = property $ do
  udh <- forAll genUseDefaultHeaders
  (read (show udh) :: UseDefaultHeaders) === udh

-- Ord is consistent with Eq.
prop_useDefaultHeaders_ord_eq_consistent :: Property
prop_useDefaultHeaders_ord_eq_consistent = property $ do
  x <- forAll genUseDefaultHeaders
  y <- forAll genUseDefaultHeaders
  (x == y) === (y == x)

-- Ord is reflexive.
prop_useDefaultHeaders_ord_reflexive :: Property
prop_useDefaultHeaders_ord_reflexive = property $ do
  x <- forAll genUseDefaultHeaders
  compare x x === EQ

-- Enum / Bounded: toEnum . fromEnum is the identity.
prop_useDefaultHeaders_enum_roundtrip :: Property
prop_useDefaultHeaders_enum_roundtrip = property $ do
  udh <- forAll genUseDefaultHeaders
  toEnum (fromEnum udh) === udh

useDefaultHeadersProps :: TestTree
useDefaultHeadersProps = testGroup "UseDefaultHeaders"
  [ testProperty "Read . Show roundtrip"        prop_useDefaultHeaders_readshow_roundtrip
  , testProperty "Ord consistent with Eq"       prop_useDefaultHeaders_ord_eq_consistent
  , testProperty "Ord reflexive"                prop_useDefaultHeaders_ord_reflexive
  , testProperty "toEnum . fromEnum roundtrip"  prop_useDefaultHeaders_enum_roundtrip
  ]

-- ---------------------------------------------------------------------------
-- knownMethods properties
--
-- knownMethods :: [Method]  (Method = String)
-- A fixed list of standard HTTP method names.
-- ---------------------------------------------------------------------------

-- All methods are non-empty strings.
prop_knownMethods_nonempty :: Property
prop_knownMethods_nonempty = property $
  assert (not (any null knownMethods))

-- All methods consist only of ASCII uppercase letters.
prop_knownMethods_uppercase_ascii :: Property
prop_knownMethods_uppercase_ascii = property $
  assert (all (all isAsciiUpper) knownMethods)

-- There are no duplicate method names.
prop_knownMethods_no_duplicates :: Property
prop_knownMethods_no_duplicates = property $
  nub knownMethods === knownMethods

-- Choosing any method from the list and uppercasing it is a no-op (already uppercase).
prop_knownMethods_toUpper_identity :: Property
prop_knownMethods_toUpper_identity = property $ do
  m <- forAll $ Gen.element knownMethods
  map toUpper m === m

-- No method in the list contains a lowercase ASCII letter.
prop_knownMethods_no_lowercase :: Property
prop_knownMethods_no_lowercase = property $ do
  m <- forAll $ Gen.element knownMethods
  assert (not (any isAsciiLower m))

knownMethodsProps :: TestTree
knownMethodsProps = testGroup "knownMethods"
  [ testProperty "all methods are non-empty"          prop_knownMethods_nonempty
  , testProperty "all methods are uppercase ASCII"    prop_knownMethods_uppercase_ascii
  , testProperty "no duplicate methods"               prop_knownMethods_no_duplicates
  , testProperty "toUpper is identity on each method" prop_knownMethods_toUpper_identity
  , testProperty "no lowercase letters"               prop_knownMethods_no_lowercase
  ]