{-# LANGUAGE OverloadedLists #-}
module Test.Data.Email.Header where

import Test.Tasty
import Test.Tasty.Hedgehog

import Hedgehog
import qualified Hedgehog.Corpus as Corpus
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import Data.Text
import qualified Data.Text as T
import qualified Data.Vector as V

import Data.Email.Header

genHeader :: Gen Header
genHeader = Gen.choice
  [ From <$> genEmail
  , To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail
  ]

genEmail :: Gen Text
genEmail = do
  name <- Gen.element Corpus.simpsons
  domain <- Gen.element Corpus.cooking
  tld <- Gen.element ["com","fi","org"]
  pure $ name <> "@" <> domain <> "." <> tld

genComment :: Gen Text
genComment = do
  x <- Gen.element Corpus.simpsons
  Gen.element [ "<" <> x <> ">", "(" <> x <> ")" ]

prop_roundtrip_parse :: Property
prop_roundtrip_parse = property $ do
  header <- forAll genHeader
  tripping header encode decode

prop_parse_from :: Property
prop_parse_from = property $ do
  email <- forAll genEmail
  decode ("From: " <> email) === Right (From email)

prop_parse_from_and_comments :: Property
prop_parse_from_and_comments = property $ do
  (email, comment) <- forAll $ (,) <$> genEmail <*> genComment
  decode ("From: " <> email <> " " <> comment) === Right (From email)

prop_parse_to_and_comments :: Property
prop_parse_to_and_comments = property $ do
  emails <- forAll $ Gen.list (Range.linear 1 10) ((,) <$> genEmail <*> genComment)
  let wanted = V.fromList $ fmap fst emails
  decode ("To: " <> T.intercalate ", " (fmap (\(e,c) -> e <> " " <> c) emails)) === Right (To wanted)

tests :: TestTree
tests = testGroup "Data.Email.Header"
  [ testProperty "roundtrip property" $ prop_roundtrip_parse
  , testProperty "any email can be read as from" $ prop_parse_from
  , testProperty "any email with comments can be parsed" $ prop_parse_from_and_comments
  , testProperty "any list of emails with comments can be parsed" $ prop_parse_to_and_comments
  ]