MasseR
/
addressbook
1
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Update tests

This commit is contained in:
Mats Rauhala 2021-10-29 22:39:27 +03:00
parent 75aa615263
commit 537c0df198
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
test/Test/Data/Email/Header.hs
View File

@ -10,11 +10,12 @@ import qualified Hedgehog.Corpus as Corpus
import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range import qualified Hedgehog.Range as Range
import Data.Text import Data.ByteString
import qualified Data.Text as T import qualified Data.ByteString as T
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Email.Header import Data.Email.Header
import qualified Data.ByteString.Char8 as BC
genHeader :: Gen Header genHeader :: Gen Header
genHeader = Gen.choice genHeader = Gen.choice
@ -22,17 +23,17 @@ genHeader = Gen.choice
, To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail , To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail
] ]
genEmail :: Gen Text genEmail :: Gen ByteString
genEmail = do genEmail = do
name <- Gen.element Corpus.simpsons name <- Gen.element Corpus.simpsons
domain <- Gen.element Corpus.cooking domain <- Gen.element Corpus.cooking
tld <- Gen.element ["com","fi","org"] tld <- Gen.element ["com","fi","org"]
pure $ name <> "@" <> domain <> "." <> tld pure $ name <> "@" <> domain <> "." <> tld
wrapped :: Char -> Text -> Char -> Text wrapped :: Char -> ByteString -> Char -> ByteString
wrapped l x r = T.singleton l <> x <> T.singleton r wrapped l x r = BC.singleton l <> x <> BC.singleton r
genComment :: Gen Text genComment :: Gen ByteString
genComment = do genComment = do
x <- Gen.element Corpus.simpsons x <- Gen.element Corpus.simpsons
Gen.element [x, wrapped '"' x '"'] Gen.element [x, wrapped '"' x '"']