content: {-# LANGUAGE PatternSynonyms #-}
  
  module Test.Toml.Type.PrefixTree
      ( prefixTreeSpec
      ) where
  
  import Hedgehog (forAll, (===))
  import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it, parallel, shouldBe)
  import Test.Hspec.Hedgehog (hedgehog)
  
  import Test.Toml.Gen (genKey, genPrefixMap, genVal)
  import Test.Toml.Property (assocSemigroup, leftIdentityMonoid, rightIdentityMonoid)
  import Toml.Type.Key (pattern (:||))
  
  import qualified Toml.Type.PrefixTree as Prefix
  
  
  prefixTreeSpec :: Spec
  prefixTreeSpec = describe "PrefixTree unit and property tests" $ do
      prefixTreeUnitSpec
      prefixTreePropertySpec
  
  prefixTreeUnitSpec :: Spec
  prefixTreeUnitSpec = describe "Unit tests for basic cases" $ do
      -- some test keys
      let a  = "a" :|| []
      let b  = "b" :|| []
      let c  = "c" :|| []
      let ab = "a" :|| ["b"]
  
      it "Lookup on empty map returns Nothing" $
          Prefix.lookup @Bool a mempty `shouldBe` Nothing
      it "Lookup in single map returns this element" $ do
          let t = Prefix.single a True
          Prefix.lookup a t `shouldBe` Just True
          Prefix.lookup b t `shouldBe` Nothing
      it "Lookup after insert returns this element" $ do
          let t = Prefix.insert a True mempty
          Prefix.lookup a t `shouldBe` Just True
          Prefix.lookup b t `shouldBe` Nothing
      it "Lookup after multiple non-overlapping inserts" $ do
          let t = Prefix.insert a True $ Prefix.insert b False mempty
          Prefix.lookup a t `shouldBe` Just True
          Prefix.lookup b t `shouldBe` Just False
          Prefix.lookup c t `shouldBe` Nothing
      it "Prefix lookup" $ do
          let t = Prefix.insert ab True mempty
          Prefix.lookup a  t `shouldBe` Nothing
          Prefix.lookup ab t `shouldBe` Just True
      it "Composite key lookup" $ do
          let t = Prefix.insert a True $ Prefix.insert ab False mempty
          Prefix.lookup a  t `shouldBe` Just True
          Prefix.lookup ab t `shouldBe` Just False
  
  prefixTreePropertySpec :: Spec
  prefixTreePropertySpec = parallel $ describe "Laws and behaviour property tests" $ do
      insertLookupSpec
      insertInsertSpec
      assocSemigroup      genPrefixMap
      leftIdentityMonoid  genPrefixMap
      rightIdentityMonoid genPrefixMap
  
  insertLookupSpec :: SpecWith (Arg Expectation)
  insertLookupSpec = it "lookup k (insert k v m) ≡ Just v" $ hedgehog $ do
      t   <- forAll genPrefixMap
      key <- forAll genKey
      val <- forAll genVal
  
      Prefix.lookup key (Prefix.insert key val t) === Just val
  
      -- DEBUG: ensures that trees of depth at least 5 are generated
      -- assert $ depth prefMap < 5
  
  insertInsertSpec :: SpecWith (Arg Expectation)
  insertInsertSpec = it "insert x a . insert x b ≡ insert x a" $ hedgehog $ do
      t <- forAll genPrefixMap
      x <- forAll genKey
      a <- forAll genVal
      b <- forAll genVal
  
      Prefix.lookup x (Prefix.insert x a $ Prefix.insert x b t) === Just a
  
  ----------------------------------------------------------------------------
  -- DEBUG
  ----------------------------------------------------------------------------
  
  -- useful functions to test generators
  -- uncomment when you need them
  
  -- depth :: PrefixMap a -> Int
  -- depth = HashMap.foldl' (\acc t -> max acc (depthT t)) 0
  --
  -- depthT :: PrefixTree a -> Int
  -- depthT (Leaf _ _)           = 1
  -- depthT (Branch _ _ prefMap) = 1 + depth prefMap
  