github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +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 Control.Monad.Free hiding (unfold)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Tuple
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck import Test.Hspec.QuickCheck
import Test.QuickCheck import Test.QuickCheck
@ -39,8 +40,12 @@ arbitraryBounded k = ArbitraryTerm <$> ((,) <$> arbitrary <*> oneof [
Leaf <$> arbitrary, Leaf <$> arbitrary,
Indexed <$> vectorOfAtMost k (arbitraryBounded $ k - 1), Indexed <$> vectorOfAtMost k (arbitraryBounded $ k - 1),
Syntax.Fixed <$> 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 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 instance Arbitrary HTML where
arbitrary = oneof [ arbitrary = oneof [