Update tests
This commit is contained in:
parent
75aa615263
commit
537c0df198
@ -10,11 +10,12 @@ 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 Data.ByteString
|
||||
import qualified Data.ByteString as T
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import Data.Email.Header
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
|
||||
genHeader :: Gen Header
|
||||
genHeader = Gen.choice
|
||||
@ -22,17 +23,17 @@ genHeader = Gen.choice
|
||||
, To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail
|
||||
]
|
||||
|
||||
genEmail :: Gen Text
|
||||
genEmail :: Gen ByteString
|
||||
genEmail = do
|
||||
name <- Gen.element Corpus.simpsons
|
||||
domain <- Gen.element Corpus.cooking
|
||||
tld <- Gen.element ["com","fi","org"]
|
||||
pure $ name <> "@" <> domain <> "." <> tld
|
||||
|
||||
wrapped :: Char -> Text -> Char -> Text
|
||||
wrapped l x r = T.singleton l <> x <> T.singleton r
|
||||
wrapped :: Char -> ByteString -> Char -> ByteString
|
||||
wrapped l x r = BC.singleton l <> x <> BC.singleton r
|
||||
|
||||
genComment :: Gen Text
|
||||
genComment :: Gen ByteString
|
||||
genComment = do
|
||||
x <- Gen.element Corpus.simpsons
|
||||
Gen.element [x, wrapped '"' x '"']
|
||||
|
Loading…
Reference in New Issue
Block a user