{-# LANGUAGE OverloadedStrings #-} module Test.Data.Buuka where import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty import Test.Tasty.Hedgehog import qualified Data.Aeson as A import qualified Data.Foldable as F import qualified Data.Text as T import Data.Buuka genUrl :: Gen URL genUrl = URL . T.concat <$> sequence go where go = [ Gen.element protocols, Gen.element domains, Gen.element tlds, pure "/", genPath ] protocols = ["http://", "https://"] domains = ["example", "foo", "bar"] tlds = ["com", "fi", "org", "net", "info"] genPath = T.intercalate "/" <$> Gen.list (Range.linear 0 10) (Gen.element paths) paths = ["foo", "bar", "asd", "xyzzy"] genBuukaEntry :: Gen BuukaEntry genBuukaEntry = BuukaEntry <$> genUrl <*> genTitle where genTitle = Gen.maybe (Gen.text (Range.linear 0 10) Gen.unicode) genBuuka :: Gen Buuka genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry prop_buukaentry_encode_decode :: Property prop_buukaentry_encode_decode = property $ do x <- forAll genBuukaEntry tripping x A.encode A.eitherDecode prop_buuka_encode_decode :: Property prop_buuka_encode_decode = property $ do x <- forAll genBuuka tripping x A.encode A.eitherDecode tests :: TestTree tests = testGroup "Data.Buuka" [ testProperty "Entries can be encoded and decoded" prop_buukaentry_encode_decode , testProperty "Entire set can be encoded and decoded" prop_buuka_encode_decode ]