github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Bound arbitrary Keyed nodes.

Browse Source 
I really hope we can clean this up.
This commit is contained in:
Rob Rix 2015-12-11 11:00:06 -05:00
parent a7c959db6c
commit e6bddf1cf1
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
test/Spec.hs
View File

@ -10,6 +10,7 @@ import Control.Comonad.Cofree
import Control.Monad.Free hiding (unfold)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Tuple
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
@ -39,8 +40,12 @@ arbitraryBounded k = ArbitraryTerm <$> ((,) <$> arbitrary <*> oneof [
Leaf <$> arbitrary,
Indexed <$> vectorOfAtMost k (arbitraryBounded $ k - 1),
Syntax.Fixed <$> vectorOfAtMost k (arbitraryBounded $ k - 1),
Keyed . Map.fromList <$> arbitrary ])
Keyed . Map.fromList <$> (pairWithKey =<< vectorOfAtMost k (arbitraryBounded $ k - 1))])
where vectorOfAtMost k gen = choose (0, k) >>= \n -> vectorOf n gen
pairWithKey :: [ArbitraryTerm a annotation] -> Gen [(String, ArbitraryTerm a annotation)]
pairWithKey x = sequence (generatorOfThings <$> x)
generatorOfThings :: ArbitraryTerm a annotation -> Gen (String, ArbitraryTerm a annotation)
generatorOfThings x = (swap . (,) x) <$> arbitrary
instance Arbitrary HTML where
arbitrary = oneof [