gistfile1.txt

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)