content: {-# LANGUAGE BangPatterns      #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  ------------------------------------------------------------------------------
  module Snap.Types.Headers.Tests (tests) where
  ------------------------------------------------------------------------------
  import           Data.CaseInsensitive           as CI
  import           Data.List                      (sort)
  import qualified Data.Set                       as Set
  import           Snap.Test.Common               (coverShowInstance)
  import qualified Snap.Types.Headers             as H
  import           Test.Framework                 (Test)
  import           Test.Framework.Providers.HUnit (testCase)
  import           Test.HUnit                     (assertBool, assertEqual)
  ------------------------------------------------------------------------------
  
  tests :: [Test]
  tests = [ testTrivials
          , testToFrom
          , testFolds
          ]
  
  
  ------------------------------------------------------------------------------
  testToFrom :: Test
  testToFrom = testCase "types/headers/toFrom" $ do
      let h = H.unsafeFromCaseFoldedList [("foo", "bar")]
      assertEqual "toFrom1" [("foo", "bar")] $ H.toList h
      assertEqual "toFrom2" [("foo", "bar")]
                  $ H.unsafeToCaseFoldedList $ H.fromList [("Foo", "bar")]
      assertBool "member" $ H.member "Foo" h
      assertBool "not member" $ not $ H.member "Fooooo" h
  
      let h' = H.set "foo" "zzz" . H.set "zzz" "qqq" $ h
      assertEqual "set/lookup" (Just "zzz") $ H.lookup "Foo" h'
      assertEqual "set/lookupD1" "zzz" $ H.lookupWithDefault "000" "Foo" h'
      assertEqual "set/lookupD2" "000" $ H.lookupWithDefault "000" "Zoo" h'
  
      assertEqual "toSort" [("a", "b"), ("foo","zzz"), ("zzz","qqq")] $ sort
                      $ H.unsafeToCaseFoldedList $ H.unsafeInsert "a" "b" h'
  
  
  ------------------------------------------------------------------------------
  testFolds :: Test
  testFolds = testCase "types/headers/folds" $ do
      let h  = H.fromList [("foo", "bar"), ("bar", "baz")]
      let r1 = Set.toAscList $ H.foldl' ffl Set.empty h
      let r2 = Set.toAscList $ H.foldr  ffr Set.empty h
      let r3 = Set.toAscList $ H.foldedFoldl' fl Set.empty h
      let r4 = Set.toAscList $ H.foldedFoldr  fr Set.empty h
  
      let r  = ["bar", "baz", "foo"]
      assertEqual "r1" r r1
      assertEqual "r2" r r2
      assertEqual "r3" r r3
      assertEqual "r4" r r4
  
    where
      fl !s !k v  = Set.insert k $ Set.insert v s
      fr !k v !s  = Set.insert k $ Set.insert v s
      ffl !s !k v = Set.insert (CI.foldedCase k) $ Set.insert v s
      ffr !k v !s = Set.insert (CI.foldedCase k) $ Set.insert v s
  
  ------------------------------------------------------------------------------
  testTrivials :: Test
  testTrivials = testCase "types/headers/show" $ do
      let h = H.empty
      assertBool "null" $ H.null h
      assertEqual "lookupWithDefault" "ok" $ H.lookupWithDefault "ok" "foo" h
      assertEqual "foldr" () $ H.foldr (\_ _ x -> x) () $ H.insert "ok" "ok" h
      assertEqual "foldl'" () $ H.foldl' (\x _ _ -> x) () $ H.insert "ok" "ok" h
      assertEqual "foldedFoldr" () $
                  H.foldedFoldr (\_ _ x -> x) () $ H.unsafeInsert "ok" "ok" h
      assertEqual "foldedFoldl'" () $
                  H.foldedFoldl' (\x _ _ -> x) () $ H.unsafeInsert "ok" "ok" h
      assertBool "member" $ not $ H.member "foo" h
      coverShowInstance h
  