Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- type ModuleName = Int
- type ModuleGraph = HM.HashMap Int (HS.HashSet Int)
- singletonGraph :: Int -> [Int] -> ModuleGraph
- singletonGraph i ds = HM.singleton i (HS.fromList ds)
- arbModuleName :: Gen ModuleName
- arbModuleName = oneof (map return [0..100])
- arbModuleGraph :: Gen ModuleGraph
- arbModuleGraph = sized f where
- f 0 = return HM.empty
- f n = arbModuleName >>= rec
- rec :: Int -> Gen ModuleGraph
- rec d = smaller $ do
- ddeps <- listOf arbModuleName
- gs <- traverse rec ddeps
- return $ foldl (HM.unionWith HS.union) (singletonGraph d ddeps) gs
- newtype CyclicGraph = CyclicGraph (Int, ModuleGraph) deriving Show
- instance Arbitrary CyclicGraph where
- arbitrary = do
- rootInt <- arbModuleName
- graph <- rec rootInt
- return $ CyclicGraph (rootInt, graph)
- prop_fetchGraphHMIdentity :: CyclicGraph -> Bool
- prop_fetchGraphHMIdentity (CyclicGraph (root, g)) =
- trace (show g) (a == b) where
- g' = fmap HS.toList g
- a = HS.fromList (HM.keys g)
- b = HS.fromList . HM.keys . runIdentity $
- fetchGraphM (g' HM.!) (const . return) (join HM.singleton 0)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement