buuka/test/Test/Data/Buuka.hs

{-# 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
  ]