packages feed

th-typegraph 0.32 → 0.33

raw patch · 13 files changed

+490/−354 lines, 13 filesdep +microlens-compat

Dependencies added: microlens-compat

Files

Language/Haskell/TH/TypeGraph/Arity.hs view
@@ -7,7 +7,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Desugar ({- instances -}) import Language.Haskell.TH.Syntax (Quasi(qReify))-import Language.Haskell.TH.TypeGraph.Prelude (pprint')+import Language.Haskell.TH.TypeGraph.Prelude (pprint1)  -- | Compute the arity of a type - the number of type parameters that -- must be applied to it in order to obtain a concrete type.  I'm not@@ -22,13 +22,13 @@       typeArity' (VarT _) = return 1       typeArity' (AppT t _) = typeArity' t >>= \ n -> return $ n - 1       typeArity' (ConT name) = qReify name >>= infoArity-      typeArity' typ = error $ "typeArity (" ++ pprint' t0 ++ ") - unexpected type: " ++ show typ+      typeArity' typ = error $ "typeArity (" ++ pprint1 t0 ++ ") - unexpected type: " ++ show typ       infoArity (TyConI dec) = decArity dec       infoArity (PrimTyConI _ _ _) = return 0       infoArity (FamilyI dec _) = decArity dec-      infoArity info = error $ "typeArity (" ++ pprint' t0 ++ ")- unexpected info: " ++ show info+      infoArity info = error $ "typeArity (" ++ pprint1 t0 ++ ")- unexpected info: " ++ show info       decArity (DataD _ _ vs _ _) = return $ length vs       decArity (NewtypeD _ _ vs _ _) = return $ length vs       decArity (TySynD _ vs t) = typeArity' t >>= \ n -> return $ n + length vs       decArity (FamilyD _ _ vs _mk) = return $ {- not sure what to do with the kind mk here -} length vs-      decArity dec = error $ "typeArity (" ++ pprint' t0 ++ ")- unexpected dec: " ++ show dec+      decArity dec = error $ "typeArity (" ++ pprint1 t0 ++ ")- unexpected dec: " ++ show dec
Language/Haskell/TH/TypeGraph/Edges.hs view
@@ -47,7 +47,7 @@ import Language.Haskell.TH -- (Con, Dec, nameBase, Type) import Language.Haskell.TH.TypeGraph.Expand (E(E), ExpandMap, expandType) import Language.Haskell.TH.TypeGraph.TypeInfo (TypeInfo, infoMap, typeSet, allVertices, fieldVertex, typeVertex')-import Language.Haskell.TH.TypeGraph.Vertex (TGV, TGVSimple, vsimple)+import Language.Haskell.TH.TypeGraph.Vertex (TGV', TGVSimple', vsimple) import Language.Haskell.TH.Desugar as DS (DsMonad) import Language.Haskell.TH.Instances () import Prelude hiding (foldr, mapM_, null)@@ -58,9 +58,9 @@ -- fields, build and return the GraphEdges relation on TypeGraphVertex. -- This is not a recursive function, it stops when it reaches the field -- types.-typeGraphEdges :: forall m. (DsMonad m, Functor m, MonadReaders TypeInfo m, MonadStates ExpandMap m) => m (GraphEdges TGV)+typeGraphEdges :: forall m. (DsMonad m, Functor m, MonadReaders TypeInfo m, MonadStates ExpandMap m) => m (GraphEdges TGV') typeGraphEdges = do-  execStateT (view typeSet <$> askPoly >>= mapM_ (\t -> lift (expandType t) >>= doType)) (mempty :: GraphEdges TGV)+  execStateT (view typeSet <$> askPoly >>= mapM_ (\t -> lift (expandType t) >>= doType)) (mempty :: GraphEdges TGV')     where       doType typ = do         vs <- allVertices Nothing typ@@ -76,25 +76,25 @@             doType (E typ2)           _ -> return () -      doInfo :: Set TGV -> Info -> StateT (GraphEdges TGV) m ()+      doInfo :: Set TGV' -> Info -> StateT (GraphEdges TGV') m ()       doInfo vs (TyConI dec) = doDec vs dec       -- doInfo vs (PrimTyConI tname _ _) = return ()       doInfo _ _ = return () -      doDec :: Set TGV -> Dec -> StateT (GraphEdges TGV) m ()+      doDec :: Set TGV' -> Dec -> StateT (GraphEdges TGV') m ()       doDec _ (TySynD _ _ _) = return () -- This type will be in typeSet       doDec vs (NewtypeD _ tname _ constr _) = doCon vs tname constr       doDec vs (DataD _ tname _ constrs _) = mapM_ (doCon vs tname) constrs       doDec _ _ = return () -      doCon :: Set TGV -> Name -> Con -> StateT (GraphEdges TGV) m ()+      doCon :: Set TGV' -> Name -> Con -> StateT (GraphEdges TGV') m ()       doCon vs tname (ForallC _ _ con) = doCon vs tname con       doCon vs tname (NormalC cname flds) = mapM_ (uncurry (doField vs tname cname)) (List.map (\ (n, (_, ftype)) -> (Left n, ftype)) (zip [1..] flds))       doCon vs tname (RecC cname flds) = mapM_ (uncurry (doField vs tname cname)) (List.map (\ (fname, _, ftype) -> (Right fname, ftype)) flds)       doCon vs tname (InfixC (_, lhs) cname (_, rhs)) = doField vs tname cname (Left 1) lhs >> doField vs tname cname (Left 2) rhs        -- Connect the vertex for this record type to one particular field vertex-      doField ::  DsMonad m => Set TGV -> Name -> Name -> Either Int Name -> Type -> StateT (GraphEdges TGV) m ()+      doField ::  DsMonad m => Set TGV' -> Name -> Name -> Either Int Name -> Type -> StateT (GraphEdges TGV') m ()       doField vs tname cname fld ftyp = do         v2 <- lift (expandType ftyp) >>= fieldVertex (tname, cname, fld)         v3 <- lift (expandType ftyp) >>= typeVertex'@@ -103,15 +103,15 @@         -- Here's where we don't recurse, see?         -- doVertex v2 -      node :: TGV -> StateT (GraphEdges TGV) m ()+      node :: TGV' -> StateT (GraphEdges TGV') m ()       -- node v = pass (return ((), (Map.alter (Just . maybe (def, Set.empty) id) v)))-      node v = modifyPoly (Map.alter (Just . maybe (Set.empty) id) v :: Map TGV (Set TGV) -> Map TGV (Set TGV))+      node v = modifyPoly (Map.alter (Just . maybe (Set.empty) id) v :: Map TGV' (Set TGV') -> Map TGV' (Set TGV')) -      edge :: TGV -> TGV -> StateT (GraphEdges TGV) m ()+      edge :: TGV' -> TGV' -> StateT (GraphEdges TGV') m ()       edge v1 v2 = node v2 >> modifyPoly f-          where f :: GraphEdges TGV -> GraphEdges TGV+          where f :: GraphEdges TGV' -> GraphEdges TGV'                 f = Map.alter g v1-                g :: (Maybe (Set TGV) -> Maybe (Set TGV))+                g :: (Maybe (Set TGV') -> Maybe (Set TGV'))                 g = Just . maybe (singleton v2) (Set.insert v2)  -- | Isolate and remove matching nodes@@ -181,7 +181,7 @@ -- | Simplify a graph by throwing away the field information in each -- node.  This means the nodes only contain the fully expanded Type -- value (and any type synonyms.)-simpleEdges :: GraphEdges TGV -> GraphEdges TGVSimple+simpleEdges :: GraphEdges TGV' -> GraphEdges TGVSimple' simpleEdges = Map.mapWithKey (\v s -> (Set.delete v s)) .    -- delete any self edges               Map.mapKeysWith Set.union (view vsimple) .   -- simplify each vertex               Map.map (Set.map (view vsimple)) -- simplify the out edges
Language/Haskell/TH/TypeGraph/Free.hs view
@@ -12,7 +12,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Desugar ({- instances -}) import Language.Haskell.TH.Syntax (Quasi(qReify))-import Language.Haskell.TH.TypeGraph.Prelude (pprint')+import Language.Haskell.TH.TypeGraph.Prelude (pprint1)  data St     = St { _result :: Set Name@@ -77,7 +77,7 @@ go_info params (TyConI dec) = go_dec params ({-trace ("go_dec " ++ show dec)-} dec) go_info params (FamilyI dec _insts) = go_dec params dec go_info _params (PrimTyConI _name _arity _unlifed) = return ()-go_info _params info = error $ "go_info - unexpected: " ++ pprint' info+go_info _params info = error $ "go_info - unexpected: " ++ pprint1 info go_dec :: (Quasi m, MonadState St m) => [Type] -> Dec -> m () go_dec params (NewtypeD cx tname tvs con supers) = go_dec params (DataD cx tname tvs [con] supers) go_dec params (DataD _ tname tvs _ _) | length params > length tvs = error $ "Too many arguments to " ++ show tname@@ -106,7 +106,7 @@ -- -- so the parameter is bound to k, and $a should be free. go_dec params (FamilyD _flavour tname tvs _mkind) = go_params tname tvs params-go_dec params dec = error $ "go_dec - unexpected: " ++ pprint' dec ++ ", params=" ++ show params+go_dec params dec = error $ "go_dec - unexpected: " ++ pprint1 dec ++ ", params=" ++ show params  go_params :: (Quasi m, MonadState St m) => Name -> [TyVarBndr] -> [Type] -> m () go_params tname tvs params | length params  > length tvs = error $ "Too many arguments to " ++ show tname@@ -117,7 +117,7 @@ go_param tvb (Just param) = do   -- If there is a binding, add the free variables found in the type   -- and remove the variable bound here-  -- trace ("go_param " ++ "(" ++ pprint tvb ++ ", " ++ pprint' param ++ ")") (return ())+  -- trace ("go_param " ++ "(" ++ pprint tvb ++ ", " ++ pprint1 param ++ ")") (return ())   ftv param   result %= Set.delete (tvbName tvb)   -- let tv = tvbName tvb
Language/Haskell/TH/TypeGraph/Lens.hs view
@@ -18,11 +18,12 @@     ) where  import Control.Category ((.))-import Control.Lens as Lens (makeLensesFor, view)+import Control.Lens as Lens (_2, makeLensesFor, view) import Control.Monad.Readers (MonadReaders) import Control.Monad.States (MonadStates) import Control.Monad.Writer (execWriterT, tell)-import Data.Map as Map (keys)+import Data.Map as Map (keys, Map)+import Data.Set (Set) import Language.Haskell.Exts.Syntax () import Language.Haskell.TH import Language.Haskell.TH.Desugar (DsMonad)@@ -32,7 +33,7 @@ import Language.Haskell.TH.TypeGraph.Stack (lensNamer) import Language.Haskell.TH.TypeGraph.TypeGraph (allLensKeys, TypeGraph) import Language.Haskell.TH.TypeGraph.TypeInfo (TypeInfo)-import Language.Haskell.TH.TypeGraph.Vertex (etype)+import Language.Haskell.TH.TypeGraph.Vertex (etype, TGVSimple, TGV) import Prelude hiding ((.))  -- | Generate lenses to access the fields of the row types.  Like@@ -43,7 +44,7 @@ -- makeLensesFor should be used instead. makeTypeGraphLenses :: forall m. (DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m, MonadStates ExpandMap m) => m [Dec] makeTypeGraphLenses =-    allLensKeys >>= execWriterT . mapM doType . map (view etype) . Map.keys+    (allLensKeys :: m (Map TGVSimple (Set TGV))) >>= execWriterT . mapM doType . map (view (_2 . etype)) . Map.keys     where       doType (E (ConT tname)) = qReify tname >>= doInfo       doType _ = return ()
Language/Haskell/TH/TypeGraph/Prelude.hs view
@@ -6,7 +6,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} module Language.Haskell.TH.TypeGraph.Prelude-    ( pprint'+    ( pprint1+    , pprintW+    , pprintL     , OverTypes(overTypes)     , unlifted     , constructorName@@ -26,11 +28,12 @@ import Data.Graph as Graph import Data.List (intersperse) import Data.Map as Map (Map, fromList, toList)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromJust, fromMaybe) import Data.Set as Set (fromList, Set, toList) import Language.Haskell.TH-import Language.Haskell.TH.PprLib (ptext, hcat)+import Language.Haskell.TH.PprLib import Language.Haskell.TH.Syntax (Lift(lift), Name(Name), NameFlavour(NameS), Quasi(qReify), StrictType, VarStrictType)+import qualified Text.PrettyPrint as HPJ  instance Ppr () where     ppr () = ptext "()"@@ -43,9 +46,18 @@ -- | Pretty print a 'Ppr' value on a single line with each block of -- white space (newlines, tabs, etc.) converted to a single space, and -- all the module qualifiers removed from the names.-pprint' :: (Ppr a, Data a) => a -> [Char]-pprint' typ = unwords $ words $ pprint $ friendlyNames $ typ+pprint1 :: (Ppr a, Data a) => a -> [Char]+pprint1 typ = pprintStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode}) $ friendlyNames $ typ +pprintW :: (Ppr a, Data a) => a -> [Char]+pprintW typ = pprintStyle (HPJ.style {HPJ.lineLength = 250}) $ friendlyNames $ typ++pprintL :: (Ppr a, Data a) => a -> [Char]+pprintL typ = pprintStyle (HPJ.style {HPJ.mode = HPJ.LeftMode}) $ friendlyNames $ typ++pprintStyle :: (Data a, Ppr a) => HPJ.Style -> a -> String+pprintStyle style x = HPJ.renderStyle style $ to_HPJ_Doc $ ppr $ friendlyNames x+ -- | Perform a fold over the Type and Info values embedded in t class OverTypes t where     overTypes :: Quasi m => (a -> Either Info Type -> m a) -> a -> t -> m a@@ -130,17 +142,19 @@ unReifyName = mkName . nameBase  -- | Return a key's list of adjacent keys-adjacent' :: forall node key. (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) -> key -> [key]-adjacent' (_, vf, kf) k =-    view _3 $ vf v+adjacent' :: forall node key. (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) -> (Vertex, key) -> [(Vertex, key)]+adjacent' (_, vf, kf) (_, k) =+    map (\k' -> (fromJust (kf k'), k')) ks     where+      ks = view _3 $ vf v       v = fromMaybe (error "Language.Haskell.TH.TypeGraph.Prelude.adjacent") (kf k)  -- | Return a key's list of reachable keys-reachable' :: forall node key. (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) -> key -> [key]-reachable' (g, vf, kf) k =-    map (view _2 . vf) $ reachableVerts+reachable' :: forall node key. (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) -> (Vertex, key) -> [(Vertex, key)]+reachable' (g, vf, kf) (_, k) =+    map (\k' -> (fromJust (kf k'), k')) ks     where+      ks = map (view _2 . vf) $ reachableVerts       reachableVerts = Graph.reachable g v       v = fromMaybe (error "Language.Haskell.TH.TypeGraph.Prelude.reachable") (kf k)
Language/Haskell/TH/TypeGraph/Stack.hs view
@@ -136,7 +136,7 @@ stackLens :: TypeStack -> Q Exp stackLens stk =     case view typeStack stk of-      [] -> [| iso id id |]+      [] -> [| id |]       xs -> mapM fieldLens xs >>= foldl1 (\ a b -> [|$b . $a|]) . map return  nthLens :: Int -> Lens' [a] a
Language/Haskell/TH/TypeGraph/TypeGraph.hs view
@@ -16,11 +16,17 @@     , makeTypeGraph     , graphFromMap +    -- , MaybePair(toMaybePair)+    , HasTGV(asTGV)+    , HasTGVSimple(asTGVSimple)+     -- * TypeGraph queries+    , simplify     , allPathNodes     , allPathStarts     , lensKeys, allLensKeys-    , pathKeys, allPathKeys+    , tgv, tgvSimple, tgvSimple'+    , pathKeys, pathKeys', allPathKeys     , reachableFrom     , reachableFromSimple     , goalReachableFull@@ -28,7 +34,7 @@     , goalReachableSimple'      , VertexStatus(..)-    , adjacent+    -- , adjacent     , typeGraphVertex     , typeGraphVertexOfField     ) where@@ -52,31 +58,31 @@ import Data.Map.Strict as Map (insertWith, Map) import qualified Data.Map.Strict as Map (toList) import Data.Maybe (fromJust, mapMaybe)-import Data.Set.Extra as Set (empty, fromList, map, Set, singleton, toList, union, unions)+import Data.Set.Extra as Set (empty, fromList, map, mapM, Set, singleton, toList, union) import Data.Traversable as Traversable import Language.Haskell.Exts.Syntax () import Language.Haskell.TH import Language.Haskell.TH.Desugar (DsMonad) import Language.Haskell.TH.Instances () import Language.Haskell.TH.PprLib (ptext, vcat)-import Language.Haskell.TH.Syntax (Quasi(..)) import Language.Haskell.TH.TypeGraph.Edges (GraphEdges, simpleEdges)-import Language.Haskell.TH.TypeGraph.Expand (E(E), ExpandMap, expandType)+import Language.Haskell.TH.TypeGraph.Expand (ExpandMap, expandType) import Language.Haskell.TH.TypeGraph.Prelude (adjacent', reachable')-import Language.Haskell.TH.TypeGraph.TypeInfo (startTypes, TypeInfo, typeVertex', fieldVertex)+import Language.Haskell.TH.TypeGraph.TypeInfo (startTypes, TypeInfo, typeVertex, typeVertex', fieldVertex)+import Language.Haskell.TH.TypeGraph.Shape (Field) import Language.Haskell.TH.TypeGraph.Stack (StackElement)-import Language.Haskell.TH.TypeGraph.Vertex (TGV, TGVSimple, tgv, vsimple, TypeGraphVertex, etype)+import Language.Haskell.TH.TypeGraph.Vertex (TGV'(..), TGV, TGVSimple'(..), TGVSimple, TypeGraphVertex(bestType), vsimple) import Prelude hiding (any, concat, concatMap, elem, exp, foldr, mapM_, null, or)  data TypeGraph     = TypeGraph-      { _graph :: (Graph, Vertex -> ((), TGV, [TGV]), TGV -> Maybe Vertex)-      , _gsimple :: (Graph, Vertex -> ((), TGVSimple, [TGVSimple]), TGVSimple -> Maybe Vertex)+      { _graph :: (Graph, Vertex -> ((), TGV', [TGV']), TGV' -> Maybe Vertex)+      , _gsimple :: (Graph, Vertex -> ((), TGVSimple', [TGVSimple']), TGVSimple' -> Maybe Vertex)       , _stack :: [StackElement]       }  -- | Build a TypeGraph given a set of edges and the TypeInfo environment-makeTypeGraph :: MonadReaders TypeInfo m => (GraphEdges TGV) -> m TypeGraph+makeTypeGraph :: MonadReaders TypeInfo m => (GraphEdges TGV') -> m TypeGraph makeTypeGraph es = do   return $ TypeGraph              { _graph = graphFromMap es@@ -106,46 +112,105 @@     askPoly = lift askPoly     localPoly f action = MTL.ask >>= MTL.runReaderT (localPoly f (lift action)) +instance Ppr TypeGraph where+    ppr = ppr . view graph+ instance Ppr Vertex where     ppr n = ptext ("V" ++ show n) -instance Ppr (Graph, Vertex -> ((), TGV, [TGV]), TGV -> Maybe Vertex) where+instance Ppr (Graph, Vertex -> ((), TGV', [TGV']), TGV' -> Maybe Vertex) where     ppr (g, vf, _) = vcat (List.map (ppr . vf) (vertices g)) -instance Ppr (Graph, Vertex -> ((), TGVSimple, [TGVSimple]), TGVSimple -> Maybe Vertex) where+instance Ppr (Graph, Vertex -> ((), TGVSimple', [TGVSimple']), TGVSimple' -> Maybe Vertex) where     ppr (g, vf, _) = vcat (List.map (ppr . vf) (vertices g)) +{-+class MaybePair t n where toMaybePair :: (Vertex, n) -> t+instance MaybePair (Vertex, n) n where toMaybePair = id+instance MaybePair t t where toMaybePair = snd+-}++class HasTGV a where asTGV :: a -> TGV'+class HasTGVSimple a where asTGVSimple :: a -> TGVSimple'++-- instance HasTGV TGV where asTGV = id+-- instance HasTGVSimple TGVSimple where asTGVSimple = id++instance HasTGV TGV where asTGV = snd+instance HasTGVSimple TGVSimple where asTGVSimple = snd+ -- | All the nodes in the TGV (unsimplified) graph, where each field -- of a record is a distinct node. allPathNodes :: forall m. (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Set TGV) allPathNodes = do   (g, vf, kf) <- askPoly >>= return . view graph   kernel <- askPoly >>= \ti -> MTL.runReaderT (Traversable.mapM expandType (view startTypes ti) >>= Traversable.mapM typeVertex') ti-  let keep = Set.fromList $ concatMap (reachable g) (mapMaybe kf kernel)-      keep' = Set.map (view _2) . Set.map vf $ keep+  let keep :: Set Vertex+      keep = Set.fromList $ concatMap (reachable g) (mapMaybe kf kernel)+      keep' :: Set TGV+      keep' = Set.map (\v -> (v, view _2 (vf v))) keep   return keep'  -- | All the nodes in the TGVSimple graph, where each field representa -- a different type.-allPathStarts :: forall m. (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Set TGVSimple)-allPathStarts = Set.map (view vsimple) <$> allPathNodes+allPathStarts :: forall m. (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) =>+                 m (Set TGVSimple)+allPathStarts = do+  ts <- allPathNodes :: m (Set TGV)+  Set.mapM (tgvSimple . bestType) ts  view' :: MonadReaders s m => Getting b s b -> m b view' lns = view lns <$> askPoly  -- | Each lens represents a single step in a path.  The start point is -- a simplified vertex and the endpoint is an unsimplified vertex.-allLensKeys :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Map TGVSimple (Set TGV))+allLensKeys :: forall m. (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Map TGVSimple (Set TGV)) allLensKeys = do-  starts <- Set.toList <$> allPathStarts-  foldM (\mp s -> lensKeys s >>= return . Fold.foldr (Map.insertWith Set.union s . Set.singleton) mp) mempty starts+  (starts :: Set TGVSimple) <- allPathStarts+  foldM (\mp s -> do+           ts <- lensKeys s :: m (Set TGV)+           return $ Fold.foldr (Map.insertWith Set.union s . Set.singleton) mp ts+        ) mempty (Set.toList starts) +-- | Find the node corresponding to the given simple graph node in the+-- full graph.+tgv :: MonadReaders TypeGraph m => Maybe Field -> TGVSimple -> m TGV+tgv mf s =+    do let t = TGV' { _field = mf, _vsimple = asTGVSimple s}+       (_g, vf, kf) <- askPoly >>= return . view graph+       case kf t of+         Just v -> let (_, t', _) = vf v in return (v, t')+         Nothing -> error $ "tgv: " ++ show mf ++ " " ++ show s++-- | Find the simple graph node corresponding to the given type+tgvSimple :: (MonadStates ExpandMap m, DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m) => Type -> m TGVSimple+tgvSimple t =+    do (_g, _vf, kf) <- askPoly >>= return . view gsimple+       s <- expandType t >>= typeVertex+       let k = maybe (error ("tgvSimple: " ++ show t)) id (kf s)+       return (k, s)++tgvSimple' :: (MonadStates ExpandMap m, DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m) => Type -> m (Maybe TGVSimple)+tgvSimple' t =+    do (_g, _vf, kf) <- askPoly >>= return . view gsimple+       s <- expandType t >>= typeVertex+       return $ fmap (\k -> (k, s)) (kf s)+ -- | Return the nodes adjacent to x in the lens graph.-lensKeys :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => TGVSimple -> m (Set TGV)-lensKeys x = do+lensKeys :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) =>+            TGVSimple -> m (Set TGV)+lensKeys s = do   g <- view' graph-  return $ Set.fromList $ adjacent' g (tgv x)+  t <- tgv Nothing s+  return $ Set.fromList $ adjacent' g t +simplify :: (MonadReaders TypeGraph m, HasTGV t) => t -> m TGVSimple+simplify t = do+  (_, _, kf) <- view' gsimple+  let s = (view vsimple . asTGV) t+  let v = (fromJust . kf) s+  return (v, s)+ -- | Paths go between simple types. allPathKeys :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Map TGVSimple (Set TGVSimple)) allPathKeys = do@@ -154,46 +219,60 @@  -- | Return the nodes reachable from x in the path graph. pathKeys :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => TGVSimple -> m (Set TGVSimple)-pathKeys x = do+pathKeys s = do   gs <- view' gsimple-  return $ Set.fromList $ reachable' gs x+  return $ Set.fromList $ reachable' gs s +-- | Return the nodes reachable from x in the path graph.+pathKeys' :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => TGV -> m (Set TGVSimple)+pathKeys' s = do+  gs <- view' graph+  Set.fromList <$> Prelude.mapM simplify (reachable' gs s)+   -- allPathStarts >>= return . Map.fromList . List.map (\x -> (x, Set.fromList (reachable' gs x))) . Set.toList . Set.map (view vsimple)  reachableFrom :: forall m. (DsMonad m, MonadReaders TypeGraph m) => TGV -> m (Set TGV)-reachableFrom v = do+reachableFrom t = do   -- (g, vf, kf) <- graphFromMap <$> view edges   (g, vf, kf) <- view' graph-  case kf v of+  case kf (asTGV t) of     Nothing -> return Set.empty-    Just v' -> return $ Set.map (\(_, key, _) -> key) . Set.map vf $ Set.fromList $ reachable (transposeG g) v'+    Just v ->+        let vs = Set.fromList (reachable (transposeG g) v) in+        return $ Set.map (\v' -> let (_, t', _) = vf v' in (v', t')) vs  reachableFromSimple :: forall m. (DsMonad m, MonadReaders TypeGraph m) => TGVSimple -> m (Set TGVSimple)-reachableFromSimple v = do+reachableFromSimple s = do   -- (g, vf, kf) <- graphFromMap <$> view edges   (g, vf, kf) <- view' gsimple-  case kf v of+  case kf (asTGVSimple s) of     Nothing -> return Set.empty-    Just v' -> return $ Set.map (\(_, key, _) -> key) . Set.map vf $ Set.fromList $ reachable (transposeG g) v'+    Just v ->+        let vs = Set.fromList (reachable (transposeG g) v) in+        return $ Set.map (\v' -> let (_, s', _) = vf v' in (v', s')) vs  -- | Can we reach the goal type from the start type in this key?-goalReachableFull :: (Functor m, DsMonad m, MonadReaders TypeGraph m) => TGV -> TGV -> m Bool-goalReachableFull gkey key0 = isReachable gkey key0 <$> view' graph+goalReachableFull :: (Functor m, DsMonad m, MonadReaders TypeGraph m, HasTGV t) => t -> t -> m Bool+goalReachableFull gkey key0 = isReachable (asTGV gkey) (asTGV key0) <$> view' graph  -- | Can we reach the goal type in the simplified graph?-goalReachableSimple :: (Functor m, DsMonad m, MonadReaders TypeGraph m) => TGVSimple -> TGVSimple -> m Bool-goalReachableSimple gkey key0 = isReachable gkey key0 <$> view' gsimple+goalReachableSimple :: (Functor m, DsMonad m, MonadReaders TypeGraph m, HasTGVSimple s) => s -> s -> m Bool+goalReachableSimple gkey key0 = isReachable (asTGVSimple gkey) (asTGVSimple key0) <$> view' gsimple  -- | Version of goalReachableSimple that first simplifies its argument nodes-goalReachableSimple' :: (Functor m, DsMonad m, MonadReaders TypeGraph m) => TGV -> TGV -> m Bool-goalReachableSimple' gkey key0 = goalReachableSimple (view vsimple gkey) (view vsimple key0)+goalReachableSimple' :: (Functor m, DsMonad m, MonadReaders TypeGraph m, HasTGV t) => t -> t -> m Bool+goalReachableSimple' gkey key0 = do+  (_g, _vf, kf) <- view' gsimple+  let gkey' = view vsimple (asTGV gkey)+      key0' = view vsimple (asTGV key0)+  goalReachableSimple (fromJust (kf gkey'), gkey') (fromJust (kf key0'), key0')  isReachable :: TypeGraphVertex key => key -> key -> (Graph, Vertex -> ((), key, [key]), key -> Maybe Vertex) -> Bool isReachable gkey key0 (g, _vf, kf) = path g (fromJust $ kf key0) (fromJust $ kf gkey)  -- | Return the TGV associated with a particular type, -- with no field specified.-typeGraphVertex :: ({-MonadReaders TypeGraph m,-} MonadReaders TypeInfo m, MonadStates ExpandMap m, DsMonad m) => Type -> m TGV+typeGraphVertex :: ({-MonadReaders TypeGraph m,-} MonadReaders TypeInfo m, MonadStates ExpandMap m, DsMonad m) => Type -> m TGV' typeGraphVertex typ = do         typ' <- expandType typ         askPoly >>= \(ti :: TypeInfo) -> MTL.runReaderT (typeVertex' typ') ti@@ -201,7 +280,7 @@  -- | Return the TGV associated with a particular type and field. typeGraphVertexOfField :: ({-MonadReaders TypeGraph m,-} MonadReaders TypeInfo m, MonadStates ExpandMap m, DsMonad m) =>-                          (Name, Name, Either Int Name) -> Type -> m TGV+                          (Name, Name, Either Int Name) -> Type -> m TGV' typeGraphVertexOfField fld typ = do         typ' <- expandType typ         askPoly >>= \(ti :: TypeInfo) -> MTL.runReaderT (fieldVertex fld typ') ti@@ -221,6 +300,7 @@ instance Default (VertexStatus typ) where     def = Vertex +{- -- | Return the set of adjacent vertices according to the default type -- graph - i.e. the one determined only by the type definitions, not -- by any additional hinting function.@@ -253,3 +333,4 @@        doField :: Name -> Dec -> Name -> (Either Int Name, Type) -> m (Set TGV)       doField tname _dec cname (fld, ftype) = Set.singleton <$> typeGraphVertexOfField (tname, cname, fld) ftype+-}
Language/Haskell/TH/TypeGraph/TypeInfo.hs view
@@ -41,9 +41,9 @@ import Language.Haskell.TH.PprLib (ptext) import Language.Haskell.TH.Syntax as TH (Lift(lift), Quasi(..)) import Language.Haskell.TH.TypeGraph.Expand (E(E), ExpandMap, expandType)-import Language.Haskell.TH.TypeGraph.Prelude (pprint')+import Language.Haskell.TH.TypeGraph.Prelude (pprint1) import Language.Haskell.TH.TypeGraph.Shape (Field)-import Language.Haskell.TH.TypeGraph.Vertex (TGV(..), TGVSimple(..), etype)+import Language.Haskell.TH.TypeGraph.Vertex (TGV'(..), TGVSimple'(..), etype)  -- | Information collected about the graph implied by the structure of -- one or more 'Type' values.@@ -121,22 +121,22 @@       doType'' ListT = return ()       doType'' (VarT _) = return ()       doType'' (TupleT _) = return ()-      doType'' typ = error $ "makeTypeInfo: " ++ pprint' typ+      doType'' typ = error $ "makeTypeInfo: " ++ pprint1 typ        doInfo :: Name -> Info -> StateT TypeInfo m ()-      doInfo _tname (TyConI dec) = doDec dec+      doInfo tname (TyConI dec) = do+        etyp <- expandType (ConT tname)+        synonyms %= Map.insertWith union etyp (singleton tname)+        doDec dec       doInfo _tname (PrimTyConI _ _ _) = return ()       doInfo _tname (FamilyI _ _) = return () -- Not sure what to do here       doInfo _ info = error $ "makeTypeInfo: " ++ show info        doDec :: Dec -> StateT TypeInfo m ()-      doDec (TySynD tname _ typ) = do-        etyp <- expandType (ConT tname)-        synonyms %= Map.insertWith union etyp (singleton tname)-        doType typ+      doDec (TySynD _tname _ typ) = doType typ       doDec (NewtypeD _ tname _ constr _) = doCon tname constr       doDec (DataD _ tname _ constrs _) = Foldable.mapM_ (doCon tname) constrs-      doDec dec = error $ "makeTypeInfo: " ++ pprint' dec+      doDec dec = error $ "makeTypeInfo: " ++ pprint1 dec        doCon :: Name -> Con -> StateT TypeInfo m ()       doCon tname (ForallC _ _ con) = doCon tname con@@ -162,38 +162,38 @@                 , _synonyms = mempty                 , _fields = mempty}) -allVertices :: (Functor m, DsMonad m, MonadReaders TypeInfo m) => Maybe Field -> E Type -> m (Set TGV)+allVertices :: (Functor m, DsMonad m, MonadReaders TypeInfo m) => Maybe Field -> E Type -> m (Set TGV') allVertices (Just fld) etyp = singleton <$> fieldVertex fld etyp allVertices Nothing etyp = do   v <- typeVertex etyp   vs <- fieldVertices v-  return $ Set.insert (TGV {_vsimple = v, _field = Nothing}) vs+  return $ Set.insert (TGV' {_vsimple = v, _field = Nothing}) vs  -- | Find the vertices that involve a particular type - if the field -- is specified it return s singleton, otherwise it returns a set -- containing a vertex one for the type on its own, and one for each -- field containing that type.-fieldVertices :: MonadReaders TypeInfo m => TGVSimple -> m (Set TGV)+fieldVertices :: MonadReaders TypeInfo m => TGVSimple' -> m (Set TGV') fieldVertices v = do   fm <- view fields <$> askPoly   let fs = Map.findWithDefault Set.empty (view etype v) fm-  return $ Set.map (\fld' -> TGV {_vsimple = v, _field = Just fld'}) fs+  return $ Set.map (\fld' -> TGV' {_vsimple = v, _field = Just fld'}) fs  -- | Build a vertex from the given 'Type' and optional 'Field'. -- vertex :: forall m. (DsMonad m, MonadReaders TypeInfo m) => Maybe Field -> E Type -> m TypeGraphVertex -- vertex fld etyp = maybe (typeVertex etyp) (fieldVertex etyp) fld  -- | Build a non-field vertex-typeVertex :: MonadReaders TypeInfo m => E Type -> m TGVSimple+typeVertex :: MonadReaders TypeInfo m => E Type -> m TGVSimple' typeVertex etyp = do   sm <- view synonyms <$> askPoly-  return $ TGVSimple {_syns = Map.findWithDefault Set.empty etyp sm, _etype = etyp}+  return $ TGVSimple' {_syns = Map.findWithDefault Set.empty etyp sm, _etype = etyp} -typeVertex' :: MonadReaders TypeInfo m => E Type -> m TGV+typeVertex' :: MonadReaders TypeInfo m => E Type -> m TGV' typeVertex' etyp = do   v <- typeVertex etyp-  return $ TGV {_vsimple = v, _field = Nothing}+  return $ TGV' {_vsimple = v, _field = Nothing}  -- | Build a vertex associated with a field-fieldVertex :: MonadReaders TypeInfo m => Field -> E Type -> m TGV-fieldVertex fld' etyp = typeVertex etyp >>= \v -> return $ TGV {_vsimple = v, _field = Just fld'}+fieldVertex :: MonadReaders TypeInfo m => Field -> E Type -> m TGV'+fieldVertex fld' etyp = typeVertex etyp >>= \v -> return $ TGV' {_vsimple = v, _field = Just fld'}
Language/Haskell/TH/TypeGraph/Vertex.hs view
@@ -4,16 +4,16 @@ {-# LANGUAGE TypeSynonymInstances #-} module Language.Haskell.TH.TypeGraph.Vertex     ( TypeGraphVertex(..)-    , TGV(..), field, vsimple-    , TGVSimple(..), syns, etype-    , tgv+    , TGV'(..), field, vsimple, TGV+    , TGVSimple'(..), syns, etype, TGVSimple     ) where  import Control.Lens import Data.Data (Data)+import Data.Graph (Vertex) import Data.List as List (concatMap, intersperse) import Data.Map as Map (Map, toList)-import Data.Set as Set (insert, minView, Set, toList)+import Data.Set as Set (delete, insert, minView, Set, toList) import Language.Haskell.Exts.Syntax () import Language.Haskell.TH -- (Con, Dec, nameBase, Type) import Language.Haskell.TH.Instances ()@@ -26,63 +26,77 @@ -- | A vertex of the type graph.  Includes a type and (optionally) -- what field of a parent type holds that type.  This allows special -- treatment of a type depending on the type that contains it.-data TGV-    = TGV+data TGV'+    = TGV'       { _field :: Maybe Field -- ^ The record field which contains this type-      , _vsimple :: TGVSimple+      , _vsimple :: TGVSimple'       } deriving (Eq, Ord, Show, Data)  -- | For simple type graphs where no parent field information is required.-data TGVSimple-    = TGVSimple+data TGVSimple'+    = TGVSimple'       { _syns :: Set Name -- ^ All the type synonyms that expand to this type       , _etype :: E Type -- ^ The fully expanded type       } deriving (Eq, Ord, Show, Data) -tgv :: TGVSimple -> TGV-tgv v = TGV { _field = Nothing, _vsimple = v}+type TGVSimple = (Vertex, TGVSimple')+type TGV = (Vertex, TGV') -$(makeLenses ''TGV)-$(makeLenses ''TGVSimple)+$(makeLenses ''TGV')+$(makeLenses ''TGVSimple') -instance Ppr TGVSimple where-    ppr (TGVSimple {_syns = ns, _etype = typ}) =+instance Ppr TGVSimple' where+    ppr (TGVSimple' {_syns = ns, _etype = typ}) =+        let ns' = Set.toList $ case typ of+                                 E (ConT n) -> Set.delete n ns+                                 _ -> ns in         hcat (ppr (unReify (view unE typ)) :-              case (Set.toList ns) of+              case ns' of                  [] -> []                  _ ->   [ptext " ("] ++                         intersperse (ptext ", ")-                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) (Set.toList ns)) +++                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) ns') ++                         [ptext ")"]) -instance Ppr TGV where-    ppr (TGV {_field = fld, _vsimple = TGVSimple {_syns = ns, _etype = typ}}) =+instance Ppr TGV' where+    ppr (TGV' {_field = fld, _vsimple = TGVSimple' {_syns = ns, _etype = typ}}) =+        let ns' = Set.toList $ case typ of+                                 E (ConT n) -> Set.delete n ns+                                 _ -> ns in         hcat (ppr (unReify (view unE typ)) :-              case (fld, Set.toList ns) of+              case (fld, ns') of                  (Nothing, []) -> []                  _ ->   [ptext " ("] ++                         intersperse (ptext ", ")-                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) (Set.toList ns) +++                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) ns' ++                            maybe [] (\ f -> [ppr f]) fld) ++                         [ptext ")"]) -instance Ppr ((), TGV, [TGV]) where-    ppr ((), v, vs) = vcat [hcat [ppr v, text ":"], hang (text "  ") 2 (vcat (map ppr vs))]+instance Ppr TGVSimple where+    ppr = ppr . snd -instance Ppr ((), TGVSimple, [TGVSimple]) where-    ppr ((), v, vs) = vcat [hcat [ppr v, text ":"], hang (text "  ") 2 (vcat (map ppr vs))]+instance Ppr TGV where+    ppr = ppr . snd -instance Ppr (Map TGV (Set TGV)) where+instance Ppr ((), TGV', [TGV']) where+    ppr ((), v, []) = hcat [ppr v, text ": []"]+    ppr ((), v, vs) = hang (hcat [ppr v, text ":"]) 2 (vcat (map ppr vs))++instance Ppr ((), TGVSimple', [TGVSimple']) where+    ppr ((), v, []) = hcat [ppr v, text ": []"]+    ppr ((), v, vs) = hang (hcat [ppr v, text ":"]) 2 (vcat (map ppr vs))++instance Ppr (Map TGV' (Set TGV')) where     ppr mp = ppr (map (\(v, vs) -> ((), v, Set.toList vs)) (Map.toList mp)) -instance Ppr (Map TGVSimple (Set TGVSimple)) where+instance Ppr (Map TGVSimple' (Set TGVSimple')) where     ppr mp = ppr (map (\(v, vs) -> ((), v, Set.toList vs)) (Map.toList mp)) -instance Lift TGV where-    lift (TGV {_field = f, _vsimple = s}) = [|TGV {_field = $(lift f), _vsimple = $(lift s)}|]+instance Lift TGV' where+    lift (TGV' {_field = f, _vsimple = s}) = [|TGV' {_field = $(lift f), _vsimple = $(lift s)}|] -instance Lift TGVSimple where-    lift (TGVSimple {_syns = ns, _etype = t}) = [|TGVSimple {_syns = $(lift ns), _etype = $(lift t)}|]+instance Lift TGVSimple' where+    lift (TGVSimple' {_syns = ns, _etype = t}) = [|TGVSimple' {_syns = $(lift ns), _etype = $(lift t)}|]  class TypeGraphVertex v where     typeNames :: v -> Set Name@@ -91,12 +105,20 @@     -- empty set.     bestType :: v -> Type -instance TypeGraphVertex TGV where+instance TypeGraphVertex TGV' where     typeNames = typeNames . _vsimple     bestType = bestType . _vsimple -instance TypeGraphVertex TGVSimple where-    typeNames (TGVSimple {_etype = E (ConT tname), _syns = s}) = Set.insert tname s-    typeNames (TGVSimple {_syns = s}) = s-    bestType (TGVSimple {_etype = E (ConT name)}) = ConT name+instance TypeGraphVertex TGVSimple' where+    typeNames (TGVSimple' {_etype = E (ConT tname), _syns = s}) = Set.insert tname s+    typeNames (TGVSimple' {_syns = s}) = s+    bestType (TGVSimple' {_etype = E (ConT name)}) = ConT name     bestType v = maybe (let (E x) = view etype v in x) (ConT . fst) (Set.minView (view syns v))++instance TypeGraphVertex TGV where+    typeNames = typeNames . snd+    bestType = bestType . snd++instance TypeGraphVertex TGVSimple where+    typeNames = typeNames . snd+    bestType = bestType . snd
test/Common.hs view
@@ -9,7 +9,7 @@ import Data.List as List (intercalate, map) import Data.Map as Map (Map, filter, fromList, fromListWith, keys, toList) import Data.Monoid ((<>), Monoid(mempty, mappend))-import Data.Set as Set (Set, difference, empty, fromList, null, toList, union)+import Data.Set as Set (Set, difference, empty, fromList, map, null, toList, union) import Data.Generics (Data, everywhere, mkT) import Language.Haskell.TH import Language.Haskell.TH.Desugar (DsMonad)@@ -19,7 +19,7 @@ import Language.Haskell.TH.TypeGraph.Prelude (pprint') import Language.Haskell.TH.TypeGraph.Shape (Field) import Language.Haskell.TH.TypeGraph.TypeInfo (TypeInfo)-import Language.Haskell.TH.TypeGraph.Vertex (etype, syns, TGV, TGVSimple, TypeGraphVertex, vsimple)+import Language.Haskell.TH.TypeGraph.Vertex (etype, syns, TGV, TGV', TGVSimple, TypeGraphVertex, vsimple)  import Language.Haskell.TH.Syntax (Lift(lift)) @@ -53,21 +53,18 @@ pprintPred :: E Pred -> String pprintPred = pprint' . unReify . view unE -edgesToStrings :: (TypeGraphVertex v, Ppr v, Data v) => GraphEdges v -> [(String, [String])]-edgesToStrings mp = List.map (\ (t, s) -> (pprintVertex t, map pprintVertex (Set.toList s))) (Map.toList mp)--typeGraphEdges' :: forall m. (DsMonad m, MonadReaders TypeInfo m, MonadStates ExpandMap m) => m (GraphEdges TGV)-typeGraphEdges' = typeGraphEdges+edgesToStrings :: (TypeGraphVertex v, Ppr v, Data v) => GraphEdges v -> [(String, Set String)]+edgesToStrings mp = List.map (\ (t, s) -> (pprintVertex t, Set.map pprintVertex s)) (Map.toList mp)  -- | Return a mapping from vertex to all the known type synonyms for -- the type in that vertex. typeSynonymMap :: forall m. (DsMonad m, MonadReaders TypeInfo m, MonadStates ExpandMap m) =>-                  m (Map TGV (Set Name))+                  m (Map TGV' (Set Name)) typeSynonymMap =      (Map.filter (not . Set.null) .       Map.fromList .       List.map (\node -> (node, view (vsimple . syns) node)) .-      Map.keys) <$> (typeGraphEdges :: m (GraphEdges TGV))+      Map.keys) <$> (typeGraphEdges :: m (GraphEdges TGV'))  -- | Like 'typeSynonymMap', but with all field information removed. typeSynonymMapSimple :: forall m. (DsMonad m, MonadReaders TypeInfo m, MonadStates ExpandMap m) =>@@ -75,5 +72,5 @@ typeSynonymMapSimple =     simplify <$> typeSynonymMap     where-      simplify :: Map TGV (Set Name) -> Map (E Type) (Set Name)+      simplify :: Map TGV' (Set Name) -> Map (E Type) (Set Name)       simplify mp = Map.fromListWith Set.union (List.map (\ (k, a) -> (view (vsimple . etype) k, a)) (Map.toList mp))
test/TypeGraph.hs view
@@ -15,11 +15,11 @@ import Data.Set as Set (fromList, singleton) import Language.Haskell.TH import Language.Haskell.TH.TypeGraph.Arity (typeArity)-import Language.Haskell.TH.TypeGraph.Edges (dissolveM, simpleEdges)+import Language.Haskell.TH.TypeGraph.Edges (dissolveM, simpleEdges, typeGraphEdges) import Language.Haskell.TH.TypeGraph.Expand (E(E), unE, ExpandMap, expandType) import Language.Haskell.TH.TypeGraph.Free (freeTypeVars) import Language.Haskell.TH.TypeGraph.TypeInfo (makeTypeInfo, synonyms, typeVertex')-import Language.Haskell.TH.TypeGraph.Vertex (TGV(..), TGVSimple(..), etype)+import Language.Haskell.TH.TypeGraph.Vertex (TGV'(..), TGVSimple'(..), etype) import Language.Haskell.TH.Desugar (withLocalDeclarations) import Language.Haskell.TH.Instances () import Language.Haskell.TH.Syntax@@ -33,14 +33,15 @@ tests = do    it "records a type synonym 1" $ do-     $([t|String|] >>= \string -> makeTypeInfo (const $ return mempty) [string] >>= lift . view synonyms) `shouldBe` (Map.fromList [(E (AppT ListT (ConT ''Char)), Set.singleton ''String)])+     $([t|String|] >>= \string -> makeTypeInfo (const $ return mempty) [string] >>= lift . view synonyms) `shouldBe` (Map.fromList [(E (AppT ListT (ConT ''Char)), Set.singleton ''String),+                                                                                                                                    (E (ConT ''Char), Set.singleton ''Char)])    it "records a type synonym 2" $ do      $([t|String|] >>= \string ->        flip evalStateT (Map.empty :: ExpandMap)                 (makeTypeInfo (const $ return mempty) [string] >>=                  runReaderT (expandType string >>= typeVertex')) >>= lift)-          `shouldBe` (TGV {_field = Nothing, _vsimple = TGVSimple {_syns = singleton ''String, _etype = E (AppT ListT (ConT ''Char))}})+          `shouldBe` (TGV' {_field = Nothing, _vsimple = TGVSimple' {_syns = singleton ''String, _etype = E (AppT ListT (ConT ''Char))}})    it "can build the TypeInfoGraph for Type" $ do     $(runQ [t|Type|] >>= \typ -> makeTypeInfo (const $ return mempty) [typ] >>= lift . pprint) `shouldBe` typeInfoOfType@@ -48,28 +49,28 @@   it "can find the edges of the (simplified) subtype graph of Type (typeEdges)" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $ flip evalStateT (Map.empty :: ExpandMap) $                                       runQ [t|Type|] >>= \typ ->-                                      makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+                                      makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>= return . simpleEdges >>=                                       runQ . lift . edgesToStrings)) simpleTypeEdges         `shouldBe` noDifferences    it "can find the edges of the (unsimplified) subtype graph of Type (typeEdges)" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $ flip evalStateT (Map.empty :: ExpandMap) $                                 runQ [t|Type|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>=+                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>=                                 runQ . lift . edgesToStrings)) typeEdges         `shouldBe` noDifferences    it "can find the subtypesOfType" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $ flip evalStateT (Map.empty :: ExpandMap) $                                   runQ [t|Type|] >>= \typ ->-                                  makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>=+                                  makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>=                                   runQ . lift . List.map pprintVertex . Map.keys)) subtypesOfType         `shouldBe` noDifferences    it "can find the edges of the arity 0 subtype graph of Type (arity0TypeEdges)" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $ flip evalStateT (Map.empty :: ExpandMap) $                                 runQ [t|Type|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>= return . simpleEdges >>=                                 dissolveM (\ v -> (/= 0) <$> (typeArity . view unE . view etype) v) >>=                                 runQ . lift . edgesToStrings)) arity0TypeEdges         `shouldBe` noDifferences@@ -77,14 +78,14 @@   it "can find the edges of the simple subtype graph of Dec (decEdges)" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $                                 runQ [t|Dec|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>= return . simpleEdges >>=                                 runQ . lift . edgesToStrings)) decEdges         `shouldBe` noDifferences    it "can find the edges of the arity 0 subtype graph of Dec (arity0DecEdges)" $ do      setDifferences (Set.fromList $(withLocalDeclarations [] $                                 runQ [t|Dec|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges >>= return . simpleEdges >>=                                 dissolveM (\ v -> (/= 0) <$> (typeArity . runExpanded . _etype) v) >>=                                 runQ . lift . edgesToStrings)) arity0DecEdges         `shouldBe` noDifferences
test/Values.hs view
@@ -143,7 +143,19 @@       "  synonyms:",       "    [GHC.Types.Char] -> fromList [GHC.Base.String]",       "    [Language.Haskell.TH.Syntax.Type] -> fromList [Language.Haskell.TH.Syntax.Cxt]",-      "    Language.Haskell.TH.Syntax.Type -> fromList [Language.Haskell.TH.Syntax.Kind,Language.Haskell.TH.Syntax.Pred]",+      "    GHC.Types.Char -> fromList [GHC.Types.Char]",+      "    GHC.Types.Int -> fromList [GHC.Types.Int]",+      "    GHC.Integer.Type.BigNat -> fromList [GHC.Integer.Type.BigNat]",+      "    GHC.Integer.Type.Integer -> fromList [GHC.Integer.Type.Integer]",+      "    Language.Haskell.TH.Syntax.ModName -> fromList [Language.Haskell.TH.Syntax.ModName]",+      "    Language.Haskell.TH.Syntax.Name -> fromList [Language.Haskell.TH.Syntax.Name]",+      "    Language.Haskell.TH.Syntax.NameFlavour -> fromList [Language.Haskell.TH.Syntax.NameFlavour]",+      "    Language.Haskell.TH.Syntax.NameSpace -> fromList [Language.Haskell.TH.Syntax.NameSpace]",+      "    Language.Haskell.TH.Syntax.OccName -> fromList [Language.Haskell.TH.Syntax.OccName]",+      "    Language.Haskell.TH.Syntax.PkgName -> fromList [Language.Haskell.TH.Syntax.PkgName]",+      "    Language.Haskell.TH.Syntax.TyLit -> fromList [Language.Haskell.TH.Syntax.TyLit]",+      "    Language.Haskell.TH.Syntax.TyVarBndr -> fromList [Language.Haskell.TH.Syntax.TyVarBndr]",+      "    Language.Haskell.TH.Syntax.Type -> fromList [Language.Haskell.TH.Syntax.Kind,Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.Type]",       "  fields:",       "    [GHC.Types.Char] -> fromList [(Language.Haskell.TH.Syntax.ModName,Language.Haskell.TH.Syntax.ModName,Left 1),(Language.Haskell.TH.Syntax.OccName,Language.Haskell.TH.Syntax.OccName,Left 1),(Language.Haskell.TH.Syntax.PkgName,Language.Haskell.TH.Syntax.PkgName,Left 1),(Language.Haskell.TH.Syntax.TyLit,Language.Haskell.TH.Syntax.StrTyLit,Left 1)]",       "    [Language.Haskell.TH.Syntax.TyVarBndr] -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 1)]",@@ -315,226 +327,226 @@ #endif     ] -simpleTypeEdges :: Set (String, [String])+simpleTypeEdges :: Set (String, Set String) simpleTypeEdges =   Set.fromList     [ #if MIN_VERSION_template_haskell(2,10,0)-     ("BigNat",["ByteArray#"]),-     ("ByteArray#",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["Int#","BigNat"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("PkgName",["[Char] (aka String)"]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TyVarBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("Type (aka Kind, aka Pred)",["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[Type] (aka Cxt)",["[]","Type (aka Kind, aka Pred)"]),-     ("[]",[])+     ("BigNat",Set.fromList ["ByteArray#"]),+     ("ByteArray#",Set.fromList []),+     ("Char",Set.fromList ["Char#"]),+     ("Char#",Set.fromList []),+     ("Int",Set.fromList ["Int#"]),+     ("Int#",Set.fromList []),+     ("Integer",Set.fromList ["Int#","BigNat"]),+     ("ModName",Set.fromList ["[Char] (aka String)"]),+     ("Name",Set.fromList ["NameFlavour","OccName"]),+     ("NameFlavour",Set.fromList ["Int","ModName","NameSpace","PkgName"]),+     ("NameSpace",Set.fromList []),+     ("OccName",Set.fromList ["[Char] (aka String)"]),+     ("PkgName",Set.fromList ["[Char] (aka String)"]),+     ("TyLit",Set.fromList ["Integer","[Char] (aka String)"]),+     ("TyVarBndr",Set.fromList ["Name","Type (aka Kind, aka Pred)"]),+     ("Type (aka Kind, aka Pred)",Set.fromList ["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),+     ("[Char] (aka String)",Set.fromList ["Char","[]"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr","[]"]),+     ("[Type] (aka Cxt)",Set.fromList ["[]","Type (aka Kind, aka Pred)"]),+     ("[]",Set.fromList []) #else-     ("ByteArray#",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["ByteArray#","Int#"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int#","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pred",["[Type]","Name","Type (aka Kind)"]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TyVarBndr",["Name","Type (aka Kind)"]),-     ("Type (aka Kind)",["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[Pred] (aka Cxt)",["Pred","[]"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[Type]",["[]","Type (aka Kind)"]),-     ("[]",[])+     ("ByteArray#",Set.fromList []),+     ("Char",Set.fromList ["Char#"]),+     ("Char#",Set.fromList []),+     ("Int",Set.fromList ["Int#"]),+     ("Int#",Set.fromList []),+     ("Integer",Set.fromList ["ByteArray#","Int#"]),+     ("ModName",Set.fromList ["[Char] (aka String)"]),+     ("Name",Set.fromList ["NameFlavour","OccName"]),+     ("NameFlavour",Set.fromList ["Int#","ModName","NameSpace","PkgName"]),+     ("NameSpace",Set.fromList []),+     ("OccName",Set.fromList ["[Char] (aka String)"]),+     ("PkgName",Set.fromList ["[Char] (aka String)"]),+     ("Pred",Set.fromList ["[Type]","Name","Type (aka Kind)"]),+     ("TyLit",Set.fromList ["Integer","[Char] (aka String)"]),+     ("TyVarBndr",Set.fromList ["Name","Type (aka Kind)"]),+     ("Type (aka Kind)",Set.fromList ["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),+     ("[Char] (aka String)",Set.fromList ["Char","[]"]),+     ("[Pred] (aka Cxt)",Set.fromList ["Pred","[]"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr","[]"]),+     ("[Type]",Set.fromList ["[]","Type (aka Kind)"]),+     ("[]",Set.fromList []) #endif     ] -typeEdges ::  Set (String, [String])+typeEdges ::  Set (String, Set String) typeEdges =   Set.fromList     [ #if MIN_VERSION_template_haskell(2,10,0)-     ("BigNat",["ByteArray# (field BigNat.BN#[1])"]),-     ("BigNat (field Integer.Jn#[1])",["BigNat","ByteArray# (field BigNat.BN#[1])"]),-     ("BigNat (field Integer.Jp#[1])",["BigNat","ByteArray# (field BigNat.BN#[1])"]),-     ("ByteArray#",[]),-     ("ByteArray# (field BigNat.BN#[1])",["ByteArray#"]),-     ("Char",["Char# (field Char.C#[1])"]),-     ("Char#",[]),-     ("Char# (field Char.C#[1])",["Char#"]),-     ("Int",["Int# (field Int.I#[1])"]),-     ("Int (field NameFlavour.NameL[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field NameFlavour.NameU[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field Type.PromotedTupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field Type.TupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field Type.UnboxedTupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int#",[]),-     ("Int# (field Int.I#[1])",["Int#"]),-     ("Int# (field Integer.S#[1])",["Int#"]),-     ("Integer",["BigNat (field Integer.Jn#[1])","BigNat (field Integer.Jp#[1])","Int# (field Integer.S#[1])"]),-     ("Integer (field TyLit.NumTyLit[1])",["Integer","BigNat (field Integer.Jn#[1])","BigNat (field Integer.Jp#[1])","Int# (field Integer.S#[1])"]),-     ("ModName",["[Char] (aka String, field ModName.ModName[1])"]),-     ("ModName (field NameFlavour.NameG[3])",["ModName","[Char] (aka String, field ModName.ModName[1])"]),-     ("ModName (field NameFlavour.NameQ[1])",["ModName","[Char] (aka String, field ModName.ModName[1])"]),-     ("Name",["OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field TyVarBndr.KindedTV[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field TyVarBndr.PlainTV[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.ConT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.PromotedT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.VarT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("NameFlavour",["NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int (field NameFlavour.NameU[1])"]),-     ("NameFlavour (field Name.Name[2])",["NameFlavour","NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int (field NameFlavour.NameU[1])"]),-     ("NameSpace",[]),-     ("NameSpace (field NameFlavour.NameG[1])",["NameSpace"]),-     ("OccName",["[Char] (aka String, field OccName.OccName[1])"]),-     ("OccName (field Name.Name[1])",["OccName","[Char] (aka String, field OccName.OccName[1])"]),-     ("PkgName",["[Char] (aka String, field PkgName.PkgName[1])"]),-     ("PkgName (field NameFlavour.NameG[2])",["PkgName","[Char] (aka String, field PkgName.PkgName[1])"]),-     ("TyLit",["Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),-     ("TyLit (field Type.LitT[1])",["TyLit","Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),-     ("TyVarBndr",["Name (field TyVarBndr.KindedTV[1])","Type (aka Kind, aka Pred, field TyVarBndr.KindedTV[2])","Name (field TyVarBndr.PlainTV[1])"]),-     ("Type (aka Kind, aka Pred)",["Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field TyVarBndr.KindedTV[2])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field Type.AppT[1])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field Type.AppT[2])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field Type.ForallT[3])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field Type.SigT[1])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, aka Pred, field Type.SigT[2])",["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[Char] (aka String, field ModName.ModName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field OccName.OccName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field PkgName.PkgName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field TyLit.StrTyLit[1])",["Char","[]","[Char] (aka String)"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[TyVarBndr] (field Type.ForallT[1])",["[TyVarBndr]","TyVarBndr","[]"]),-     ("[Type] (aka Cxt)",["[]","Type (aka Kind, aka Pred)"]),-     ("[Type] (aka Cxt, field Type.ForallT[2])",["[]","[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),-     ("[]",[])+     ("BigNat",Set.fromList ["ByteArray# (field BigNat.BN#[1])"]),+     ("BigNat (field Integer.Jn#[1])",Set.fromList ["BigNat","ByteArray# (field BigNat.BN#[1])"]),+     ("BigNat (field Integer.Jp#[1])",Set.fromList ["BigNat","ByteArray# (field BigNat.BN#[1])"]),+     ("ByteArray#",Set.fromList []),+     ("ByteArray# (field BigNat.BN#[1])",Set.fromList ["ByteArray#"]),+     ("Char",Set.fromList ["Char# (field Char.C#[1])"]),+     ("Char#",Set.fromList []),+     ("Char# (field Char.C#[1])",Set.fromList ["Char#"]),+     ("Int",Set.fromList ["Int# (field Int.I#[1])"]),+     ("Int (field NameFlavour.NameL[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field NameFlavour.NameU[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field Type.PromotedTupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field Type.TupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field Type.UnboxedTupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int#",Set.fromList []),+     ("Int# (field Int.I#[1])",Set.fromList ["Int#"]),+     ("Int# (field Integer.S#[1])",Set.fromList ["Int#"]),+     ("Integer",Set.fromList ["BigNat (field Integer.Jn#[1])","BigNat (field Integer.Jp#[1])","Int# (field Integer.S#[1])"]),+     ("Integer (field TyLit.NumTyLit[1])",Set.fromList ["Integer","BigNat (field Integer.Jn#[1])","BigNat (field Integer.Jp#[1])","Int# (field Integer.S#[1])"]),+     ("ModName",Set.fromList ["[Char] (aka String, field ModName.ModName[1])"]),+     ("ModName (field NameFlavour.NameG[3])",Set.fromList ["ModName","[Char] (aka String, field ModName.ModName[1])"]),+     ("ModName (field NameFlavour.NameQ[1])",Set.fromList ["ModName","[Char] (aka String, field ModName.ModName[1])"]),+     ("Name",Set.fromList ["OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field TyVarBndr.KindedTV[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field TyVarBndr.PlainTV[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.ConT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.PromotedT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.VarT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("NameFlavour",Set.fromList ["NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int (field NameFlavour.NameU[1])"]),+     ("NameFlavour (field Name.Name[2])",Set.fromList ["NameFlavour","NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int (field NameFlavour.NameU[1])"]),+     ("NameSpace",Set.fromList []),+     ("NameSpace (field NameFlavour.NameG[1])",Set.fromList ["NameSpace"]),+     ("OccName",Set.fromList ["[Char] (aka String, field OccName.OccName[1])"]),+     ("OccName (field Name.Name[1])",Set.fromList ["OccName","[Char] (aka String, field OccName.OccName[1])"]),+     ("PkgName",Set.fromList ["[Char] (aka String, field PkgName.PkgName[1])"]),+     ("PkgName (field NameFlavour.NameG[2])",Set.fromList ["PkgName","[Char] (aka String, field PkgName.PkgName[1])"]),+     ("TyLit",Set.fromList ["Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),+     ("TyLit (field Type.LitT[1])",Set.fromList ["TyLit","Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),+     ("TyVarBndr",Set.fromList ["Name (field TyVarBndr.KindedTV[1])","Type (aka Kind, aka Pred, field TyVarBndr.KindedTV[2])","Name (field TyVarBndr.PlainTV[1])"]),+     ("Type (aka Kind, aka Pred)",Set.fromList ["Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field TyVarBndr.KindedTV[2])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field Type.AppT[1])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field Type.AppT[2])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field Type.ForallT[3])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field Type.SigT[1])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, aka Pred, field Type.SigT[2])",Set.fromList ["Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("[Char] (aka String)",Set.fromList ["Char","[]"]),+     ("[Char] (aka String, field ModName.ModName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field OccName.OccName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field PkgName.PkgName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field TyLit.StrTyLit[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr","[]"]),+     ("[TyVarBndr] (field Type.ForallT[1])",Set.fromList ["[TyVarBndr]","TyVarBndr","[]"]),+     ("[Type] (aka Cxt)",Set.fromList ["[]","Type (aka Kind, aka Pred)"]),+     ("[Type] (aka Cxt, field Type.ForallT[2])",Set.fromList ["[]","[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),+     ("[]",Set.fromList []) #else-     ("ByteArray#",[]),-     ("ByteArray# (field Integer.J#[2])",["ByteArray#"]),-     ("Char",["Char# (field Char.C#[1])"]),-     ("Char#",[]),-     ("Char# (field Char.C#[1])",["Char#"]),-     ("Int",["Int# (field Int.I#[1])"]),-     ("Int (field Type.PromotedTupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field Type.TupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int (field Type.UnboxedTupleT[1])",["Int","Int# (field Int.I#[1])"]),-     ("Int#",[]),-     ("Int# (field Int.I#[1])",["Int#"]),-     ("Int# (field Integer.J#[1])",["Int#"]),-     ("Int# (field Integer.S#[1])",["Int#"]),-     ("Int# (field NameFlavour.NameL[1])",["Int#"]),-     ("Int# (field NameFlavour.NameU[1])",["Int#"]),-     ("Integer",["Int# (field Integer.J#[1])","ByteArray# (field Integer.J#[2])","Int# (field Integer.S#[1])"]),-     ("Integer (field TyLit.NumTyLit[1])",["Integer","Int# (field Integer.J#[1])","ByteArray# (field Integer.J#[2])","Int# (field Integer.S#[1])"]),-     ("ModName",["[Char] (aka String, field ModName.ModName[1])"]),-     ("ModName (field NameFlavour.NameG[3])",["ModName","[Char] (aka String, field ModName.ModName[1])"]),-     ("ModName (field NameFlavour.NameQ[1])",["ModName","[Char] (aka String, field ModName.ModName[1])"]),-     ("Name",["OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Pred.ClassP[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field TyVarBndr.KindedTV[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field TyVarBndr.PlainTV[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.ConT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.PromotedT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("Name (field Type.VarT[1])",["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),-     ("NameFlavour",["NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int# (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int# (field NameFlavour.NameU[1])"]),-     ("NameFlavour (field Name.Name[2])",["NameFlavour","NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int# (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int# (field NameFlavour.NameU[1])"]),-     ("NameSpace",[]),-     ("NameSpace (field NameFlavour.NameG[1])",["NameSpace"]),-     ("OccName",["[Char] (aka String, field OccName.OccName[1])"]),-     ("OccName (field Name.Name[1])",["OccName","[Char] (aka String, field OccName.OccName[1])"]),-     ("PkgName",["[Char] (aka String, field PkgName.PkgName[1])"]),-     ("PkgName (field NameFlavour.NameG[2])",["PkgName","[Char] (aka String, field PkgName.PkgName[1])"]),-     ("Pred",["Name (field Pred.ClassP[1])","[Type] (field Pred.ClassP[2])","Type (aka Kind, field Pred.EqualP[1])","Type (aka Kind, field Pred.EqualP[2])"]),-     ("TyLit",["Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),-     ("TyLit (field Type.LitT[1])",["TyLit","Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),-     ("TyVarBndr",["Name (field TyVarBndr.KindedTV[1])","Type (aka Kind, field TyVarBndr.KindedTV[2])","Name (field TyVarBndr.PlainTV[1])"]),-     ("Type (aka Kind)",["Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Pred.EqualP[1])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Pred.EqualP[2])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field TyVarBndr.KindedTV[2])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Type.AppT[1])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Type.AppT[2])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Type.ForallT[3])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Type.SigT[1])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("Type (aka Kind, field Type.SigT[2])",["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[Char] (aka String, field ModName.ModName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field OccName.OccName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field PkgName.PkgName[1])",["Char","[]","[Char] (aka String)"]),-     ("[Char] (aka String, field TyLit.StrTyLit[1])",["Char","[]","[Char] (aka String)"]),-     ("[Pred] (aka Cxt)",["Pred","[]"]),-     ("[Pred] (aka Cxt, field Type.ForallT[2])",["Pred","[]","[Pred] (aka Cxt)"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[TyVarBndr] (field Type.ForallT[1])",["[TyVarBndr]","TyVarBndr","[]"]),-     ("[Type]",["[]","Type (aka Kind)"]),-     ("[Type] (field Pred.ClassP[2])",["[Type]","[]","Type (aka Kind)"]),-     ("[]",[])+     ("ByteArray#",Set.fromList []),+     ("ByteArray# (field Integer.J#[2])",Set.fromList ["ByteArray#"]),+     ("Char",Set.fromList ["Char# (field Char.C#[1])"]),+     ("Char#",Set.fromList []),+     ("Char# (field Char.C#[1])",Set.fromList ["Char#"]),+     ("Int",Set.fromList ["Int# (field Int.I#[1])"]),+     ("Int (field Type.PromotedTupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field Type.TupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int (field Type.UnboxedTupleT[1])",Set.fromList ["Int","Int# (field Int.I#[1])"]),+     ("Int#",Set.fromList []),+     ("Int# (field Int.I#[1])",Set.fromList ["Int#"]),+     ("Int# (field Integer.J#[1])",Set.fromList ["Int#"]),+     ("Int# (field Integer.S#[1])",Set.fromList ["Int#"]),+     ("Int# (field NameFlavour.NameL[1])",Set.fromList ["Int#"]),+     ("Int# (field NameFlavour.NameU[1])",Set.fromList ["Int#"]),+     ("Integer",Set.fromList ["Int# (field Integer.J#[1])","ByteArray# (field Integer.J#[2])","Int# (field Integer.S#[1])"]),+     ("Integer (field TyLit.NumTyLit[1])",Set.fromList ["Integer","Int# (field Integer.J#[1])","ByteArray# (field Integer.J#[2])","Int# (field Integer.S#[1])"]),+     ("ModName",Set.fromList ["[Char] (aka String, field ModName.ModName[1])"]),+     ("ModName (field NameFlavour.NameG[3])",Set.fromList ["ModName","[Char] (aka String, field ModName.ModName[1])"]),+     ("ModName (field NameFlavour.NameQ[1])",Set.fromList ["ModName","[Char] (aka String, field ModName.ModName[1])"]),+     ("Name",Set.fromList ["OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Pred.ClassP[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field TyVarBndr.KindedTV[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field TyVarBndr.PlainTV[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.ConT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.PromotedT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("Name (field Type.VarT[1])",Set.fromList ["Name","OccName (field Name.Name[1])","NameFlavour (field Name.Name[2])"]),+     ("NameFlavour",Set.fromList ["NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int# (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int# (field NameFlavour.NameU[1])"]),+     ("NameFlavour (field Name.Name[2])",Set.fromList ["NameFlavour","NameSpace (field NameFlavour.NameG[1])","PkgName (field NameFlavour.NameG[2])","ModName (field NameFlavour.NameG[3])","Int# (field NameFlavour.NameL[1])","ModName (field NameFlavour.NameQ[1])","Int# (field NameFlavour.NameU[1])"]),+     ("NameSpace",Set.fromList []),+     ("NameSpace (field NameFlavour.NameG[1])",Set.fromList ["NameSpace"]),+     ("OccName",Set.fromList ["[Char] (aka String, field OccName.OccName[1])"]),+     ("OccName (field Name.Name[1])",Set.fromList ["OccName","[Char] (aka String, field OccName.OccName[1])"]),+     ("PkgName",Set.fromList ["[Char] (aka String, field PkgName.PkgName[1])"]),+     ("PkgName (field NameFlavour.NameG[2])",Set.fromList ["PkgName","[Char] (aka String, field PkgName.PkgName[1])"]),+     ("Pred",Set.fromList ["Name (field Pred.ClassP[1])","[Type] (field Pred.ClassP[2])","Type (aka Kind, field Pred.EqualP[1])","Type (aka Kind, field Pred.EqualP[2])"]),+     ("TyLit",Set.fromList ["Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),+     ("TyLit (field Type.LitT[1])",Set.fromList ["TyLit","Integer (field TyLit.NumTyLit[1])","[Char] (aka String, field TyLit.StrTyLit[1])"]),+     ("TyVarBndr",Set.fromList ["Name (field TyVarBndr.KindedTV[1])","Type (aka Kind, field TyVarBndr.KindedTV[2])","Name (field TyVarBndr.PlainTV[1])"]),+     ("Type (aka Kind)",Set.fromList ["Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Pred.EqualP[1])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Pred.EqualP[2])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field TyVarBndr.KindedTV[2])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Type.AppT[1])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Type.AppT[2])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Type.ForallT[3])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Type.SigT[1])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("Type (aka Kind, field Type.SigT[2])",Set.fromList ["Type (aka Kind)","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Name (field Type.ConT[1])","[TyVarBndr] (field Type.ForallT[1])","[Pred] (aka Cxt, field Type.ForallT[2])","Type (aka Kind, field Type.ForallT[3])","TyLit (field Type.LitT[1])","Name (field Type.PromotedT[1])","Int (field Type.PromotedTupleT[1])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Name (field Type.VarT[1])"]),+     ("[Char] (aka String)",Set.fromList ["Char","[]"]),+     ("[Char] (aka String, field ModName.ModName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field OccName.OccName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field PkgName.PkgName[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Char] (aka String, field TyLit.StrTyLit[1])",Set.fromList ["Char","[]","[Char] (aka String)"]),+     ("[Pred] (aka Cxt)",Set.fromList ["Pred","[]"]),+     ("[Pred] (aka Cxt, field Type.ForallT[2])",Set.fromList ["Pred","[]","[Pred] (aka Cxt)"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr","[]"]),+     ("[TyVarBndr] (field Type.ForallT[1])",Set.fromList ["[TyVarBndr]","TyVarBndr","[]"]),+     ("[Type]",Set.fromList ["[]","Type (aka Kind)"]),+     ("[Type] (field Pred.ClassP[2])",Set.fromList ["[Type]","[]","Type (aka Kind)"]),+     ("[]",Set.fromList []) #endif     ] -arity0TypeEdges :: Set (String, [String])+arity0TypeEdges :: Set (String, Set String) arity0TypeEdges =   Set.fromList     [ #if MIN_VERSION_template_haskell(2,10,0)-     ("BigNat",["ByteArray#"]),-     ("ByteArray#",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["Int#","BigNat"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("PkgName",["[Char] (aka String)"]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TyVarBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("Type (aka Kind, aka Pred)",["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),-     ("[Char] (aka String)",["Char"]),-     ("[TyVarBndr]",["TyVarBndr"]),-     ("[Type] (aka Cxt)",["Type (aka Kind, aka Pred)"])+     ("BigNat",Set.fromList ["ByteArray#"]),+     ("ByteArray#",Set.fromList []),+     ("Char",Set.fromList ["Char#"]),+     ("Char#",Set.fromList []),+     ("Int",Set.fromList ["Int#"]),+     ("Int#",Set.fromList []),+     ("Integer",Set.fromList ["Int#","BigNat"]),+     ("ModName",Set.fromList ["[Char] (aka String)"]),+     ("Name",Set.fromList ["NameFlavour","OccName"]),+     ("NameFlavour",Set.fromList ["Int","ModName","NameSpace","PkgName"]),+     ("NameSpace",Set.fromList []),+     ("OccName",Set.fromList ["[Char] (aka String)"]),+     ("PkgName",Set.fromList ["[Char] (aka String)"]),+     ("TyLit",Set.fromList ["Integer","[Char] (aka String)"]),+     ("TyVarBndr",Set.fromList ["Name","Type (aka Kind, aka Pred)"]),+     ("Type (aka Kind, aka Pred)",Set.fromList ["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),+     ("[Char] (aka String)",Set.fromList ["Char"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr"]),+     ("[Type] (aka Cxt)",Set.fromList ["Type (aka Kind, aka Pred)"]) #else-     ("ByteArray#",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["ByteArray#","Int#"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int#","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pred",["[Type]","Name","Type (aka Kind)"]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TyVarBndr",["Name","Type (aka Kind)"]),-     ("Type (aka Kind)",["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),-     ("[Char] (aka String)",["Char"]),-     ("[Pred] (aka Cxt)",["Pred"]),-     ("[TyVarBndr]",["TyVarBndr"]),-     ("[Type]",["Type (aka Kind)"])+     ("ByteArray#",Set.fromList []),+     ("Char",Set.fromList ["Char#"]),+     ("Char#",Set.fromList []),+     ("Int",Set.fromList ["Int#"]),+     ("Int#",Set.fromList []),+     ("Integer",Set.fromList ["ByteArray#","Int#"]),+     ("ModName",Set.fromList ["[Char] (aka String)"]),+     ("Name",Set.fromList ["NameFlavour","OccName"]),+     ("NameFlavour",Set.fromList ["Int#","ModName","NameSpace","PkgName"]),+     ("NameSpace",Set.fromList []),+     ("OccName",Set.fromList ["[Char] (aka String)"]),+     ("PkgName",Set.fromList ["[Char] (aka String)"]),+     ("Pred",Set.fromList ["[Type]","Name","Type (aka Kind)"]),+     ("TyLit",Set.fromList ["Integer","[Char] (aka String)"]),+     ("TyVarBndr",Set.fromList ["Name","Type (aka Kind)"]),+     ("Type (aka Kind)",Set.fromList ["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),+     ("[Char] (aka String)",Set.fromList ["Char"]),+     ("[Pred] (aka Cxt)",Set.fromList ["Pred"]),+     ("[TyVarBndr]",Set.fromList ["TyVarBndr"]),+     ("[Type]",Set.fromList ["Type (aka Kind)"]) #endif     ]
th-typegraph.cabal view
@@ -1,5 +1,5 @@ name:               th-typegraph-version:            0.32+version:            0.33 cabal-version:      >= 1.10 build-type:         Simple license:            BSD3@@ -15,7 +15,7 @@                     the subtype relation: Char is a subtype of Maybe Char, Int is                     a subtype of (Int, Double), and so on. extra-source-files: test/Common.hs test/Tests.hs test/TypeGraph.hs test/Values.hs-+tested-with: GHC == 7.10.3, GHC == 7.11.* library   default-language: Haskell2010   hs-source-dirs: .@@ -38,7 +38,6 @@     containers,     data-default,     haskell-src-exts,-    lens,     mtl,     mtl-unleashed >= 0.5,     set-extra,@@ -46,15 +45,24 @@     template-haskell >= 2.10,     th-desugar,     th-orphans >= 0.10.0+  if impl(ghcjs)+    build-depends: microlens-compat+  else+    build-depends: lens + test-suite th-typegraph-tests   type:             exitcode-stdio-1.0   hs-source-dirs:   test   main-is:          Tests.hs   build-depends:    array, base, bytestring, containers, data-default, deepseq, ghc-prim,-                    hspec, hspec-core, lens, mtl, mtl-unleashed >= 0.5, syb, template-haskell, text,+                    hspec, hspec-core, mtl, mtl-unleashed >= 0.5, syb, template-haskell, text,                     th-typegraph, th-desugar, th-orphans, th-reify-many   default-language: Haskell2010+  if impl(ghcjs)+    build-depends: microlens-compat+  else+    build-depends: lens  source-repository head   type:     git