packages feed

th-typegraph 0.35.1 → 1.0

raw patch · 20 files changed

+1121/−3009 lines, 20 filesdep +aesondep +cerealdep +fgldep −arraydep −base-compatdep −bytestringdep ~basedep ~template-haskelldep ~th-orphans

Dependencies added: aeson, cereal, fgl, parsec, safecopy, split, th-lift, time, userid, web-routes

Dependencies removed: array, base-compat, bytestring, data-default, deepseq, ghc-prim, haskell-src-exts, hspec, hspec-core, mtl-unleashed, set-extra, th-context, th-reify-many, th-typegraph

Dependency ranges changed: base, template-haskell, th-orphans

Files

− Language/Haskell/TH/TypeGraph/Arity.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE CPP #-}---- | Function to compute the arity or kind of a Type, the number of--- type parameters that need to be applied to get a concrete type.-module Language.Haskell.TH.TypeGraph.Arity-    ( typeArity-    ) where--import Language.Haskell.TH-import Language.Haskell.TH.Desugar ({- instances -})-import Language.Haskell.TH.Syntax (Quasi(qReify))-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--- quite sure I understand the relationship between this and--- 'freeTypeVars'.-typeArity :: Quasi m => Type -> m Int-typeArity t0 = typeArity' t0-    where-      typeArity' (ForallT _ _ typ) = typeArity' typ -- Shouldn't a forall affect the arity?-      typeArity' ListT = return 1-      typeArity' (TupleT n) = return n-      typeArity' (VarT _) = return 1-      typeArity' (AppT t _) = typeArity' t >>= \ n -> return $ n - 1-      typeArity' (ConT name) = qReify name >>= infoArity-      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 (" ++ pprint1 t0 ++ ")- unexpected info: " ++ show info-#if MIN_VERSION_template_haskell(2,11,0)-      decArity (DataD _ _ vs _ _ _) = return $ length vs-      decArity (NewtypeD _ _ vs _ _ _) = return $ length vs-#else-      decArity (DataD _ _ vs _ _) = return $ length vs-      decArity (NewtypeD _ _ vs _ _) = return $ length vs-#endif-      decArity (TySynD _ vs t) = typeArity' t >>= \ n -> return $ n + length vs-#if MIN_VERSION_template_haskell(2,11,0)-      decArity (DataFamilyD _ vs _mk) = return $ {- not sure what to do with the kind mk here -} length vs-#else-      decArity (FamilyD _ _ vs _mk) = return $ {- not sure what to do with the kind mk here -} length vs-#endif-      decArity dec = error $ "typeArity (" ++ pprint1 t0 ++ ")- unexpected dec: " ++ show dec
− Language/Haskell/TH/TypeGraph/Edges.hs 
@@ -1,192 +0,0 @@--- | Operations involving the edges of the graph (before it is a graph.)--{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-}-module Language.Haskell.TH.TypeGraph.Edges-    ( GraphEdges-    , typeGraphEdges-    , cut-    , cutM-    , cutEdges-    , cutEdgesM-    , isolate-    , isolateM-    , link-    , linkM-    , dissolve-    , dissolveM-    , simpleEdges-    ) where--#if __GLASGOW_HASKELL__ < 709-import Control.Applicative ((<$>))-import Data.Monoid (mempty)-#endif-import Control.Lens -- (makeLenses, view)-import Control.Monad (filterM)-import Control.Monad.Readers (askPoly, MonadReaders)-import Control.Monad.State (execStateT, StateT)-import Control.Monad.States (MonadStates, modifyPoly)-import Control.Monad.Trans (lift)-import Data.Foldable-import Data.List as List (filter, map)-import Data.Map as Map ((!), alter, delete, filterWithKey, fromList, keys, lookup, map, Map, mapKeysWith, mapWithKey)-import qualified Data.Map as Map (toList)-import Data.Maybe (mapMaybe)-import Data.Set as Set (delete, empty, filter, insert, map, member, fromList, Set, singleton, toList, union)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH -- (Con, Dec, nameBase, Type)-import Language.Haskell.TH.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.Desugar as DS (DsMonad)-import Language.Haskell.TH.Instances ()-import Prelude hiding (foldr, mapM_, null)--type GraphEdges key = Map key (Set key)---- | Given the discovered set of types and maps of type synonyms and--- 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 = do-  execStateT (view typeSet <$> askPoly >>= mapM_ (\t -> lift (expandType t) >>= doType)) (mempty :: GraphEdges TGV')-    where-      doType typ = do-        vs <- allVertices Nothing typ-        mapM_ node vs-        case typ of-          E (ConT tname) -> askPoly >>= \(x :: TypeInfo) -> doInfo vs (view infoMap x ! tname)-          E (AppT typ1 typ2) -> do-            v1 <- typeVertex' (E typ1)-            v2 <- typeVertex' (E typ2)-            mapM_ (flip edge v1) vs-            mapM_ (flip edge v2) vs-            doType (E typ1)-            doType (E typ2)-          _ -> return ()--      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 _ (TySynD _ _ _) = return () -- This type will be in typeSet-#if MIN_VERSION_template_haskell(2,11,0)-      doDec vs (NewtypeD _ tname _ _ constr _) = doCon vs tname constr-      doDec vs (DataD _ tname _ _ constrs _) = mapM_ (doCon vs tname) constrs-#else-      doDec vs (NewtypeD _ tname _ constr _) = doCon vs tname constr-      doDec vs (DataD _ tname _ constrs _) = mapM_ (doCon vs tname) constrs-#endif-      doDec _ _ = return ()--      doCon :: Set TGV' -> Name -> Con -> StateT (GraphEdges TGV') m ()-      doCon vs tname (ForallC _ _ con) = doCon vs tname con-      doCon vs tname con@(NormalC _cname flds) = mapM_ (uncurry (doField vs tname con)) (List.map (\ (n, (_, ftype)) -> (Left n, ftype)) (zip [1..] flds))-      doCon vs tname con@(RecC _cname flds) = mapM_ (uncurry (doField vs tname con)) (List.map (\ (fname, _, ftype) -> (Right fname, ftype)) flds)-      doCon vs tname con@(InfixC (_, lhs) _cname (_, rhs)) = doField vs tname con (Left 1) lhs >> doField vs tname con (Left 2) rhs--      -- Connect the vertex for this record type to one particular field vertex-      doField ::  DsMonad m => Set TGV' -> Name -> Con -> Either Int Name -> Type -> StateT (GraphEdges TGV') m ()-      doField vs tname con fld ftyp = do-        v2 <- lift (expandType ftyp) >>= fieldVertex (tname, con, fld)-        v3 <- lift (expandType ftyp) >>= typeVertex'-        edge v2 v3-        mapM_ (flip edge v2) vs-        -- Here's where we don't recurse, see?-        -- doVertex v2--      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'))--      edge :: TGV' -> TGV' -> StateT (GraphEdges TGV') m ()-      edge v1 v2 = node v2 >> modifyPoly f-          where f :: GraphEdges TGV' -> GraphEdges TGV'-                f = Map.alter g v1-                g :: (Maybe (Set TGV') -> Maybe (Set TGV'))-                g = Just . maybe (singleton v2) (Set.insert v2)---- | Isolate and remove matching nodes-cut :: (Eq a, Ord a) => (a -> Bool) -> GraphEdges a -> GraphEdges a-cut p edges = Map.filterWithKey (\v _ -> not (p v)) (isolate p edges)---- | Monadic predicate version of 'cut'.-cutM :: (Functor m, Monad m, Eq a, Ord a) => (a -> m Bool) -> GraphEdges a -> m (GraphEdges a)-cutM victim edges = do-  victims <- Set.fromList <$> filterM victim (Map.keys edges)-  return $ cut (flip Set.member victims) edges--cutEdges :: (Eq a, Ord a) => (a -> a -> Bool) -> GraphEdges a -> (GraphEdges a)-cutEdges p edges = Map.mapWithKey (\key gkeys -> Set.filter (\gkey -> not (p key gkey)) gkeys) edges--cutEdgesM :: (Monad m, Eq a, Ord a) => (a -> a -> m Bool) -> GraphEdges a -> m (GraphEdges a)-cutEdgesM p edges = do-  let pairs = Map.toList edges-  ss <- mapM (\(a, s) -> filterM (\b -> not <$> p a b) (Set.toList s)) pairs-  let pairs' = List.map (\ ((a, _), s') -> (a, Set.fromList s')) (zip pairs ss)-  return $ Map.fromList pairs'---- | Remove all the in- and out-edges of matching nodes-isolate :: (Eq a, Ord a) => (a -> Bool) -> GraphEdges a -> GraphEdges a-isolate p edges = cutEdges (\ a b -> p a || p b) edges---- | Monadic predicate version of 'isolate'.-isolateM :: (Functor m, Monad m, Eq a, Ord a) => (a -> m Bool) -> GraphEdges a -> m (GraphEdges a)-isolateM victim edges = do-  victims <- Set.fromList <$> filterM victim (Map.keys edges)-  return $ isolate (flip Set.member victims) edges---- | Replace the out set of selected nodes-link :: (Eq a, Ord a) => (a -> Maybe (Set a)) -> GraphEdges a -> GraphEdges a-link f edges =-    foldr link1 edges (List.map (\a -> (a, f a)) (Map.keys edges))-    where-      link1 :: (Eq a, Ord a) => (a, Maybe (Set a)) -> GraphEdges a -> GraphEdges a-      link1 (_, Nothing) edges' = edges'-      link1 (a, Just s) edges' = Map.alter (\(Just _) -> Just s) a edges'--linkM :: (Eq a, Ord a, Monad m) => (a -> m (Maybe (Set a))) -> GraphEdges a -> m (GraphEdges a)-linkM f edges = do-  let ks = Map.keys edges-  mss <- mapM f ks-  let mp = Map.fromList $ mapMaybe (\(k, ms) -> maybe Nothing (Just .(k,)) ms) $ zip ks mss-  return $ link (\k -> Map.lookup k mp) edges---- | Remove matching nodes and extend each of their in-edges to each of--- their out-edges.-dissolve :: (Eq a, Ord a) => (a -> Bool) -> GraphEdges a -> GraphEdges a-dissolve p edges =-    foldr dissolve1 edges (List.filter p (Map.keys edges))-    where-      -- Remove a victim and call dissolve1' to extend the edges of each-      -- node that had it in its out set.-      dissolve1 v es = maybe es (\s -> dissolve1' v (Set.delete v s) (Map.delete v es)) (Map.lookup v es)-      -- If a node's out edges include the victim replace them with next.-      dissolve1' v vs es = Map.map (\s -> if Set.member v s then Set.union vs (Set.delete v s) else s) es---- | Monadic predicate version of 'dissolve'.-dissolveM :: (Functor m, Monad m, Eq a, Ord a) => (a -> m Bool) -> GraphEdges a -> m (GraphEdges a)-dissolveM victim edges = do-  victims <- Set.fromList <$> filterM victim (Map.keys edges)-  return $ dissolve (flip Set.member victims) edges---- | 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 = 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 
@@ -1,175 +0,0 @@--- | Function to compute free type variable set for a Type.  (I took--- this from somewhere, I really need to credit it.  Now when I search--- all I can find is myself.)-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, TemplateHaskell #-}-module Language.Haskell.TH.TypeGraph.Free-    ( freeTypeVars-    ) where--import Control.Lens hiding (Strict, cons)-import Control.Monad.State (MonadState, execStateT)-import Data.Set as Set (Set, delete, difference, empty, fromList, insert, member)-import Language.Haskell.TH-import Language.Haskell.TH.Desugar ({- instances -})-import Language.Haskell.TH.Syntax (Quasi(qReify))-import Language.Haskell.TH.TypeGraph.Prelude (pprint1)--data St-    = St { _result :: Set Name-         , _visited :: Set Name-         } deriving Show--st0 :: St-st0 = St {_result = empty, _visited = empty}--$(makeLenses ''St)---- | Return the names of the type variables that are free in x.  I.e.,--- type variables that appear in the type expression but are not bound--- by an enclosing forall or by the type parameters of a Dec.-freeTypeVars :: (FreeTypeVars t, Quasi m) => t -> m (Set Name)-freeTypeVars x = view result <$> execStateT (ftv x) st0---- | This is based on the freeNamesOfTypes function from the--- th-desugar package.-class FreeTypeVars t where-    ftv :: (Quasi m, MonadState St m) => t -> m ()--instance FreeTypeVars a => FreeTypeVars [a] where-    ftv ts = mapM_ ftv ts--instance FreeTypeVars Type where-    ftv (ForallT tvbs cx ty) = do-      ftv ty-      mapM_ go_pred cx-      result %= (`Set.difference` (Set.fromList (map tvbName tvbs)))-        where-#if __GLASGOW_HASKELL__ >= 709-          go_pred typ =-              -- This looks wrong as the one below looks wrong.  Wronger maybe.-              ftv typ-#else-          go_pred (ClassP _ tys) = ftv tys-          go_pred (EqualP t1 t2) = do-            -- This looks wrong - we need to unify t1 and t2 and look-            -- at the free type variables in the resulting bindings-            ftv t1-            ftv t2-#endif-    ftv (SigT ty _) = ftv ty-    ftv (VarT n) = result %= Set.insert n-    ftv (AppT t1 t2) = {-trace ("go_app " ++ show typ) (return ()) >>-} go_app [t2] t1-    ftv typ@(ConT _) = {-trace ("go_app " ++ show typ) (return ()) >>-} go_app [] typ-    ftv _ = return ()---go_app :: (Quasi m, MonadState St m) => [Type] -> Type -> m ()-go_app params (AppT t1 t2) = go_app (t2 : params) t1-go_app params (ConT n) = do-    stk <- use visited-    case Set.member n stk of-      True -> return ()-      False -> do-        visited %= Set.insert n-        qReify n >>= go_info (reverse params)-go_app params typ = mapM_ ftv (typ : params)-go_info :: (Quasi m, MonadState St m) => [Type] -> Info -> m ()-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: " ++ pprint1 info-go_dec :: (Quasi m, MonadState St m) => [Type] -> Dec -> m ()-#if MIN_VERSION_template_haskell(2,11,0)-go_dec params (NewtypeD cx tname tvs m con supers) = go_dec params (DataD cx tname tvs m [con] supers)-go_dec params (DataD _ tname tvs _ _ _) | length params > length tvs = error $ "Too many arguments to " ++ show tname-go_dec params (DataD _cx tname tvs _ cons _supers) = do-  -- For each type variable bound to a type parameter,-  -- replace the type variable with the free variables-  -- in the parameter-  ftv cons-  go_params tname tvs params-#else-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-go_dec params (DataD _cx tname tvs cons _supers) = do-  -- For each type variable bound to a type parameter,-  -- replace the type variable with the free variables-  -- in the parameter-  ftv cons-  go_params tname tvs params-#endif-go_dec params (TySynD tname tvs typ) = do-  -- Add the free variables in the type, then subtract the ones that-  -- are bound here.-  ftv typ-  go_params tname tvs params---- I have a feeling this is utterly wrong.  Example, with this class:------ class OrderKey k => OrderMap k where---    data Order k :: * -> *---    ...------ the resulting declaration of Order is------    FamilyD DataFam Language.Haskell.TH.Path.Order.Order [PlainTV k,PlainTV $a] (Just StarT)---    params=[ConT AbbrevPairID]------ so the parameter is bound to k, and $a should be free.-#if MIN_VERSION_template_haskell(2,11,0)-go_dec params (DataFamilyD tname tvs _mkind) = go_params tname tvs params-#else-go_dec params (FamilyD _flavour tname tvs _mkind) = go_params tname tvs params-#endif-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-go_params _ tvs params = mapM_ (uncurry go_param) (zip tvs (map Just params ++ repeat Nothing))---- | Update the free variable set for a type parameter-go_param :: (Quasi m, MonadState St m) => TyVarBndr -> Maybe Type -> m ()-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 ++ ", " ++ pprint1 param ++ ")") (return ())-  ftv param-  result %= Set.delete (tvbName tvb)-  -- let tv = tvbName tvb-  -- r <- use result-  -- when (Set.member tv r) (ftv param >> result %= Set.delete tv)-go_param tvb Nothing = do-  -- If there is a variable not bound to a type parameter it is fee-  result %= Set.insert (tvbName tvb)--{--instance FreeTypeVars Info where-    ftv (TyConI dec) = ftv dec--instance FreeTypeVars Dec where-    ftv dec@(DataD _ _ _ _ _ _) = ftv dec-#if __GLASGOW_HASKELL__ >= 709-    go_pred = go-#else-    go_pred (ClassP _ tys) = freeNamesOfTypes tys-    go_pred (EqualP t1 t2) = go t1 <> go t2-#endif--}--instance FreeTypeVars Con where-    ftv (NormalC _name sts) = ftv sts-    ftv (RecC _name vsts) = ftv vsts-    ftv (InfixC st1 _ st2) = ftv [st1, st2]-    -- I'm not sure what effect this forall has.-    ftv (ForallC _tvbs _cx con) = ftv con--instance FreeTypeVars (Strict, Type) where-    ftv (_, typ) = ftv typ--instance FreeTypeVars (Name, Strict, Type) where-    ftv (_, _, typ) = ftv typ---- | Extract a 'Name' from a 'TyVarBndr'-tvbName :: TyVarBndr -> Name-tvbName (PlainTV n)    = n-tvbName (KindedTV n _) = n
− Language/Haskell/TH/TypeGraph/Lens.hs 
@@ -1,86 +0,0 @@--- | The HasStack monad used in MIMO to construct lenses that look--- deep into a record type.  However, it does not involve the Path--- type mechanism, and is unaware of View instances and other things--- that modify the type graph.  Lets see how it adapts.-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}-module Language.Haskell.TH.TypeGraph.Lens-    ( makeTypeGraphLenses-    , lensNamePairs-    ) where--import Control.Category ((.))-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, Map)-import Data.Set (Set)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH-import Language.Haskell.TH.Desugar (DsMonad)-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.Syntax hiding (lift)-import Language.Haskell.TH.Expand (E(E), ExpandMap)-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, TGVSimple, TGV)-import Prelude hiding ((.))---- | Generate lenses to access the fields of the row types.  Like--- Control.Lens.TH.makeLenses, but makes lenses for every field, and--- instead of removing the prefix '_' to form the lens name it adds--- the prefix "lens" and capitalizes the first letter of the field.--- The only reason for this function is backwards compatibility,--- makeLensesFor should be used instead.-makeTypeGraphLenses :: forall m. (DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m, MonadStates ExpandMap m) => m [Dec]-makeTypeGraphLenses =-    (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 ()-#if MIN_VERSION_template_haskell(2,11,0)-      doInfo (TyConI (NewtypeD _ tname _ _ _ _)) = lensNamePairs namer tname >>= \pairs -> runQ (makeLensesFor pairs tname) >>= tell-      doInfo (TyConI (DataD _ tname _ _ _ _)) = lensNamePairs namer tname >>= \pairs -> runQ (makeLensesFor pairs tname) >>= tell-#else-      doInfo (TyConI (NewtypeD _ tname _ _ _)) = lensNamePairs namer tname >>= \pairs -> runQ (makeLensesFor pairs tname) >>= tell-      doInfo (TyConI (DataD _ tname _ _ _)) = lensNamePairs namer tname >>= \pairs -> runQ (makeLensesFor pairs tname) >>= tell-#endif-      doInfo _ = return ()--namer :: Name -> Name -> Name -> (String, String)-namer _tname _cname fname = (nameBase fname, lensNamer (nameBase fname))---- | Build the list of pairs used by makeLensesFor.-lensNamePairs :: Quasi m => (Name -> Name -> Name -> (String, String)) -> Name -> m [(String, String)]-lensNamePairs namefn tname =-    qReify tname >>= execWriterT . doInfo-    where-      doInfo (TyConI dec) = doDec dec-      doInfo _ = return ()-#if MIN_VERSION_template_haskell(2,11,0)-      doDec (NewtypeD _ _ _ _ con _) = doCon con-      doDec (DataD _ _ _ _ cons _) = mapM_ doCon cons-#else-      doDec (NewtypeD _ _ _ con _) = doCon con-      doDec (DataD _ _ _ cons _) = mapM_ doCon cons-#endif-      doDec (TySynD _ _ _) = return ()-      doDec _ = return ()-      doCon (ForallC _ _ con) = doCon con-      doCon (RecC cname flds) = mapM_ (doField cname) flds-      doCon (NormalC _ _) = return ()-      doCon (InfixC _ _ _) = return ()-      doField cname (fname, _, (ConT fTypeName)) = qReify fTypeName >>= doFieldTypeName cname fname-      doField cname (fname, _, _) = tell [namefn tname cname fname]-      doFieldTypeName _cname _fname (PrimTyConI _ _ _) = return ()-      doFieldTypeName cname fname _ = tell [namefn tname cname fname]
− Language/Haskell/TH/TypeGraph/Prelude.hs 
@@ -1,183 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-module Language.Haskell.TH.TypeGraph.Prelude-    ( pprint1-    , pprintW-    , pprintL-    , OverTypes(overTypes)-    , unlifted-    , constructorName-    , declarationName-    , declarationType-    , unReify-    , unReifyName-    , adjacent'-    , reachable'-    , friendlyNames-    ) where--import Control.Lens hiding (cons)-import Control.Monad (foldM)-import Data.Generics (Data, everywhere, mkT)-import Data.Graph as Graph-import Data.Map as Map (Map, fromList, toList)-import Data.Maybe (fromJust, fromMaybe)-import Data.Set as Set (fromList, Set, toList)-import Language.Haskell.TH-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-import Instances.TH.Lift () -- extra Lift instances--instance Ppr () where-    ppr () = ptext "()"---- | 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.  (If the data type--- has no 'Name' values the friendlyNames function has no effect.)-pprint1 :: (Ppr a, Data a) => a -> [Char]-pprint1 = pprintStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode}) . friendlyNames---- | Pretty print with friendly names and wide lines-pprintW :: (Ppr a, Data a) => Int -> a -> [Char]-pprintW w = pprintStyle (HPJ.style {HPJ.lineLength = w}) . friendlyNames---- | Pretty print with friendly names in left mode-pprintL :: (Ppr a, Data a) => a -> [Char]-pprintL = pprintStyle (HPJ.style {HPJ.mode = HPJ.LeftMode}) . friendlyNames---- | Helper function for pprint1 et. al.-pprintStyle :: (Ppr a, Data a) => HPJ.Style -> a -> String-pprintStyle style = HPJ.renderStyle style . to_HPJ_Doc . ppr . friendlyNames---- | Make a template haskell value more human reader friendly.  The--- result almost certainly won't be compilable.  That's ok, though,--- because the input is usually uncompilable - it imports hidden modules,--- uses infix operators in invalid positions, puts module qualifiers in--- places where they are not allowed, and maybe other things.-friendlyNames :: Data a => a -> a-friendlyNames =-    everywhere (mkT friendlyName)-    where-      friendlyName (Name x _) = Name x NameS -- Remove all module qualifiers---- | 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--instance OverTypes Dec where-#if MIN_VERSION_template_haskell(2,11,0)-    overTypes f a (DataD _ _ _ _ cons _) = foldM (overTypes f) a cons-    overTypes f a (NewtypeD _ _ _ _ con _) = overTypes f a con-#else-    overTypes f a (DataD _ _ _ cons _) = foldM (overTypes f) a cons-    overTypes f a (NewtypeD _ _ _ con _) = overTypes f a con-#endif-    overTypes f a (TySynD _ _ typ) = overTypes f a typ-    overTypes _ a _ = return a--instance OverTypes StrictType where-    overTypes f a (_, t) = overTypes f a t--instance OverTypes VarStrictType where-    overTypes f a (_, _, t) = overTypes f a t--instance OverTypes Con where-    overTypes f a (ForallC _ _ con) = overTypes f a con-    overTypes f a (NormalC _ ts) = foldM (overTypes f) a ts-    overTypes f a (RecC _ ts) = foldM (overTypes f) a ts-    overTypes f a (InfixC t1 _ t2) = overTypes f a t1 >>= flip (overTypes f) t2--instance OverTypes Type where-    overTypes f a t@(AppT t1 t2) = f a (Right t) >>= flip (overTypes f) t1 >>= flip (overTypes f) t2-    overTypes f a (ConT name) = qReify name >>= overTypes f a-    overTypes f a t@(ForallT _ _ typ) = f a (Right t) >>= flip (overTypes f) typ-    overTypes f a t = f a (Right t)--instance OverTypes Info where-    overTypes f a x = f a (Left x)---- | Does the type or the declaration to which it refers contain a--- primitive (aka unlifted) type?  This will traverse down any 'Dec'--- to the named types, and then check whether any of their 'Info'--- records are 'PrimTyConI' values.-unlifted :: (OverTypes t, Quasi m) => t -> m Bool-unlifted x = overTypes f False x-    where-      f _ (Left (PrimTyConI _ _ _)) = return True-      f r _ = return r--constructorName :: Con -> Name-constructorName (ForallC _ _ con) = constructorName con-constructorName (NormalC name _) = name-constructorName (RecC name _) = name-constructorName (InfixC _ name _) = name--declarationName :: Dec -> Maybe Name-declarationName (FunD name _) = Just name-declarationName (ValD _pat _body _decs) = Nothing-#if MIN_VERSION_template_haskell(2,11,0)-declarationName (DataD _ name _ _ _ _) = Just name-declarationName (NewtypeD _ name _ _ _ _) = Just name-#else-declarationName (DataD _ name _ _ _) = Just name-declarationName (NewtypeD _ name _ _ _) = Just name-#endif-declarationName (TySynD name _ _) = Just name-declarationName (ClassD _ name _ _ _) = Just name-#if MIN_VERSION_template_haskell(2,11,0)-declarationName (InstanceD _ _ _ _) = Nothing-#else-declarationName (InstanceD _ _ _) = Nothing-#endif-declarationName (SigD name _) = Just name-declarationName (ForeignD _) = Nothing-declarationName (InfixD _ name) = Just name-declarationName (PragmaD _) = Nothing-#if MIN_VERSION_template_haskell(2,11,0)-declarationName (DataFamilyD _name _ _) = Nothing-declarationName (DataInstD _ name _ _ _ _) = Just name-declarationName (NewtypeInstD _ name _ _ _ _) = Just name-declarationName (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) = Just name-#else-declarationName (FamilyD _ _name _ _) = Nothing-declarationName (DataInstD _ name _ _ _) = Just name-declarationName (NewtypeInstD _ name _ _ _) = Just name-declarationName (ClosedTypeFamilyD name _ _ _) = Just name-#endif-declarationName (TySynInstD name _) = Just name-declarationName (RoleAnnotD name _) = Just name-declarationName (StandaloneDerivD _ _) = Nothing-declarationName (DefaultSigD name _) = Just name--declarationType :: Dec -> Maybe Type-declarationType = fmap ConT . declarationName--unReify :: Data a => a -> a-unReify = everywhere (mkT unReifyName)--unReifyName :: Name -> Name-unReifyName = mkName . nameBase---- | Return a key's list of adjacent keys-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) -> (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/Shape.hs 
@@ -1,118 +0,0 @@--- | A fold on the shape of the constructors of a DataD or NewtypeD record.-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-module Language.Haskell.TH.TypeGraph.Shape-    ( -    -- * Field name and position-      Field-    , FieldType(..)-    , fieldType-    , constructorName-    , constructorFields-    , constructorFieldTypes-    , constructorPat-    , fPos-    , fName-    , fType-    -- * Decl shape-    , foldShape-    ) where--import Data.Generics (Data)-import Data.Typeable (Typeable)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH-import Language.Haskell.TH.Desugar ({- instances -})-import Language.Haskell.TH.PprLib (ptext)-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.TypeGraph.Prelude (unReifyName)-import Language.Haskell.TH.Expand (E)---- FieldType and Field should be merged, or made less rudundant.--type Field = ( Name, -- type name-               Con,  -- constructor-               Either Int -- field position-                      Name -- field name-             )--instance Ppr Field where-    ppr (tname, con, field) = ptext $-        "field " ++-        show (unReifyName tname) ++ "." ++-        either (\ n -> show (unReifyName (constructorName con)) ++ "[" ++ show n ++ "]") (\ f -> show (unReifyName f)) field--instance Ppr (Maybe Field, E Type) where-    ppr (mf, typ) = ptext $ pprint typ ++ maybe "" (\fld -> " (field " ++ pprint fld ++ ")") mf--instance Ppr (Maybe Field, Type) where-    ppr (mf, typ) = ptext $ pprint typ ++ " (unexpanded)" ++ maybe "" (\fld -> " (field " ++ pprint fld ++ ")") mf--data FieldType = Positional Int StrictType | Named VarStrictType deriving (Eq, Ord, Show, Data, Typeable)--fieldType :: FieldType -> Type-fieldType (Positional _ (_, ftype)) = ftype-fieldType (Named (_, _, ftype)) = ftype--instance Ppr FieldType where-    ppr (Positional x _) = ptext $ show x-    ppr (Named (x, _, _)) = ptext $ nameBase x--fPos :: FieldType -> Either Int Name-fPos = fName--fName :: FieldType -> Either Int Name-fName (Positional x _) = Left x-fName (Named (x, _, _)) = Right x--fType :: FieldType -> Type-fType (Positional _ (_, x)) = x-fType (Named (_, _, x)) = x---- | Given the list of constructors from a Dec, dispatch on the--- different levels of complexity of the type they represent - a--- wrapper is a single arity one constructor, an enum is--- several arity zero constructors, and so on.-foldShape :: Monad m =>-             ([(Con, [FieldType])] -> m r) -- dataFn - several constructors not all of which are arity zero-          -> (Con -> [FieldType] -> m r)   -- recordFn - one constructor which has arity greater than one-          -> ([Con] -> m r)                -- enumFn - all constructors are of arity zero-          -> (Con -> FieldType -> m r)     -- wrapperFn - one constructor of arity one-          -> [Con] -> m r-foldShape dataFn recordFn enumFn wrapperFn cons =-    case zip cons (map constructorFieldTypes cons) :: [(Con, [FieldType])] of-      [(con, [fld])] ->-          wrapperFn con fld-      [(con, flds)] ->-          recordFn con flds-      pairs | all (== 0) (map (length . snd) pairs) ->-          enumFn (map fst pairs)-      pairs ->-          dataFn pairs--constructorFieldTypes :: Con -> [FieldType]-constructorFieldTypes (ForallC _ _ con) = constructorFieldTypes con-constructorFieldTypes (NormalC _ ts) = map (uncurry Positional) (zip [1..] ts)-constructorFieldTypes (RecC _ ts) = map Named ts-constructorFieldTypes (InfixC t1 _ t2) = [Positional 1 t1, Positional 2 t2]--constructorFields :: Name -> Con -> [Field]-constructorFields tname (ForallC _ _ con) = constructorFields tname con-constructorFields tname con@(NormalC _cname fields) = map (\(i, _) -> (tname, con, Left i)) (zip ([1..] :: [Int]) fields)-constructorFields tname con@(RecC _cname fields) = map (\ (fname, _, _typ) -> (tname, con, Right fname)) fields-constructorFields tname con@(InfixC (_, _lhs) _cname (_, _rhs)) = [(tname, con, Left 1), (tname, con, Left 2)]--constructorName :: Con -> Name-constructorName (ForallC _ _ con) = constructorName con-constructorName (NormalC cname _) = cname-constructorName (RecC cname _) = cname-constructorName (InfixC _ cname _) = cname---- | Build a pattern that will match only values with the given constructor.-constructorPat :: Con -> PatQ-constructorPat (ForallC _ _ con) = constructorPat con-constructorPat (NormalC cname _) = recP cname []-constructorPat (RecC cname _) = recP cname []-constructorPat (InfixC _ cname _) = infixP wildP cname wildP
− Language/Haskell/TH/TypeGraph/Stack.hs 
@@ -1,175 +0,0 @@--- | The HasStack monad used in MIMO to construct lenses that look--- deep into a record type.  However, it does not involve the Path--- type mechanism, and is unaware of View instances and other things--- that modify the type graph.  Lets see how it adapts.-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}-module Language.Haskell.TH.TypeGraph.Stack-    ( TypeStack(..)-    , topType-    , typeStack-    , StackElement(..)-    , prettyStack-    , foldField-      -- * Stack+instance map monad-    , HasStack-    , StackT-    , execStackT-    , withStack-    , push-      -- * Stack operations-    , stackAccessor-    , traceIndented-    , lensNamer-    ) where--import Control.Applicative-import Control.Category ((.))-import Control.Lens as Lens -- (iso, Lens', lens, set, view, (%=), (.~))-import Control.Monad.Reader (ask, ReaderT, runReaderT)-import Control.Monad.Readers (MonadReaders(askPoly, localPoly))-import Control.Monad.Trans (lift)-import Data.Char (toUpper)-import Data.Generics (Data, Typeable)-import Data.Maybe (fromMaybe)-import Debug.Trace (trace)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.Syntax hiding (lift)-import Language.Haskell.TH.TypeGraph.Prelude (constructorName)-import Language.Haskell.TH.TypeGraph.Shape (FieldType(..), fName, fType, constructorFieldTypes)-import Language.Haskell.TH.TypeGraph.TypeInfo (TypeInfo)-import Prelude hiding ((.))---- | The information required to extact a field value from a value.--- We keep a stack of these as we traverse a declaration.  Generally,--- we only need the field names.-data StackElement = StackElement FieldType Con Dec deriving (Eq, Show, Data, Typeable)---- | A stack describes a path from a top type down through fields of--- its component types.-data TypeStack-    = TypeStack-      { _topType :: Type-      , _typeStack :: [StackElement]-      } deriving (Eq, Show, Data, Typeable)--$(makeLenses ''TypeStack)--type HasStack = MonadReaders TypeStack--withStack :: (Monad m, MonadReaders TypeStack m) => (TypeStack -> m a) -> m a-withStack f = askPoly >>= f--instance MonadReaders TypeInfo m => MonadReaders TypeInfo (ReaderT TypeStack m) where-    askPoly = lift askPoly-    localPoly f action = ask >>= runReaderT (localPoly f (lift action))---- | push an element onto the TypeStack in m-push :: MonadReaders TypeStack m => FieldType -> Con -> Dec -> m a -> m a-push fld con dec action = localPoly (\(stk :: TypeStack) -> set typeStack (StackElement fld con dec : view typeStack stk) stk) action--traceIndented :: MonadReaders TypeStack m => String -> m ()-traceIndented s = withStack $ \stk -> trace (replicate (length (view typeStack stk)) ' ' ++ s) (return ())--prettyStack :: TypeStack -> String-prettyStack stk = prettyType (view topType stk) ++ " → " ++ prettyStack' (reverse (view typeStack stk))-    where-      prettyStack' :: [StackElement] -> String-      prettyStack' [] = "(empty)"-      prettyStack' (x : xs) = "[" ++ prettyElt x ++ prettyTail xs ++ "]"-      prettyTail [] = ""-      prettyTail (x : xs) = " → " ++ prettyElt x ++ prettyTail xs-      prettyElt (StackElement fld con dec) = prettyDec dec ++ ":" ++ prettyCon con ++ "." ++ pprint fld-      prettyDec (TySynD _ _ typ) = prettyType typ-#if MIN_VERSION_template_haskell(2,11,0)-      prettyDec (NewtypeD _ name _ _ _ _) = nameBase name-      prettyDec (DataD _ name _ _ _ _) = nameBase name-#else-      prettyDec (NewtypeD _ name _ _ _) = nameBase name-      prettyDec (DataD _ name _ _ _) = nameBase name-#endif-      prettyDec dec = error $ "prettyStack: " ++ show dec-      prettyCon = nameBase . constructorName-      prettyType (AppT t1 t2) = "((" ++ prettyType t1 ++ ") (" ++ prettyType t2 ++ "))"-      prettyType (ConT name) = nameBase name-      prettyType typ = "(" ++ show typ ++ ")"---- | Push the stack and process the field.-foldField :: MonadReaders TypeStack m => (FieldType -> m r) -> Dec -> Con -> FieldType -> m r-foldField doField dec con fld = push fld con dec $ doField fld--type StackT m = ReaderT TypeStack m--execStackT :: Monad m => StackT m a -> Type -> m a-execStackT action type0 = runReaderT action (TypeStack {_topType = type0, _typeStack = []})---- | Return a lambda function that turns a value of Type typ0 into the--- type implied by the stack elements.-stackAccessor :: (Quasi m, MonadReaders TypeStack m) => m Exp-stackAccessor =-    withStack f-    where-      -- It works without this case, but this way the code is a little-      -- neater.  FIXME: Actually, we should have a stackView function-      -- that only builds the getter, we are just throwing away the-      -- lens's setter here.-      f stk | null (view typeStack stk) = runQ [|id|]-      f stk = do-        lns <- runQ $ stackLens stk-        Just typ <- stackType-        runQ [| \x -> (Lens.view $(pure lns) x) :: $(pure typ) |]--stackType :: MonadReaders TypeStack m => m (Maybe Type)-stackType =-    withStack (return . f . view typeStack)-    where-      f [] = Nothing-      f (StackElement fld _ _ : _) = Just (fType fld)---- | Return an expression of a lens for the value described by the--- stack.-stackLens :: TypeStack -> Q Exp-stackLens stk =-    case view typeStack stk of-      [] -> [| id |]-      xs -> mapM fieldLens xs >>= foldl1 (\ a b -> [|$b . $a|]) . map return--nthLens :: Int -> Lens' [a] a-nthLens n = lens (\ xs -> xs !! n) (\ xs x -> take (n - 1) xs ++ [x] ++ drop n xs)---- | Generate a lens to access a field, as represented by the--- StackElement type.-fieldLens :: StackElement -> Q Exp-fieldLens e@(StackElement fld con _) =-    do lns <--           case fName fld of-              Right fieldName ->-                  -- Use the field name to build an accessor-                  let lensName = lensNamer (nameBase fieldName) in-                  lookupValueName lensName >>= maybe (error ("fieldLensName - missing lens: " ++ lensName)) varE-              Left fieldPos ->-                  -- Build a pattern expression to extract the field-                  do cname <- lookupValueName (nameBase $ constructorName con) >>= return . fromMaybe (error $ "fieldLens: " ++ show e)-                     f <- newName "f"-                     let n = length $ constructorFieldTypes con-                     as <- mapM newName (map (\ p -> "_a" ++ show p) [1..n])-                     [| lens -- \ (Con _ _ _ x _ _) -> x-                             $(lamE [conP cname (set (nthLens fieldPos) (varP f) (repeat wildP))] [| $(varE f) :: $(pure (fType fld)) |])-                             -- \ x (Con a b c _ d e) -> Con a b c x d e-                             $(lamE [conP cname (map varP as), varP f] (foldl appE (conE cname) (set (nthLens fieldPos) (varE f) (map varE as)))) |]-       [| $(pure lns) {- :: Lens $(pure top) $(pure (fType fld)) -} |]---- | Given a field name, return the name to use for the corresponding lens.-lensNamer :: String -> String-lensNamer (n : ame) = "lens" ++ [toUpper n] ++ ame-lensNamer "" = error "Saw the empty string as a field name"
− Language/Haskell/TH/TypeGraph/TypeGraph.hs 
@@ -1,339 +0,0 @@--- | Abstract operations on Maps containing graph edges.--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE TypeFamilies #-}--module Language.Haskell.TH.TypeGraph.TypeGraph-    ( TypeGraph, graph, gsimple, stack-    , makeTypeGraph-    , graphFromMap--    -- , MaybePair(toMaybePair)-    , HasTGV(asTGV)-    , HasTGVSimple(asTGVSimple)--    -- * TypeGraph queries-    , simplify-    , allPathNodes-    , allPathStarts-    , lensKeys, allLensKeys-    , tgv, tgvSimple, tgvSimple'-    , pathKeys, pathKeys', allPathKeys-    , reachableFrom-    , reachableFromSimple-    , goalReachableFull-    , goalReachableSimple-    , goalReachableSimple'--    , VertexStatus(..)-    -- , adjacent-    , typeGraphVertex-    , typeGraphVertexOfField-    ) where--#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-import Data.Monoid (mempty)-#else-import Control.Applicative-#endif-import Control.Lens-import Control.Monad (foldM)-import qualified Control.Monad.Reader as MTL (ask, ReaderT, runReaderT)-import Control.Monad.Readers (MonadReaders(askPoly, localPoly))-import Control.Monad.States (MonadStates)-import Control.Monad.Trans (lift)-import Data.Default (Default(def))-import Data.Foldable as Fold-import Data.Graph hiding (edges)-import Data.List as List (map)-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, 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.TypeGraph.Edges (GraphEdges, simpleEdges)-import Language.Haskell.TH.Expand (ExpandMap, expandType)-import Language.Haskell.TH.TypeGraph.Prelude (adjacent', pprint1, reachable')-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'(..), TGV, TGVSimple'(..), TGVSimple, TypeGraphVertex, 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)-      , _stack :: [StackElement]-      }---- | Build a TypeGraph given a set of edges and the TypeInfo environment-makeTypeGraph :: MonadReaders TypeInfo m => (GraphEdges TGV') -> m TypeGraph-makeTypeGraph es = do-  return $ TypeGraph-             { _graph = graphFromMap es-             , _gsimple = graphFromMap (simpleEdges es)-             , _stack = []-             }---- | Build a graph from the result of typeGraphEdges, each edge goes--- from a type to one of the types it contains.  Thus, each edge--- represents a primitive lens, and each path in the graph is a--- composition of lenses.-graphFromMap :: forall key. (Ord key) =>-                GraphEdges key -> (Graph, Vertex -> ((), key, [key]), key -> Maybe Vertex)-graphFromMap mp =-    graphFromEdges triples-    where-      triples :: [((), key, [key])]-      triples = List.map (\ (k, ks) -> ((), k, Fold.toList ks)) $ Map.toList mp--$(makeLenses ''TypeGraph)--instance (Monad m, MonadReaders [StackElement] m) => MonadReaders [StackElement] (MTL.ReaderT TypeGraph m) where-    askPoly = lift askPoly-    localPoly f action = MTL.ask >>= MTL.runReaderT (localPoly f (lift action))--instance MonadReaders TypeInfo m => MonadReaders TypeInfo (MTL.ReaderT TypeGraph m) where-    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-    ppr (g, vf, _) = vcat (List.map (ppr . vf) (vertices g))--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 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 = do-  ts <- allPathNodes :: m (Set TGV)-  Set.mapM simplify 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 :: forall m. (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => m (Map TGVSimple (Set TGV))-allLensKeys = do-  (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 (Maybe TGVSimple)-tgvSimple t =-    do (_g, _vf, kf) <- askPoly >>= return . view gsimple-       s <- expandType t >>= typeVertex-       return $ fmap (\k -> (k, s)) (kf s)--tgvSimple' :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) =>-              Type -> m TGVSimple-tgvSimple' typ =-    tgvSimple typ >>= maybe (error $ "tgvSimple' - no node for " ++ pprint1 typ) pure---- | 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 s = do-  g <- view' graph-  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-  starts <- Set.toList <$> allPathStarts-  foldM (\mp s -> pathKeys s >>= return . Fold.foldr (Map.insertWith Set.union s . Set.singleton) mp) mempty starts---- | 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 s = do-  gs <- view' gsimple-  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-#if 0-  g <- view' graph-  Set.fromList <$> Prelude.mapM simplify (reachable' g s)-#else-  s' <- simplify s-  gs <- view' gsimple-  pure $ Set.fromList $ reachable' gs s'-#endif--  -- 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 t = do-  -- (g, vf, kf) <- graphFromMap <$> view edges-  (g, vf, kf) <- view' graph-  case kf (asTGV t) of-    Nothing -> return Set.empty-    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 s = do-  -- (g, vf, kf) <- graphFromMap <$> view edges-  (g, vf, kf) <- view' gsimple-  case kf (asTGVSimple s) of-    Nothing -> return Set.empty-    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, 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, 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, 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 typ = do-        typ' <- expandType typ-        askPoly >>= \(ti :: TypeInfo) -> MTL.runReaderT (typeVertex' typ') ti-        -- magnify typeInfo $ vertex Nothing typ'---- | Return the TGV associated with a particular type and field.-typeGraphVertexOfField :: (MonadReaders TypeInfo m, MonadStates ExpandMap m, DsMonad m) => Field -> Type -> m TGV'-typeGraphVertexOfField fld typ = do-        typ' <- expandType typ-        askPoly >>= \(ti :: TypeInfo) -> MTL.runReaderT (fieldVertex fld typ') ti-        -- magnify typeInfo $ vertex (Just fld) typ'---- type TypeGraphEdges typ = Map typ (Set typ)---- | When a VertexStatus value is associated with a Type it describes--- alterations in the type graph from the usual default.-data VertexStatus typ-    = Vertex      -- ^ normal case-    | Sink        -- ^ out degree zero - don't create any outgoing edges-    | Divert typ  -- ^ replace all outgoing edges with an edge to an alternate type-    | Extra typ   -- ^ add an extra outgoing edge to the given type-    deriving Show--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.-adjacent :: forall m. ({-MonadReaders TypeGraph m,-} MonadReaders TypeInfo m, DsMonad m, MonadStates ExpandMap m) => TGV -> m (Set TGV)-adjacent typ =-    case view (vsimple . etype) typ of-      E (ForallT _ _ typ') -> typeGraphVertex typ' >>= adjacent-      E (AppT c e) ->-          typeGraphVertex c >>= \c' ->-          typeGraphVertex e >>= \e' ->-          return $ Set.fromList [c', e']-      E (ConT name) -> do-        info <- qReify name-        case info of-          TyConI dec -> doDec dec-          _ -> return mempty-      _typ -> return $ {-trace ("Unrecognized type: " ++ pprint' typ)-} mempty-    where-      doDec :: Dec -> m (Set TGV)-      doDec dec@(NewtypeD _ tname _ con _) = doCon tname dec con-      doDec dec@(DataD _ tname _ cns _) = Set.unions <$> Traversable.mapM (doCon tname dec) cns-      doDec (TySynD _tname _tvars typ') = singleton <$> typeGraphVertex typ'-      doDec _ = return mempty--      doCon :: Name -> Dec -> Con -> m (Set TGV)-      doCon tname dec (ForallC _ _ con) = doCon tname dec con-      doCon tname dec (NormalC cname fields) = Set.unions <$> Traversable.mapM (doField tname dec cname) (zip (List.map Left ([1..] :: [Int])) (List.map snd fields))-      doCon tname dec (RecC cname fields) = Set.unions <$> Traversable.mapM (doField tname dec cname) (List.map (\ (fname, _, typ') -> (Right fname, typ')) fields)-      doCon tname dec (InfixC (_, lhs) cname (_, rhs)) = Set.unions <$> Traversable.mapM (doField tname dec cname) [(Left 1, lhs), (Left 2, rhs)]--      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 
@@ -1,204 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-}-module Language.Haskell.TH.TypeGraph.TypeInfo-    ( -- * Type and builders-      TypeInfo, startTypes, fields, infoMap, synonyms, typeSet-    , makeTypeInfo-    -- * Update-    , typeVertex-    , typeVertex'-    , fieldVertex-    -- * Query-    , fieldVertices-    , allVertices-    ) where--#if __GLASGOW_HASKELL__ < 709-import Data.Monoid (mempty)-#endif-import Control.Lens -- (makeLenses, view)-import Control.Monad.Readers (askPoly, MonadReaders)-import Control.Monad.Trans as Monad-import Control.Monad.State (execStateT, StateT)-import Control.Monad.States (MonadStates(getPoly, putPoly))-import Data.Foldable as Foldable (mapM_)-import Data.List as List (intercalate, map)-import Data.Map as Map (findWithDefault, insert, insertWith, Map, toList)-import Data.Set.Extra as Set (empty, insert, map, mapM_, member, Set, singleton, toList, union)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH-import Language.Haskell.TH.Desugar as DS (DsMonad)-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.PprLib (ptext)-import Language.Haskell.TH.Syntax as TH (Lift(lift), Quasi(..))-import Language.Haskell.TH.Expand (E(E), ExpandMap, expandType)-import Language.Haskell.TH.TypeGraph.Prelude (pprint1)-import Language.Haskell.TH.TypeGraph.Shape (Field)-import Language.Haskell.TH.TypeGraph.Vertex (TGV'(..), TGVSimple'(..), etype)---- | Information collected about the graph implied by the structure of--- one or more 'Type' values.-data TypeInfo-    = TypeInfo-      { _startTypes :: [Type]-      -- ^ The kernel of types from which the others in _typeSet are discovered-      , _typeSet :: Set Type-      -- ^ All the types encountered, including embedded types such as the-      -- 'Maybe' and the 'Int' in @Maybe Int@.-      , _infoMap :: Map Name Info-      -- ^ The Info record of all known named types-      , _expanded :: ExpandMap-      -- ^ Map of the expansion of all encountered types-      , _synonyms :: Map (E Type) (Set Name)-      -- ^ The types with all type synonyms replaced with their expansions.-      , _fields :: Map (E Type) (Set Field)-      -- ^ Map from field type to field names-      } deriving (Show, Eq, Ord)--instance Ppr TypeInfo where-    ppr (TypeInfo {_typeSet = t, _infoMap = i, _expanded = e, _synonyms = s, _fields = f}) =-        ptext $ intercalate "\n  " ["TypeInfo:", ppt, ppi, ppe, pps, ppf] ++ "\n"-        where-          ppt = intercalate "\n    " ("typeSet:" : concatMap (lines . pprint) (Set.toList t))-          ppi = intercalate "\n    " ("infoMap:" : concatMap (lines . (\ (name, info) -> show name ++ " -> " ++ pprint info)) (Map.toList i))-          ppe = intercalate "\n    " ("expanded:" : concatMap (lines . (\ (typ, (E etyp)) -> pprint typ ++ " -> " ++ pprint etyp)) (Map.toList e))-          pps = intercalate "\n    " ("synonyms:" : concatMap (lines . (\ (typ, ns) -> pprint typ ++ " -> " ++ show ns)) (Map.toList s))-          ppf = intercalate "\n    " ("fields:" : concatMap (lines . (\ (typ, fs) -> pprint typ ++ " -> " ++ show fs)) (Map.toList f))--$(makeLenses ''TypeInfo)--instance Monad m => MonadStates ExpandMap (StateT TypeInfo m) where-    getPoly = use expanded-    putPoly x = expanded .= x--instance Lift TypeInfo where-    lift (TypeInfo {_startTypes = st, _typeSet = t, _infoMap = i, _expanded = e, _synonyms = s, _fields = f}) =-        [| TypeInfo { _startTypes = $(TH.lift st)-                    , _typeSet = $(TH.lift t)-                    , _infoMap = $(TH.lift i)-                    , _expanded = $(TH.lift e)-                    , _synonyms = $(TH.lift s)-                    , _fields = $(TH.lift f)-                    } |]---- | Collect the graph information for one type and all the types--- reachable from it.  The extraTypes function parameter allows extra--- edges to be added to the graph other than those implied by the Type--- structure.-collectTypeInfo :: forall m. DsMonad m => (Type -> m (Set Type)) -> Type -> StateT TypeInfo m ()-collectTypeInfo extraTypes typ0 = do-  doType typ0-    where-      doType :: Type -> StateT TypeInfo m ()-      doType typ = Monad.lift (extraTypes typ) >>= Set.mapM_ doType' . Set.insert typ--      doType' :: Type -> StateT TypeInfo m ()-      doType' typ = do-        (s :: Set Type) <- use typeSet-        case Set.member typ s of-          True -> return ()-          False -> do typeSet %= Set.insert typ-                      etyp{-@(E etyp')-} <- expandType typ-                      expanded %= Map.insert typ etyp-                      -- expanded %= Map.insert etyp' etyp -- A type is its own expansion, but we shouldn't need this-                      doType'' typ--      doType'' :: Type -> StateT TypeInfo m ()-      doType'' (ConT name) = do-        info <- qReify name-        infoMap %= Map.insert name info-        doInfo name info-      doType'' (AppT typ1 typ2) = doType typ1 >> doType typ2-      doType'' ListT = return ()-      doType'' (VarT _) = return ()-      doType'' (TupleT _) = return ()-      doType'' typ = error $ "makeTypeInfo: " ++ pprint1 typ--      doInfo :: Name -> Info -> StateT TypeInfo m ()-      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) = doType typ-#if MIN_VERSION_template_haskell(2,11,0)-      doDec (NewtypeD _ tname _ _ constr _) = doCon tname constr-      doDec (DataD _ tname _ _ constrs _) = Foldable.mapM_ (doCon tname) constrs-#else-      doDec (NewtypeD _ tname _ constr _) = doCon tname constr-      doDec (DataD _ tname _ constrs _) = Foldable.mapM_ (doCon tname) constrs-#endif-      doDec dec = error $ "makeTypeInfo: " ++ pprint1 dec--      doCon :: Name -> Con -> StateT TypeInfo m ()-      doCon tname (ForallC _ _ con) = doCon tname con-      doCon tname con@(NormalC _cname flds) = Foldable.mapM_ doField (zip (List.map (\n -> (tname, con, Left n)) ([1..] :: [Int])) (List.map snd flds))-      doCon tname con@(RecC _cname flds) = Foldable.mapM_ doField (List.map (\ (fname, _, ftype) -> ((tname, con, Right fname), ftype)) flds)-      doCon tname con@(InfixC (_, lhs) _cname (_, rhs)) = Foldable.mapM_ doField [((tname, con, Left 1), lhs), ((tname, con, Left 2), rhs)]--      doField :: (Field, Type) -> StateT TypeInfo m ()-      doField (fld, ftyp) = do-        etyp <- expandType ftyp-        fields %= Map.insertWith union etyp (singleton fld)-        doType ftyp---- | Build a TypeInfo value by scanning the supplied types-makeTypeInfo :: forall m. DsMonad m => (Type -> m (Set Type)) -> [Type] -> m TypeInfo-makeTypeInfo extraTypes types =-    execStateT-      (Foldable.mapM_ (collectTypeInfo extraTypes) types)-      (TypeInfo { _startTypes = types-                , _typeSet = mempty-                , _infoMap = mempty-                , _expanded = mempty-                , _synonyms = mempty-                , _fields = mempty})--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---- | 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 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---- | 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 etyp = do-  sm <- view synonyms <$> askPoly-  return $ TGVSimple' {_syns = Map.findWithDefault Set.empty etyp sm, _etype = etyp}--typeVertex' :: MonadReaders TypeInfo m => E Type -> m TGV'-typeVertex' etyp = do-  v <- typeVertex etyp-  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'}
− Language/Haskell/TH/TypeGraph/Vertex.hs 
@@ -1,128 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances #-}-module Language.Haskell.TH.TypeGraph.Vertex-    ( TypeGraphVertex(..)-    , TGV'(..), field, vsimple, TGV-    , TGVSimple'(..), syns, etype, TGVSimple-    , bestTypeQ-    ) 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 (delete, insert, minView, Set, toList)-import Language.Haskell.Exts.Syntax ()-import Language.Haskell.TH -- (Con, Dec, nameBase, Type)-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.PprLib (hang, hcat, ptext, text, vcat)-import Language.Haskell.TH.Syntax (Lift(lift))-import Language.Haskell.TH.Expand (E(E), unE)-import Language.Haskell.TH.TypeGraph.Prelude (unReify, unReifyName)-import Language.Haskell.TH.TypeGraph.Shape (Field)---- | 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'-      { _field :: Maybe Field -- ^ The record field which contains this type-      , _vsimple :: TGVSimple'-      } deriving (Eq, Ord, Show, Data)---- | For simple type graphs where no parent field information is required.-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)--type TGVSimple = (Vertex, TGVSimple')-type TGV = (Vertex, TGV')--$(makeLenses ''TGV')-$(makeLenses ''TGVSimple')--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 ns' of-                 [] -> []-                 _ ->   [ptext " ("] ++-                        intersperse (ptext ", ")-                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) ns') ++-                        [ptext ")"])--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, ns') of-                 (Nothing, []) -> []-                 _ ->   [ptext " ("] ++-                        intersperse (ptext ", ")-                          (List.concatMap (\ n -> [ptext ("aka " ++ show (unReifyName n))]) ns' ++-                           maybe [] (\ f -> [ppr f]) fld) ++-                        [ptext ")"])--instance Ppr TGVSimple where-    ppr = ppr . snd--instance Ppr TGV where-    ppr = ppr . snd--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-    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 TGVSimple' where-    lift (TGVSimple' {_syns = ns, _etype = t}) = [|TGVSimple' {_syns = $(lift ns), _etype = $(lift t)}|]--class TypeGraphVertex v where-    typeNames :: v -> Set Name-    -- ^ Return the set of 'Name' of a type's synonyms, plus the name (if-    -- any) used in its data declaration.  Note that this might return the-    -- empty set.-    bestType :: v -> Type--bestTypeQ :: TypeGraphVertex v => v -> TypeQ-bestTypeQ = pure . bestType--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-    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
+ src/Language/Haskell/TH/TypeGraph/Orphans.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fno-warn-unused-imports -fno-warn-orphans #-}++module Language.Haskell.TH.TypeGraph.Orphans where++import Data.Aeson (FromJSON(parseJSON), Value(Null), ToJSON(toJSON))+#if !MIN_VERSION_aeson(0,11,0)+import Data.Aeson.Types (typeMismatch)+#endif+import qualified Data.Graph.Inductive as G+import Data.Proxy (Proxy(Proxy))+import Data.Set as Set (Set, toList)+import Data.Time (UTCTime(..), Day(ModifiedJulianDay), toModifiedJulianDay, DiffTime)+import Data.UserId (UserId(..))+import Instances.TH.Lift ()+import Language.Haskell.TH (ExpQ, Loc(..), location, Name, NameSpace, Type)+import Language.Haskell.TH.Instances ({-instance Lift Loc-})+import Language.Haskell.TH.Lift (deriveLift, lift)+import Language.Haskell.TH.Ppr (Ppr(ppr))+import Language.Haskell.TH.PprLib (hcat, ptext, vcat)+import Language.Haskell.TH.Syntax (ModName(..), NameFlavour(..), OccName(..), PkgName(..))+import Data.SafeCopy (base, contain, deriveSafeCopy, SafeCopy(errorTypeName, getCopy, kind, putCopy, version))+import Data.Serialize (label, Serialize(..))++#if !MIN_VERSION_aeson(0,11,0)+-- Backport the JSON instances from aeson-0.11.+instance ToJSON (Proxy a) where+   toJSON _ = Null+   {-# INLINE toJSON #-}++instance FromJSON (Proxy a) where+    {-# INLINE parseJSON #-}+    parseJSON Null = pure Proxy+    parseJSON v    = typeMismatch "Proxy" v+#endif++instance Ppr () where+    ppr () = ptext "()"++-- | 'Int' is the 'Data.Path.Index.ContainerKey' type for all lists, so+-- we need to make sure all the required instances exist.+instance Ppr Int where+    ppr = ptext . show++instance Ppr (Set Type, Set Type) where+    ppr (extra, missing) = vcat [ptext "extra:", ppr extra, ptext "missing:", ppr missing]++instance Ppr (Set Type) where+    ppr s = hcat [ptext "Set.fromList [", ppr (Set.toList s), ptext "]"]++instance SafeCopy (Proxy t) where+      putCopy Proxy = contain (do { return () })+      getCopy = contain (label "Data.Proxy.Proxy:" (pure Proxy))+      version = 0+      kind = base+      errorTypeName _ = "Data.Proxy.Proxy"++$(deriveSafeCopy 0 'base ''OccName)+$(deriveSafeCopy 0 'base ''NameSpace)+$(deriveSafeCopy 0 'base ''PkgName)+$(deriveSafeCopy 0 'base ''ModName)+$(deriveSafeCopy 0 'base ''NameFlavour)+$(deriveSafeCopy 0 'base ''Name)+$(deriveSafeCopy 1 'base ''Loc)++instance Serialize UTCTime where+    get = uncurry UTCTime <$> get+    put (UTCTime day time) = put (day, time)++instance Serialize Day where+    get = ModifiedJulianDay <$> get+    put = put . toModifiedJulianDay++instance Serialize DiffTime where+    get = fromRational <$> get+    put = put . toRational++#if MIN_VERSION_aeson(1,0,0)+instance FromJSONKey UserId+instance ToJSONKey UserId+#endif++deriving instance Serialize UserId+deriving instance Serialize Loc++$(deriveLift ''UserId)++$(deriveLift ''G.Gr)+$(deriveLift ''G.NodeMap)
+ src/Language/Haskell/TH/TypeGraph/Phantom.hs view
@@ -0,0 +1,92 @@+-- | Compute which type parameters are phantom types.++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS -Wall #-}++module Language.Haskell.TH.TypeGraph.Phantom+    ( nonPhantom+    ) where++import Control.Lens ((%=), _1, makeLenses, over, use, view)+import Control.Monad.RWS hiding (lift)+import Language.Haskell.TH.TypeGraph.TypeTraversal+import Data.Set as Set+import Language.Haskell.TH+import Language.Haskell.TH.Desugar (DsMonad)++-- | The reader monad type used while generating a 'TypeGraph'.+data R+    = R+      { _params :: [Type]+      -- ^ Positional type parameters.  When @AppT a b@ is+      -- encountered, @b@ is pushed onto the stack and @a@ is+      -- processed.  Then when a type name is reified and is+      -- found to have type variables, they are bound to the+      -- type parameters which are on the stack.+      , _verbosity :: Int+      , _prefix :: String+      }++data S+    = S+      { _result :: Set Type+      , _visited :: Set Type+      }++$(makeLenses ''R)+$(makeLenses ''S)++instance Monad m => HasTypeParameters (PathT m) where+    pushParam typ action = local (over params (typ :)) action+    withParams action = do+      ps <- view params+      local (over params (const [])) (action ps)++instance HasMessageInfo R where+    verbosity' = verbosity+    prefix' = prefix++-- Monad which maintains type variable bindings and builds a set of supertypes+type PathT m = RWST R () S m++instance DsMonad m => HasVisitedMap (RWST R () S m) where+    unvisited typ action = do+      typ' <- expandType typ+      c <- Set.member typ' <$> use visited+      case c of+        False -> do+          visited %= Set.insert typ'+          action+        _ -> pure ()++instance DsMonad m => HasTypeTraversal (RWST R () S m) where+    prepType = return+    doTypeInternal = \typ -> message 1 ("doTypeInternal " ++ show typ) >> local (over prefix' (++ " ")) (doApply typ typ)+    doListT = \typ0 etyp -> message 1 ("doListT " ++ pprint1 typ0) >> doType etyp+    doTupleT = \_ etyp _ -> message 1 ("doTupleT " ++ show etyp) >> doType etyp+    doField = \_t0 _ fi@(FieldInfo {..})  -> message 1 ("doField " ++ show fi) >> doType _fieldType+    doVarT = \_ name -> message 1 ("doVarT " ++ show name) >> result %= Set.insert (VarT name)++nonPhantom :: DsMonad m => Name -> m [Type]+nonPhantom tname =+    runQ (reify tname) >>= go+    where+      go :: DsMonad m => Info -> m [Type]+      go (TyConI (DataD _cx _tname binds _cons _supers)) = mapM (runQ . varT . toName) binds >>= go'+      go (TyConI (NewtypeD _cx _tname binds _con _supers)) = mapM (runQ . varT . toName) binds >>= go'+      go (TyConI (TySynD _tname binds _typ)) = mapM (runQ . varT . toName) binds >>= go'+      go' :: DsMonad m => [Type] -> m [Type]+      go' ps =+          (Set.toList . view (_1 . result)) <$>+            execRWST (go'' (ConT tname))+              (R {_params = ps, _verbosity = 0, _prefix = "  "})+              (S {_result = Set.empty, _visited = mempty})+      go'' :: DsMonad m => Type -> RWST R () S m ()+      go'' = doType++-- λ> $([t|forall u key proxy s. SPath u key proxy s|] >>= nonPhantom >>= lift . fmap pprint)+-- ["key_0","proxy_0"]
+ src/Language/Haskell/TH/TypeGraph/SafeCopyDerive.hs view
@@ -0,0 +1,469 @@+{-# LANGUAGE TemplateHaskell, CPP #-}++-- Hack for bug in older Cabal versions+#ifndef MIN_VERSION_template_haskell+#define MIN_VERSION_template_haskell(x,y,z) 1+#endif++module Language.Haskell.TH.TypeGraph.SafeCopyDerive where++import Language.Haskell.TH.TypeGraph.Phantom (nonPhantom)+import Data.Serialize (getWord8, putWord8, label)+import Data.SafeCopy++#if MIN_VERSION_template_haskell(2,8,0)+import Language.Haskell.TH hiding (Kind)+#else+import Language.Haskell.TH hiding (Kind(..))+#endif+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif+import Control.Monad+import Data.Maybe (fromMaybe)+#ifdef __HADDOCK__+import Data.Word (Word8) -- Haddock+#endif+import Data.Int (Int32)++-- | FIXME - Bogus reimplementation of the hidden+-- Data.SafeCopy.unVersion function+unVersion :: Version a -> Int32+unVersion v = read (takeWhile (/= '}') (drop 21 (show v)))++-- | Derive an instance of 'SafeCopy'.+--+--   When serializing, we put a 'Word8' describing the+--   constructor (if the data type has more than one+--   constructor).  For each type used in the constructor, we+--   call 'getSafePut' (which immediately serializes the version+--   of the type).  Then, for each field in the constructor, we+--   use one of the put functions obtained in the last step.+--+--   For example, given the data type and the declaration below+--+--   @+--data T0 b = T0 b Int+--deriveSafeCopy 1 'base ''T0+--   @+--+--   we generate+--+--   @+--instance (SafeCopy a, SafeCopy b) =>+--         SafeCopy (T0 b) where+--    putCopy (T0 arg1 arg2) = contain $ do put_b   <- getSafePut+--                                          put_Int <- getSafePut+--                                          put_b   arg1+--                                          put_Int arg2+--                                          return ()+--    getCopy = contain $ do get_b   <- getSafeGet+--                           get_Int <- getSafeGet+--                           return T0 \<*\> get_b \<*\> get_Int+--    version = 1+--    kind = base+--   @+--+--   And, should we create another data type as a newer version of @T0@, such as+--+--   @+--data T a b = C a a | D b Int+--deriveSafeCopy 2 'extension ''T+--+--instance SafeCopy b => Migrate (T a b) where+--  type MigrateFrom (T a b) = T0 b+--  migrate (T0 b i) = D b i+--   @+--+--   we generate+--+--   @+--instance (SafeCopy a, SafeCopy b) =>+--         SafeCopy (T a b) where+--    putCopy (C arg1 arg2) = contain $ do putWord8 0+--                                         put_a <- getSafePut+--                                         put_a arg1+--                                         put_a arg2+--                                         return ()+--    putCopy (D arg1 arg2) = contain $ do putWord8 1+--                                         put_b   <- getSafePut+--                                         put_Int <- getSafePut+--                                         put_b   arg1+--                                         put_Int arg2+--                                         return ()+--    getCopy = contain $ do tag <- getWord8+--                           case tag of+--                             0 -> do get_a <- getSafeGet+--                                     return C \<*\> get_a \<*\> get_a+--                             1 -> do get_b   <- getSafeGet+--                                     get_Int <- getSafeGet+--                                     return D \<*\> get_b \<*\> get_Int+--                             _ -> fail $ \"Could not identify tag \\\"\" +++--                                         show tag ++ \"\\\" for type Main.T \" +++--                                         \"that has only 2 constructors.  \" +++--                                         \"Maybe your data is corrupted?\"+--    version = 2+--    kind = extension+--   @+--+--   Note that by using getSafePut, we saved 4 bytes in the case+--   of the @C@ constructor.  For @D@ and @T0@, we didn't save+--   anything.  The instance derived by this function always use+--   at most the same space as those generated by+--   'deriveSafeCopySimple', but never more (as we don't call+--   'getSafePut'/'getSafeGet' for types that aren't needed).+--+--   Note that you may use 'deriveSafeCopySimple' with one+--   version of your data type and 'deriveSafeCopy' in another+--   version without any problems.+deriveSafeCopy :: Version a -> Name -> Name -> Q [Dec]+deriveSafeCopy = internalDeriveSafeCopy Normal++deriveSafeCopyIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]+deriveSafeCopyIndexedType = internalDeriveSafeCopyIndexedType Normal++-- | Derive an instance of 'SafeCopy'.  The instance derived by+--   this function is simpler than the one derived by+--   'deriveSafeCopy' in that we always use 'safePut' and+--   'safeGet' (instead of 'getSafePut' and 'getSafeGet').+--+--   When serializing, we put a 'Word8' describing the+--   constructor (if the data type has more than one constructor)+--   and, for each field of the constructor, we use 'safePut'.+--+--   For example, given the data type and the declaration below+--+--   @+--data T a b = C a a | D b Int+--deriveSafeCopySimple 1 'base ''T+--   @+--+--   we generate+--+--   @+--instance (SafeCopy a, SafeCopy b) =>+--         SafeCopy (T a b) where+--    putCopy (C arg1 arg2) = contain $ do putWord8 0+--                                         safePut arg1+--                                         safePut arg2+--                                         return ()+--    putCopy (D arg1 arg2) = contain $ do putWord8 1+--                                         safePut arg1+--                                         safePut arg2+--                                         return ()+--    getCopy = contain $ do tag <- getWord8+--                           case tag of+--                             0 -> do return C \<*\> safeGet \<*\> safeGet+--                             1 -> do return D \<*\> safeGet \<*\> safeGet+--                             _ -> fail $ \"Could not identify tag \\\"\" +++--                                         show tag ++ \"\\\" for type Main.T \" +++--                                         \"that has only 2 constructors.  \" +++--                                         \"Maybe your data is corrupted?\"+--    version = 1+--    kind = base+--   @+--+--   Using this simpler instance means that you may spend more+--   bytes when serializing data.  On the other hand, it is more+--   straightforward and may match any other format you used in+--   the past.+--+--   Note that you may use 'deriveSafeCopy' with one version of+--   your data type and 'deriveSafeCopySimple' in another version+--   without any problems.+deriveSafeCopySimple :: Version a -> Name -> Name -> Q [Dec]+deriveSafeCopySimple = internalDeriveSafeCopy Simple++deriveSafeCopySimpleIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]+deriveSafeCopySimpleIndexedType = internalDeriveSafeCopyIndexedType Simple++-- | Derive an instance of 'SafeCopy'.  The instance derived by+--   this function should be compatible with the instance derived+--   by the module @Happstack.Data.SerializeTH@ of the+--   @happstack-data@ package.  The instances use only 'safePut'+--   and 'safeGet' (as do the instances created by+--   'deriveSafeCopySimple'), but we also always write a 'Word8'+--   tag, even if the data type isn't a sum type.+--+--   For example, given the data type and the declaration below+--+--   @+--data T0 b = T0 b Int+--deriveSafeCopy 1 'base ''T0+--   @+--+--   we generate+--+--   @+--instance (SafeCopy a, SafeCopy b) =>+--         SafeCopy (T0 b) where+--    putCopy (T0 arg1 arg2) = contain $ do putWord8 0+--                                          safePut arg1+--                                          safePut arg2+--                                          return ()+--    getCopy = contain $ do tag <- getWord8+--                           case tag of+--                             0 -> do return T0 \<*\> safeGet \<*\> safeGet+--                             _ -> fail $ \"Could not identify tag \\\"\" +++--                                         show tag ++ \"\\\" for type Main.T0 \" +++--                                         \"that has only 1 constructors.  \" +++--                                         \"Maybe your data is corrupted?\"+--    version = 1+--    kind = base+--   @+--+--   This instance always consumes at least the same space as+--   'deriveSafeCopy' or 'deriveSafeCopySimple', but may use more+--   because of the useless tag.  So we recomend using it only if+--   you really need to read a previous version in this format,+--   and not for newer versions.+--+--   Note that you may use 'deriveSafeCopy' with one version of+--   your data type and 'deriveSafeCopyHappstackData' in another version+--   without any problems.+deriveSafeCopyHappstackData :: Version a -> Name -> Name -> Q [Dec]+deriveSafeCopyHappstackData = internalDeriveSafeCopy HappstackData++deriveSafeCopyHappstackDataIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]+deriveSafeCopyHappstackDataIndexedType = internalDeriveSafeCopyIndexedType HappstackData++data DeriveType = Normal | Simple | HappstackData++forceTag :: DeriveType -> Bool+forceTag HappstackData = True+forceTag _             = False++tyVarName :: TyVarBndr -> Name+tyVarName (PlainTV n) = n+#if MIN_VERSION_template_haskell(2,10,0)+tyVarName (KindedTV n _) = n+#endif++internalDeriveSafeCopy :: DeriveType -> Version a -> Name -> Name -> Q [Dec]+internalDeriveSafeCopy deriveType versionId kindName tyName = do+  info <- reify tyName+  internalDeriveSafeCopy' deriveType versionId kindName tyName info++internalDeriveSafeCopy' :: DeriveType -> Version a -> Name -> Name -> Info -> Q [Dec]+internalDeriveSafeCopy' deriveType versionId kindName tyName info = do+  case info of+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD context _name tyvars _kind cons _derivs)+#else+    TyConI (DataD context _name tyvars cons _derivs)+#endif+      | length cons > 255 -> fail $ "Can't derive SafeCopy instance for: " ++ show tyName +++                                    ". The datatype must have less than 256 constructors."+      | otherwise         -> worker context tyvars (zip [0..] cons)++#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (NewtypeD context _name tyvars _kind con _derivs) ->+#else+    TyConI (NewtypeD context _name tyvars con _derivs) ->+#endif+      worker context tyvars [(0, con)]++    FamilyI _ insts -> do+      decs <- forM insts $ \inst ->+        case inst of+#if MIN_VERSION_template_haskell(2,11,0)+          DataInstD context _name ty _kind cons _derivs ->+#else+          DataInstD context _name ty cons _derivs ->+#endif+              worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons)++#if MIN_VERSION_template_haskell(2,11,0)+          NewtypeInstD context _name ty _kind con _derivs ->+#else+          NewtypeInstD context _name ty con _derivs ->+#endif+              worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)]+          _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, inst)+      return $ concat decs+    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info)+  where+    worker = worker' (conT tyName)+    worker' tyBase context tyvars cons =+      nonPhantom tyName >>= \tyvars' ->+      let ty = foldl appT tyBase [ varT $ tyVarName var | var <- tyvars ]+#if MIN_VERSION_template_haskell(2,10,0)+          safeCopyClass args = foldl appT (conT ''SafeCopy) args+#else+          safeCopyClass args = classP ''SafeCopy args+#endif+      in (:[]) <$> instanceD (cxt $ [safeCopyClass [varT $ var] | VarT var <- tyvars'] ++ map return context)+                                       (conT ''SafeCopy `appT` ty)+                                       [ mkPutCopy deriveType cons+                                       , mkGetCopy deriveType (show tyName) cons+                                       , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) []+                                       , valD (varP 'kind) (normalB (varE kindName)) []+                                       , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL (show tyName)) []]+                                       ]++internalDeriveSafeCopyIndexedType :: DeriveType -> Version a -> Name -> Name -> [Name] -> Q [Dec]+internalDeriveSafeCopyIndexedType deriveType versionId kindName tyName tyIndex' = do+  info <- reify tyName+  internalDeriveSafeCopyIndexedType' deriveType versionId kindName tyName tyIndex' info++internalDeriveSafeCopyIndexedType' :: DeriveType -> Version a -> Name -> Name -> [Name] -> Info -> Q [Dec]+internalDeriveSafeCopyIndexedType' deriveType versionId kindName tyName tyIndex' info = do+  tyIndex <- mapM conT tyIndex'+  case info of+    FamilyI _ insts -> do+      decs <- forM insts $ \inst ->+        case inst of+#if MIN_VERSION_template_haskell(2,11,0)+          DataInstD context _name ty _kind cons _derivs+#else+          DataInstD context _name ty cons _derivs+#endif+            | ty == tyIndex ->+              worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons)+            | otherwise ->+              return []++#if MIN_VERSION_template_haskell(2,11,0)+          NewtypeInstD context _name ty _kind con _derivs+#else+          NewtypeInstD context _name ty con _derivs+#endif+            | ty == tyIndex ->+              worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)]+            | otherwise ->+              return []+          _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, inst)+      return $ concat decs+    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info)+  where+    typeNameStr = unwords $ map show (tyName:tyIndex')+    worker' tyBase context tyvars cons =+      let ty = foldl appT tyBase [ varT $ tyVarName var | var <- tyvars ]+#if MIN_VERSION_template_haskell(2,10,0)+          safeCopyClass args = foldl appT (conT ''SafeCopy) args+#else+          safeCopyClass args = classP ''SafeCopy args+#endif+      in (:[]) <$> instanceD (cxt $ [safeCopyClass [varT $ tyVarName var] | var <- tyvars] ++ map return context)+                                       (conT ''SafeCopy `appT` ty)+                                       [ mkPutCopy deriveType cons+                                       , mkGetCopy deriveType typeNameStr cons+                                       , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) []+                                       , valD (varP 'kind) (normalB (varE kindName)) []+                                       , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL typeNameStr) []]+                                       ]++mkPutCopy :: DeriveType -> [(Integer, Con)] -> DecQ+mkPutCopy deriveType cons = funD 'putCopy $ map mkPutClause cons+    where+      manyConstructors = length cons > 1 || forceTag deriveType+      mkPutClause (conNumber, con)+          = do putVars <- mapM (\n -> newName ("a" ++ show n)) [1..conSize con]+               (putFunsDecs, putFuns) <- case deriveType of+                                           Normal -> mkSafeFunctions "safePut_" 'getSafePut con+                                           _      -> return ([], const 'safePut)+               let putClause   = conP (conName con) (map varP putVars)+                   putCopyBody = varE 'contain `appE` doE (+                                   [ noBindS $ varE 'putWord8 `appE` litE (IntegerL conNumber) | manyConstructors ] +++                                   putFunsDecs +++                                   [ noBindS $ varE (putFuns typ) `appE` varE var | (typ, var) <- zip (conTypes con) putVars ] +++                                   [ noBindS $ varE 'return `appE` tupE [] ])+               clause [putClause] (normalB putCopyBody) []++mkGetCopy :: DeriveType -> String -> [(Integer, Con)] -> DecQ+mkGetCopy deriveType tyName cons = valD (varP 'getCopy) (normalB $ varE 'contain `appE` mkLabel) []+    where+      mkLabel = varE 'label `appE` litE (stringL labelString) `appE` getCopyBody+      labelString = tyName ++ ":"+      getCopyBody+          = case cons of+              [(_, con)] | not (forceTag deriveType) -> mkGetBody con+              _ -> do+                tagVar <- newName "tag"+                doE [ bindS (varP tagVar) (varE 'getWord8)+                    , noBindS $ caseE (varE tagVar) (+                        [ match (litP $ IntegerL i) (normalB $ mkGetBody con) [] | (i, con) <- cons ] +++                        [ match wildP (normalB $ varE 'fail `appE` errorMsg tagVar) [] ]) ]+      mkGetBody con+          = do (getFunsDecs, getFuns) <- case deriveType of+                                           Normal -> mkSafeFunctions "safeGet_" 'getSafeGet con+                                           _      -> return ([], const 'safeGet)+               let getBase = appE (varE 'return) (conE (conName con))+                   getArgs = foldl (\a t -> infixE (Just a) (varE '(<*>)) (Just (varE (getFuns t)))) getBase (conTypes con)+               doE (getFunsDecs ++ [noBindS getArgs])+      errorMsg tagVar = infixE (Just $ strE str1) (varE '(++)) $ Just $+                        infixE (Just tagStr) (varE '(++)) (Just $ strE str2)+          where+            strE = litE . StringL+            tagStr = varE 'show `appE` varE tagVar+            str1 = "Could not identify tag \""+            str2 = concat [ "\" for type "+                          , show tyName+                          , " that has only "+                          , show (length cons)+                          , " constructors.  Maybe your data is corrupted?" ]++mkSafeFunctions :: String -> Name -> Con -> Q ([StmtQ], Type -> Name)+mkSafeFunctions name baseFun con = do let origTypes = conTypes con+                                      realTypes <- mapM followSynonyms origTypes+                                      finish (zip origTypes realTypes) <$> foldM go ([], []) realTypes+    where go (ds, fs) t+              | found     = return (ds, fs)+              | otherwise = do funVar <- newName (name ++ typeName t)+                               return ( bindS (varP funVar) (varE baseFun) : ds+                                      , (t, funVar) : fs )+              where found = any ((== t) . fst) fs+          finish+            :: [(Type, Type)]            -- "dictionary" from synonyms(or not) to real types+            -> ([StmtQ], [(Type, Name)]) -- statements+            -> ([StmtQ], Type -> Name)   -- function body and name-generator+          finish typeList (ds, fs) = (reverse ds, getName)+              where getName typ = fromMaybe err $ lookup typ typeList >>= flip lookup fs+                    err = error "mkSafeFunctions: never here"++-- | Follow type synonyms.  This allows us to see, for example,+-- that @[Char]@ and @String@ are the same type and we just need+-- to call 'getSafePut' or 'getSafeGet' once for both.+followSynonyms :: Type -> Q Type+followSynonyms t@(ConT name)+    = maybe (return t) followSynonyms =<<+      recover (return Nothing) (do info <- reify name+                                   return $ case info of+                                              TyVarI _ ty            -> Just ty+                                              TyConI (TySynD _ _ ty) -> Just ty+                                              _                      -> Nothing)+followSynonyms (AppT ty1 ty2) = liftM2 AppT (followSynonyms ty1) (followSynonyms ty2)+followSynonyms (SigT ty k)    = liftM (flip SigT k) (followSynonyms ty)+followSynonyms t              = return t++conSize :: Con -> Int+conSize (NormalC _name args) = length args+conSize (RecC _name recs)    = length recs+conSize InfixC{}             = 2+conSize ForallC{}            = error "Found constructor with existentially quantified binder. Cannot derive SafeCopy for it."+#if MIN_VERSION_template_haskell(2,11,0)+conSize GadtC{}              = error "Found GADT constructor. Cannot derive SafeCopy for it."+conSize RecGadtC{}           = error "Found GADT constructor. Cannot derive SafeCopy for it."+#endif++conName :: Con -> Name+conName (NormalC name _args) = name+conName (RecC name _recs)    = name+conName (InfixC _ name _)    = name+conName _                    = error "conName: never here"++conTypes :: Con -> [Type]+conTypes (NormalC _name args)       = [t | (_, t)    <- args]+conTypes (RecC _name args)          = [t | (_, _, t) <- args]+conTypes (InfixC (_, t1) _ (_, t2)) = [t1, t2]+conTypes _                          = error "conName: never here"++typeName :: Type -> String+typeName (VarT name) = nameBase name+typeName (ConT name) = nameBase name+typeName (TupleT n)  = "Tuple" ++ show n+typeName ArrowT      = "Arrow"+typeName ListT       = "List"+typeName (AppT t u)  = typeName t ++ typeName u+typeName (SigT t _k) = typeName t+typeName _           = "_"
+ src/Language/Haskell/TH/TypeGraph/TypeTraversal.hs view
@@ -0,0 +1,254 @@+-- | Build a directed graph whose nodes are arity zero types and whose+-- edges represent the hops in the path graph.++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS -Wall #-}++module Language.Haskell.TH.TypeGraph.TypeTraversal+    ( HasVisitedMap(..)+    , doType+    , HasTypeParameters(..)+    , withBindings+    , HasTypeTraversal(..)+    , doApply+    , FieldInfo(..)+    , expandType, pprint1, pprint1', pprintW, pprintW'+    , ToName(toName)+    , HasMessageInfo(..), message, indent+    ) where++import Control.Lens (Lens', view)+import Control.Monad.RWS as Monad hiding (lift)+import Data.Generics (Data, everywhere, mkT)+import Data.List (intercalate)+import Data.Map.Strict as Map (Map, lookup)+import qualified Data.Map.Strict as Map (fromList)+-- import Debug.Trace+import Instances.TH.Lift ()+import Language.Haskell.TH hiding (prim)+import Language.Haskell.TH.Desugar as DS (DsMonad, typeToTH, dsType, expand)+import Language.Haskell.TH.PprLib (to_HPJ_Doc)+import Language.Haskell.TH.Syntax as TH+import Language.Haskell.TH.TypeGraph.Orphans ()+import qualified Text.PrettyPrint as HPJ++class Monad m => HasTypeParameters m where+    pushParam :: Type -> m a -> m a -- ^ Push a parameter+    withParams :: ([Type] -> m ()) -> m ()++data FieldInfo+    = FieldInfo+      { _typeName :: Name+      , _constrCount :: Int+      , _constrIndex :: Int+      , _constrName :: Name+      , _fieldCount :: Int+      , _fieldIndex :: Int+      , _fieldName :: Maybe Name+      , _fieldType :: Type+      } deriving Show++class (DsMonad m, HasVisitedMap m) => HasTypeTraversal m where+    prepType :: Type -> m Type+    -- ^ Normally just 'return', this can modify the types during the+    -- traversal.+    doTypeInternal :: Type -> m ()+    -- ^ This is passed every type that is encountered.  The methods+    -- below are called from doApply.+    doListT :: Type -> Type -> m ()+    -- ^ When a ListT type is encountered this is passed the type and+    -- the element type+    doTupleT :: Type -> Type -> Int -> m ()+    -- ^ When a TupleT type is encountered this is called once for+    -- each element, with the type, element type, and element+    -- position.+    doField :: Type -> (Type -> Type) -> FieldInfo -> m ()+    -- ^ When a field is encountered this is called with all the+    -- field info - type name, constructor count/position/name,+    -- field count/position/type/maybe name.+    doVarT :: Type -> Name -> m ()+    -- ^ Called when a type variable is encountered.++doType :: HasTypeTraversal m => Type -> m ()+doType typ = prepType typ >>= doTypeOnce doTypeInternal++class DsMonad m => HasVisitedMap m where+    unvisited :: Type -> m () -> m () -- ^ Perform action if type has not been visted++doTypeOnce :: HasVisitedMap m => (Type -> m ()) -> Type -> m ()+doTypeOnce go typ = unvisited typ (go typ)++doApply :: (HasTypeTraversal m, HasTypeParameters m, DsMonad m) => Type -> Type -> m ()+doApply typ0 (ForallT tvs cxt typ) = doApply typ0 typ+doApply typ0 (VarT name) = doVarT typ0 name+doApply typ0 (AppT a b) = pushParam b (doApply typ0 a)+doApply typ0 (ConT tname) = qReify tname >>= doInfo typ0+doApply typ0 ListT = do+  withParams $ \ps -> do+    case ps of+      [a] -> doListT typ0 a+      _ -> error $ "ListT Arity error: "+doApply typ0 typ@(TupleT n) = do+  withParams $ \ps -> do+    when (length ps /= n) (error $ "Tuple Arity error: " +++                                   pprint1 typ +++                                   " [" ++ intercalate ", " (fmap pprint1 ps) ++ "]")+    mapM_ (uncurry (doTupleT typ0)) (zip ps [1..])+doApply typ0 _ = do+  error $ "doApply - unexpected type: " ++ pprint1 typ0++doInfo :: (DsMonad m, HasTypeParameters m, HasTypeTraversal m) => Type -> Info -> m ()+doInfo _typ0 (PrimTyConI _name _arity _unl) = pure ()+doInfo _typ0 (TyConI (TySynD _tname binds typ)) =+    runQ (expandType typ) >>= \typ' ->+    withBindings (\subst -> doType (subst typ')) binds+#if MIN_VERSION_template_haskell(2,11,0)+doInfo typ0 (TyConI (NewtypeD cx tname binds mk con supers)) =+    doInfo typ0 (TyConI (DataD cx tname binds mk [con] supers))+doInfo typ0 (TyConI (DataD _ tname binds _mk cons _supers)) =+    withBindings (\subst -> do mapM_ (uncurry (doCon typ0 tname subst (length cons))) (zip [1..] cons)) binds+#else+doInfo typ0 (TyConI (NewtypeD cx tname binds con supers)) =+    doInfo typ0 (TyConI (DataD cx tname binds [con] supers))+doInfo typ0 (TyConI (DataD _ tname binds cons _supers)) =+    withBindings (\subst -> do mapM_ (uncurry (doCon typ0 tname subst (length cons))) (zip [1..] cons)) binds+#endif+doInfo _ info = error $ "Unexpected info: " ++ pprint1 info ++ "\n\t" ++ show info++doCon :: (HasTypeParameters m, HasTypeTraversal m) => Type -> Name -> (Type -> Type) -> Int -> Int -> Con -> m ()+doCon typ0 tname subst cct cpos (ForallC _ _ con) = doCon typ0 tname subst cct cpos con+doCon typ0 tname subst cct cpos (RecC cname vsts) =+  mapM_ (\(i, (fname, _, ftype)) ->+             expandType ftype >>= \ftype' ->+             let fld = FieldInfo { _typeName = tname+                                 , _constrCount = cct+                                 , _constrIndex = cpos+                                 , _constrName = cname+                                 , _fieldCount = length vsts+                                 , _fieldIndex = i+                                 , _fieldName = Just fname+                                 , _fieldType = subst ftype' } in+             doField typ0 subst fld) (zip [1..] vsts)+doCon typ0 tname subst cct cpos con@(NormalC cname sts) =+  mapM_ (\(i, (_, ftype)) ->+             expandType ftype >>= \ftype' ->+             let fld = FieldInfo { _typeName = tname+                                 , _constrCount = cct+                                 , _constrIndex = cpos+                                 , _constrName = cname+                                 , _fieldCount = length sts+                                 , _fieldIndex = i+                                 , _fieldName = Nothing+                                 , _fieldType = subst ftype' } in+             doField typ0 subst fld) (zip [1..] sts)+doCon typ0 tname subst cct cpos (InfixC lhs cname rhs) =+  mapM_ (\(i, (_, ftype)) ->+             expandType ftype >>= \ftype' ->+             let  fld = FieldInfo { _typeName = tname+                                  , _constrCount = cct+                                  , _constrIndex = cpos+                                  , _constrName = cname+                                  , _fieldCount = 2+                                  , _fieldIndex = i+                                  , _fieldName = Nothing+                                  , _fieldType = subst ftype' } in+             doField typ0 subst fld) [(1, lhs), (2, rhs)]++-- | Input is a list of type variable bindings (such as those+-- appearing in a Dec) and the current stack of type parameters+-- applied by AppT.  Builds a function that expands a type using those+-- bindings and pass it to an action.+withBindings :: (HasTypeParameters m, Data a) => ((a -> a) -> m ()) -> [TyVarBndr] -> m ()+withBindings action vars = do+  withParams $ \vals -> do+    when (length vals < length vars)+      (error $ "doInfo - arity mismatch:\n\tvars=" ++ show vars +++               "\n\tparams=" ++ show vals)+    let subst :: forall a. Data a => a -> a+        subst = substG bindings+        bindings = Map.fromList (zip (fmap toName vars) ({-fmap subst-} vals :: [Type]))+    action subst+    where+      substG :: forall a. Data a => Map Name Type -> a -> a+      substG bindings typ = everywhere (mkT (subst1 bindings)) typ++      subst1 :: Map Name Type -> Type -> Type+      subst1 bindings t@(VarT name) = maybe t id (Map.lookup name bindings)+      subst1 _ t = t++-- | 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.  (If the data type+-- has no 'Name' values the friendlyNames function has no effect.)+pprint1 :: (Ppr a, Data a) => a -> [Char]+pprint1 = pprint1' . friendlyNames++pprint1' :: Ppr a => a -> [Char]+pprint1' = pprintStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode})++-- | Pretty print with friendly names and wide lines+pprintW :: (Ppr a, Data a) => Int -> a -> [Char]+pprintW w = pprintW' w . friendlyNames++pprintW' :: Ppr a => Int -> a -> [Char]+pprintW' w = pprintStyle (HPJ.style {HPJ.lineLength = w})++-- | Helper function for pprint1 et. al.+pprintStyle :: Ppr a => HPJ.Style -> a -> String+pprintStyle style = HPJ.renderStyle style . to_HPJ_Doc . ppr++-- | Make a template haskell value more human reader friendly.  The+-- result almost certainly won't be compilable.  That's ok, though,+-- because the input is usually uncompilable - it imports hidden modules,+-- uses infix operators in invalid positions, puts module qualifiers in+-- places where they are not allowed, and maybe other things.+friendlyNames :: Data a => a -> a+friendlyNames =+    everywhere (mkT friendlyName)+    where+      friendlyName (Name x _) = Name x NameS -- Remove all module qualifiers++expandType :: DsMonad m  => Type -> m Type+expandType typ = DS.typeToTH <$> (DS.dsType typ >>= DS.expand)++-- | Copied from haskell-src-meta+class ToName a where toName :: a -> Name++instance ToName TyVarBndr where+  toName (PlainTV n) = n+  toName (KindedTV n _) = n++instance ToName Con where+    toName (ForallC _ _ con) = toName con+    toName (NormalC cname _) = cname+    toName (RecC cname _) = cname+    toName (InfixC _ cname _) = cname++instance ToName VarStrictType where+  toName (n, _, _) = n++class HasMessageInfo a where+    verbosity' :: Lens' a Int+    prefix' :: Lens' a String++-- | Output a verbosity controlled error message with the current+-- indentation.+message :: (Quasi m, MonadReader s m, HasMessageInfo s) =>+           Int -> String -> m ()+message minv s = do+    v <- view verbosity'+    p <- view prefix'+    when (v >= minv) $ (runQ . runIO . putStr . indent p) s++-- | Indent the lines of a message.+indent :: String -> String -> String+indent p s = unlines $ fmap (p ++) (lines s)
+ src/Language/Haskell/TH/TypeGraph/WebRoutesTH.hs view
@@ -0,0 +1,188 @@+-- | Modified version of Web.Routes.TH++{-# LANGUAGE CPP, TemplateHaskell #-}+module Language.Haskell.TH.TypeGraph.WebRoutesTH+     ( derivePathInfo+     , derivePathInfo'+     , standard+     , mkRoute+     ) where++import Control.Applicative           ((<$>))+import Control.Monad                 (ap, replicateM)+import Data.Char                     (isUpper, toLower, toUpper)+import Data.List                     (intercalate, foldl')+import Data.List.Split               (split, dropInitBlank, keepDelimsL, whenElt)+import Data.Text                     (pack, unpack)+import Debug.Trace+import Language.Haskell.TH+import Language.Haskell.TH.Syntax    (nameBase)+import Language.Haskell.TH.TypeGraph.Phantom             (nonPhantom)+import Text.ParserCombinators.Parsec ((<|>),many1)+import Web.Routes.PathInfo++-- | use Template Haskell to create 'PathInfo' instances for a type.+--+-- > $(derivePathInfo ''SiteURL)+--+-- Uses the 'standard' formatter by default.+derivePathInfo :: Name+               -> Q [Dec]+derivePathInfo = derivePathInfo' standard++-- FIXME: handle when called with a type (not data, newtype)++-- | use Template Haskell to create 'PathInfo' instances for a type.+--+-- This variant allows the user to supply a function that transforms+-- the constructor name to a prettier rendering. It is important that+-- the transformation function generates a unique output for each+-- input. For example, simply converting the string to all lower case+-- is not acceptable, because then 'FooBar' and 'Foobar' would be+-- indistinguishable.+--+-- > $(derivePathInfo' standard ''SiteURL)+--+-- see also: 'standard'+derivePathInfo' :: (String -> String)+                -> Name+                -> Q [Dec]+derivePathInfo' formatter name+    = do c <- parseInfo name+         case c of+           Tagged cons cx keys ->+               do keys' <- nonPhantom name+                  -- trace ("nonPhantom " ++ show name ++ " -> " ++ show keys') (pure ())+                  let context = [ mkCtx ''PathInfo [pure key] | key <- keys' ] ++ map return cx+                  i <- instanceD (sequence context) (mkType ''PathInfo [mkType name (map varT keys)])+                       [ toPathSegmentsFn cons+                       , fromPathSegmentsFn cons+                       ]+                  return [i]+    where+#if MIN_VERSION_template_haskell(2,4,0)+      mkCtx = classP+#else+      mkCtx = mkType+#endif+      toPathSegmentsFn :: [(Name, Int)] -> DecQ+      toPathSegmentsFn cons+          = do inp <- newName "inp"+               let body = caseE (varE inp) $+                            [ do args <- replicateM nArgs (newName "arg")+                                 let matchCon = conP conName (map varP args)+                                     conStr = formatter (nameBase conName)+                                 match matchCon (normalB (toURLWork conStr args)) []+                                  |  (conName, nArgs) <- cons ]+                   toURLWork :: String -> [Name] -> ExpQ+                   toURLWork conStr args+                       = foldr1 (\a b -> appE (appE [| (++) |] a) b) ([| [pack conStr] |] : [ [| toPathSegments $(varE arg) |] | arg <- args ])+               funD 'toPathSegments [clause [varP inp] (normalB body)  []]+      fromPathSegmentsFn :: [(Name,Int)] -> DecQ+      fromPathSegmentsFn cons+          = do let body = (foldl1 (\a b -> appE (appE [| (<|>) |] a) b)+                            [ parseCon conName nArgs+                            | (conName, nArgs) <- cons])+                   parseCon :: Name -> Int -> ExpQ+                   parseCon conName nArgs = foldl1 (\a b -> appE (appE [| ap |] a) b)+                                                   ([| segment (pack $(stringE (formatter $ nameBase conName))) >> return $(conE conName) |]+                                                   : (replicate nArgs [| fromPathSegments |]))+               funD 'fromPathSegments [clause [] (normalB body) []]++mkType :: Name -> [TypeQ] -> TypeQ+mkType con = foldl appT (conT con)++data Class = Tagged [(Name, Int)] Cxt [Name]++parseInfo :: Name -> Q Class+parseInfo name+    = do info <- reify name+         case info of+#if MIN_VERSION_template_haskell(2,11,0)+           TyConI (DataD cx _ keys _ cs _)    -> return $ Tagged (map conInfo cs) cx $ map conv keys+           TyConI (NewtypeD cx _ keys _ con _)-> return $ Tagged [conInfo con] cx $ map conv keys+#else+           TyConI (DataD cx _ keys cs _)    -> return $ Tagged (map conInfo cs) cx $ map conv keys+           TyConI (NewtypeD cx _ keys con _)-> return $ Tagged [conInfo con] cx $ map conv keys+#endif+           _                                ->  error $ "derivePathInfo - invalid input: " ++ pprint info+    where conInfo (NormalC n args) = (n, length args)+          conInfo (RecC n args) = (n, length args)+          conInfo (InfixC _ n _) = (n, 2)+          conInfo (ForallC _ _ con) = conInfo con+#if MIN_VERSION_template_haskell(2,4,0)+          conv (PlainTV nm) = nm+          conv (KindedTV nm _) = nm+#else+          conv = id+#endif++-- | the standard formatter+--+-- Converts @CamelCase@ to @camel-case@.+--+-- see also: 'derivePathInfo' and 'derivePathInfo''+standard :: String -> String+standard =+    intercalate "-" . map (map toLower) . split splitter+  where+    splitter = dropInitBlank . keepDelimsL . whenElt $ isUpper++mkRoute :: Name -> Q [Dec]+mkRoute url =+    do (Tagged cons _ _) <- parseInfo url+       fn <- funD (mkName "route") $+               map (\(con, numArgs) ->+                        do -- methods <- parseMethods con+                           -- runIO $ print methods+                           args <- replicateM numArgs (newName "arg")+                           clause [conP con $ map varP args] (normalB $ foldl' appE (varE (mkName (headLower (nameBase con)))) (map varE args)) []+                   ) cons+       return [fn]+    where+      headLower :: String -> String+      headLower (c:cs) = toLower c : cs++-- work in progress++parseMethods :: Name -> Q [Name]+parseMethods con =+    do info <- reify con+       case info of+#if MIN_VERSION_template_haskell(2,11,0)+         (DataConI _ ty _) ->+#else+         (DataConI _ ty _ _) ->+#endif+             do runIO $ print ty+                runIO $ print $ lastTerm ty+                return $ extractMethods (lastTerm ty)++extractMethods :: Type -> [Name]+extractMethods ty =+    case ty of+      (AppT (ConT con) (ConT method)) ->+          [method]+      (AppT (ConT con) methods) ->+          extractMethods' methods+        where+          extractMethods' :: Type -> [Name]+          extractMethods' t = map (\(ConT n) -> n) (leafs t)++-- | return the 'Type' after the right-most @->@. Or the original 'Type' if there are no @->@.+lastTerm :: Type -> Type+lastTerm t@(AppT l r)+    | hasArrowT l = lastTerm r+    | otherwise   = t+lastTerm t = t++-- | tests if a 'Type' contains an 'ArrowT' somewhere+hasArrowT :: Type -> Bool+hasArrowT ArrowT     = True+hasArrowT (AppT l r) = hasArrowT l || hasArrowT r+hasArrowT _          = False++leafs :: Type -> [Type]+leafs (AppT l@(AppT _ _) r) = leafs l ++ leafs r+leafs (AppT _ r) = leafs r+leafs t          = [t]
− test/Common.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, TemplateHaskell #-}-module Common where--import Control.Applicative ((<$>))-import Control.Lens (view)-import Control.Monad.Readers (MonadReaders, ReaderT)-import Control.Monad.States (MonadStates)-import Data.Default (Default)-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, map, null, toList, union)-import Data.Generics (Data, everywhere, mkT)-import Language.Haskell.TH-import Language.Haskell.TH.Desugar (DsMonad)-import Language.Haskell.TH.TypeGraph.Edges (GraphEdges)-import Language.Haskell.TH.TypeGraph.Expand (E, unE, ExpandMap)-import Language.Haskell.TH.TypeGraph.Edges (typeGraphEdges)-import Language.Haskell.TH.TypeGraph.Prelude (pprint1)-import Language.Haskell.TH.TypeGraph.Shape (Field)-import Language.Haskell.TH.TypeGraph.TypeInfo (TypeInfo)-import Language.Haskell.TH.TypeGraph.Vertex (etype, syns, TGV, TGV', TGVSimple, TypeGraphVertex, vsimple)--import Language.Haskell.TH.Syntax (Lift(lift))--data SetDifferences a = SetDifferences {unexpected :: Set a, missing :: Set a} deriving (Eq, Ord, Show)--setDifferences :: Ord a => Set a -> Set a -> SetDifferences a-setDifferences actual expected = SetDifferences {unexpected = Set.difference actual expected, missing = Set.difference expected actual}-noDifferences = SetDifferences {unexpected = Set.empty, missing = Set.empty}--unReify :: Data a => a -> a-unReify = everywhere (mkT unReifyName)--unReifyName :: Name -> Name-unReifyName = mkName . nameBase---- Some very nasty bug is triggered here in ghc-7.8 if we try to implement--- a generic function that unReifies the symbols.  Ghc-7.10 works fine---- pprint' :: (Data a, Ppr a) => a -> String--- pprint' = pprint' . unReify--pprintDec :: Dec -> String-pprintDec = pprint1 . unReify--pprintType :: E Type -> String-pprintType = pprint1 . unReify . view unE--pprintVertex :: (Ppr v, Data v) => v -> String-pprintVertex = pprint1--pprintPred :: E Pred -> String-pprintPred = pprint1 . unReify . view unE--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))-typeSynonymMap =-     (Map.filter (not . Set.null) .-      Map.fromList .-      List.map (\node -> (node, view (vsimple . syns) node)) .-      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) =>-                        m (Map (E Type) (Set Name))-typeSynonymMapSimple =-    simplify <$> typeSynonymMap-    where-      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/Tests.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-module Main where--import Control.DeepSeq-import Control.Monad.State (evalStateT, runStateT)-import Data.Array.Base-import Data.ByteString (ByteString)-import Data.List as List (intercalate, map, null)-import Data.Map as Map (Map, fromList, toList, map, mapKeys, empty)-import Data.Set as Set (Set, fromList, toList, null, difference, empty)-import Data.Text (Text)-import Data.Monoid (mempty)-import Language.Haskell.TH-import Language.Haskell.TH.Desugar (withLocalDeclarations)-import Language.Haskell.TH.ReifyMany-import Language.Haskell.TH.Syntax (Lift(lift), Quasi(qReifyInstances))-import System.Exit (ExitCode)-import Test.Hspec hiding (runIO)-import TypeGraph (tests)--main :: IO ()-main = hspec $ do-  TypeGraph.tests
− test/TypeGraph.hs 
@@ -1,125 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}-module TypeGraph where--#if __GLASGOW_HASKELL__ < 709-import Control.Applicative ((<$>))-#endif-import Control.Lens-import Control.Monad.Reader (runReaderT)-import Control.Monad.State (evalStateT)-import Data.List as List (map)-import Data.Map as Map (Map, empty, fromList, keys)-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, 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.Desugar (withLocalDeclarations)-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.Syntax-import Test.Hspec hiding (runIO)-import Test.Hspec.Core.Spec (SpecM)--import Common-import Values--tests :: SpecM () ()-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),-                                                                                                                                    (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))}})--  it "can build the TypeInfoGraph for Type" $ do-    $(runQ [t|Type|] >>= \typ -> makeTypeInfo (const $ return mempty) [typ] >>= lift . pprint) `shouldBe` typeInfoOfType--  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 >>=-                                      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 >>=-                                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 >>=-                                  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 >>=-                                dissolveM (\ v -> (/= 0) <$> (typeArity . view unE . view etype) v) >>=-                                runQ . lift . edgesToStrings)) arity0TypeEdges-        `shouldBe` noDifferences-#if 0-  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 >>=-                                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 >>=-                                dissolveM (\ v -> (/= 0) <$> (typeArity . runExpanded . _etype) v) >>=-                                runQ . lift . edgesToStrings)) arity0DecEdges-        `shouldBe` noDifferences--  it "can find the subtypesOfDec" $ do-     setDifferences (Set.fromList $(withLocalDeclarations [] $-                                runQ [t|Dec|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphVertices >>=-                                runQ . lift . List.map pprint . Set.toList . Set.map simpleVertex)) subtypesOfDec-        `shouldBe` noDifferences--  it "can find the arity0SubtypesOfDec" $ do-     setDifferences (Set.fromList $(withLocalDeclarations [] $-                                runQ [t|Dec|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphVertices >>=-                                return . Set.toList . Set.map simpleVertex >>=-                                filterM (\ t -> typeArity (runExpanded (_etype t)) >>= \ a -> return (a == 0)) >>=-                                runQ . lift . List.map pprint)) arity0SubtypesOfDec-        `shouldBe` noDifferences--  it "can find the simpleSubtypesOfDec" $ do-     setDifferences (Set.fromList $(withLocalDeclarations [] $-                                runQ [t|Dec|] >>= \typ ->-                                makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphVertices >>=-                                runQ . lift . List.map pprint . Set.toList . Set.map simpleVertex)) simpleSubtypesOfDec-        `shouldBe` noDifferences--  it "can find the type synonyms in Dec (decTypeSynonyms)" $ do-     $(withLocalDeclarations [] $-       runQ [t|Dec|] >>= \typ -> makeTypeInfo (const $ return mempty) [typ] >>= runReaderT (typeSynonymMapSimple >>= runQ . lift)) `shouldBe` decTypeSynonyms-#endif--  it "can find the free type variable names in: Map k a" $ do-    $(runQ (appT (appT (conT ''Map) (varT (mkName "k"))) (varT (mkName "a"))) >>= freeTypeVars >>= runQ . lift . show) `shouldBe` "fromList [a,k]"--  it "can find the free type variable names in: Map Int String" $ do-    $(runQ [t|Map Int String|] >>= freeTypeVars  >>= runQ . lift . show) `shouldBe` "fromList []"
− test/Values.hs 
@@ -1,1107 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-module Values where--import Control.Monad (filterM)-import Data.Map as Map (Map, fromList, toList)-import Data.Ratio (Ratio)-import Data.Set as Set (Set, empty, fromList, toList, union)-import GHC.Prim -- ByteArray#, Char#, etc-import Language.Haskell.TH-import Language.Haskell.TH.TypeGraph.Arity (typeArity)-import Language.Haskell.TH.TypeGraph.Edges (typeGraphEdges)-import Language.Haskell.TH.TypeGraph.Expand (E(E), expandType)-import Language.Haskell.TH.TypeGraph.Vertex (TypeGraphVertex(..))-import Language.Haskell.TH.Desugar (withLocalDeclarations)-import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.Syntax-import Test.Hspec hiding (runIO)-import Test.Hspec.Core.Spec (SpecM)--import Common--typeInfoOfType =-    unlines-#if MIN_VERSION_template_haskell(2,10,0)-    [ "TypeInfo:",-      "  typeSet:",-      "    [GHC.Types.Char]",-      "    [Language.Haskell.TH.Syntax.Pred]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr]",-      "    GHC.Base.String",-      "    GHC.Prim.ByteArray#",-      "    GHC.Prim.Char#",-      "    GHC.Prim.Int#",-      "    GHC.Types.Char",-      "    GHC.Types.Int",-      "    GHC.Integer.Type.BigNat",-      "    GHC.Integer.Type.Integer",-      "    Language.Haskell.TH.Syntax.Cxt",-      "    Language.Haskell.TH.Syntax.Kind",-      "    Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.Name",-      "    Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameSpace",-      "    Language.Haskell.TH.Syntax.OccName",-      "    Language.Haskell.TH.Syntax.PkgName",-      "    Language.Haskell.TH.Syntax.Pred",-      "    Language.Haskell.TH.Syntax.TyLit",-      "    Language.Haskell.TH.Syntax.TyVarBndr",-      "    Language.Haskell.TH.Syntax.Type",-      "    []",-      "  infoMap:",-      "    GHC.Base.String -> type GHC.Base.String = [GHC.Types.Char]",-      "    GHC.Prim.ByteArray# -> Primitive unlifted type constructor 'GHC.Prim.ByteArray#' (arity 0)",-      "    GHC.Prim.Char# -> Primitive unlifted type constructor 'GHC.Prim.Char#' (arity 0)",-      "    GHC.Prim.Int# -> Primitive unlifted type constructor 'GHC.Prim.Int#' (arity 0)",-      "    GHC.Types.Char -> data GHC.Types.Char = GHC.Types.C# GHC.Prim.Char#",-      "    GHC.Types.Int -> data GHC.Types.Int = GHC.Types.I# GHC.Prim.Int#",-      "    GHC.Integer.Type.BigNat -> data GHC.Integer.Type.BigNat",-      "        = GHC.Integer.Type.BN# GHC.Prim.ByteArray#",-      "    GHC.Integer.Type.Integer -> data GHC.Integer.Type.Integer",-      "        = GHC.Integer.Type.S# !GHC.Prim.Int#",-      "        | GHC.Integer.Type.Jp# {-# UNPACK #-} !GHC.Integer.Type.BigNat",-      "        | GHC.Integer.Type.Jn# {-# UNPACK #-} !GHC.Integer.Type.BigNat",-      "    Language.Haskell.TH.Syntax.Cxt -> type Language.Haskell.TH.Syntax.Cxt = [Language.Haskell.TH.Syntax.Pred]",-      "    Language.Haskell.TH.Syntax.Kind -> type Language.Haskell.TH.Syntax.Kind = Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.ModName -> newtype Language.Haskell.TH.Syntax.ModName",-      "      = Language.Haskell.TH.Syntax.ModName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.Name -> data Language.Haskell.TH.Syntax.Name",-      "        = Language.Haskell.TH.Syntax.Name Language.Haskell.TH.Syntax.OccName",-      "                                          Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameFlavour -> data Language.Haskell.TH.Syntax.NameFlavour",-      "        = Language.Haskell.TH.Syntax.NameS",-      "        | Language.Haskell.TH.Syntax.NameQ Language.Haskell.TH.Syntax.ModName",-      "        | Language.Haskell.TH.Syntax.NameU {-# UNPACK #-} !GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.NameL {-# UNPACK #-} !GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.NameG Language.Haskell.TH.Syntax.NameSpace",-      "                                           Language.Haskell.TH.Syntax.PkgName",-      "                                           Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.NameSpace -> data Language.Haskell.TH.Syntax.NameSpace",-      "        = Language.Haskell.TH.Syntax.VarName",-      "        | Language.Haskell.TH.Syntax.DataName",-      "        | Language.Haskell.TH.Syntax.TcClsName",-      "    Language.Haskell.TH.Syntax.OccName -> newtype Language.Haskell.TH.Syntax.OccName",-      "      = Language.Haskell.TH.Syntax.OccName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.PkgName -> newtype Language.Haskell.TH.Syntax.PkgName",-      "      = Language.Haskell.TH.Syntax.PkgName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.Pred -> type Language.Haskell.TH.Syntax.Pred = Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.TyLit -> data Language.Haskell.TH.Syntax.TyLit",-      "        = Language.Haskell.TH.Syntax.NumTyLit GHC.Integer.Type.Integer",-      "        | Language.Haskell.TH.Syntax.StrTyLit GHC.Base.String",-      "    Language.Haskell.TH.Syntax.TyVarBndr -> data Language.Haskell.TH.Syntax.TyVarBndr",-      "        = Language.Haskell.TH.Syntax.PlainTV Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.KindedTV Language.Haskell.TH.Syntax.Name",-      "                                              Language.Haskell.TH.Syntax.Kind",-      "    Language.Haskell.TH.Syntax.Type -> data Language.Haskell.TH.Syntax.Type",-      "        = Language.Haskell.TH.Syntax.ForallT ([Language.Haskell.TH.Syntax.TyVarBndr])",-      "                                             Language.Haskell.TH.Syntax.Cxt",-      "                                             Language.Haskell.TH.Syntax.Type",-      "        | Language.Haskell.TH.Syntax.AppT Language.Haskell.TH.Syntax.Type",-      "                                          Language.Haskell.TH.Syntax.Type",-      "        | Language.Haskell.TH.Syntax.SigT Language.Haskell.TH.Syntax.Type",-      "                                          Language.Haskell.TH.Syntax.Kind",-      "        | Language.Haskell.TH.Syntax.VarT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.ConT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.PromotedT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.TupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.UnboxedTupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.ArrowT",-      "        | Language.Haskell.TH.Syntax.EqualityT",-      "        | Language.Haskell.TH.Syntax.ListT",-      "        | Language.Haskell.TH.Syntax.PromotedTupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.PromotedNilT",-      "        | Language.Haskell.TH.Syntax.PromotedConsT",-      "        | Language.Haskell.TH.Syntax.StarT",-      "        | Language.Haskell.TH.Syntax.ConstraintT",-      "        | Language.Haskell.TH.Syntax.LitT Language.Haskell.TH.Syntax.TyLit",-      "  expanded:",-      "    [GHC.Types.Char] -> [GHC.Types.Char]",-      "    [Language.Haskell.TH.Syntax.Pred] -> [Language.Haskell.TH.Syntax.Type]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr] -> [Language.Haskell.TH.Syntax.TyVarBndr]",-      "    GHC.Base.String -> [GHC.Types.Char]",-      "    GHC.Prim.ByteArray# -> GHC.Prim.ByteArray#",-      "    GHC.Prim.Char# -> GHC.Prim.Char#",-      "    GHC.Prim.Int# -> GHC.Prim.Int#",-      "    GHC.Types.Char -> GHC.Types.Char",-      "    GHC.Types.Int -> GHC.Types.Int",-      "    GHC.Integer.Type.BigNat -> GHC.Integer.Type.BigNat",-      "    GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer",-      "    Language.Haskell.TH.Syntax.Cxt -> [Language.Haskell.TH.Syntax.Type]",-      "    Language.Haskell.TH.Syntax.Kind -> Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.ModName -> Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.Name -> Language.Haskell.TH.Syntax.Name",-      "    Language.Haskell.TH.Syntax.NameFlavour -> Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameSpace -> Language.Haskell.TH.Syntax.NameSpace",-      "    Language.Haskell.TH.Syntax.OccName -> Language.Haskell.TH.Syntax.OccName",-      "    Language.Haskell.TH.Syntax.PkgName -> Language.Haskell.TH.Syntax.PkgName",-      "    Language.Haskell.TH.Syntax.Pred -> Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.TyLit -> Language.Haskell.TH.Syntax.TyLit",-      "    Language.Haskell.TH.Syntax.TyVarBndr -> Language.Haskell.TH.Syntax.TyVarBndr",-      "    Language.Haskell.TH.Syntax.Type -> Language.Haskell.TH.Syntax.Type",-      "    [] -> []",-      "  synonyms:",-      "    [GHC.Types.Char] -> fromList [GHC.Base.String]",-      "    [Language.Haskell.TH.Syntax.Type] -> fromList [Language.Haskell.TH.Syntax.Cxt]",-      "    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,NormalC Language.Haskell.TH.Syntax.ModName [(NotStrict,ConT GHC.Base.String)],Left 1),(Language.Haskell.TH.Syntax.OccName,NormalC Language.Haskell.TH.Syntax.OccName [(NotStrict,ConT GHC.Base.String)],Left 1),(Language.Haskell.TH.Syntax.PkgName,NormalC Language.Haskell.TH.Syntax.PkgName [(NotStrict,ConT GHC.Base.String)],Left 1),(Language.Haskell.TH.Syntax.TyLit,NormalC Language.Haskell.TH.Syntax.StrTyLit [(NotStrict,ConT GHC.Base.String)],Left 1)]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr] -> fromList [(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.ForallT [(NotStrict,AppT ListT (ConT Language.Haskell.TH.Syntax.TyVarBndr)),(NotStrict,ConT Language.Haskell.TH.Syntax.Cxt),(NotStrict,ConT Language.Haskell.TH.Syntax.Type)],Left 1)]",-      "    [Language.Haskell.TH.Syntax.Type] -> fromList [(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.ForallT [(NotStrict,AppT ListT (ConT Language.Haskell.TH.Syntax.TyVarBndr)),(NotStrict,ConT Language.Haskell.TH.Syntax.Cxt),(NotStrict,ConT Language.Haskell.TH.Syntax.Type)],Left 2)]",-      "    GHC.Prim.ByteArray# -> fromList [(GHC.Integer.Type.BigNat,NormalC GHC.Integer.Type.BN# [(NotStrict,ConT GHC.Prim.ByteArray#)],Left 1)]",-      "    GHC.Prim.Char# -> fromList [(GHC.Types.Char,NormalC GHC.Types.C# [(NotStrict,ConT GHC.Prim.Char#)],Left 1)]",-      "    GHC.Prim.Int# -> fromList [(GHC.Types.Int,NormalC GHC.Types.I# [(NotStrict,ConT GHC.Prim.Int#)],Left 1),(GHC.Integer.Type.Integer,NormalC GHC.Integer.Type.S# [(IsStrict,ConT GHC.Prim.Int#)],Left 1)]",-      "    GHC.Types.Int -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameL [(Unpacked,ConT GHC.Types.Int)],Left 1),(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameU [(Unpacked,ConT GHC.Types.Int)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.PromotedTupleT [(NotStrict,ConT GHC.Types.Int)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.TupleT [(NotStrict,ConT GHC.Types.Int)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.UnboxedTupleT [(NotStrict,ConT GHC.Types.Int)],Left 1)]",-      "    GHC.Integer.Type.BigNat -> fromList [(GHC.Integer.Type.Integer,NormalC GHC.Integer.Type.Jn# [(Unpacked,ConT GHC.Integer.Type.BigNat)],Left 1),(GHC.Integer.Type.Integer,NormalC GHC.Integer.Type.Jp# [(Unpacked,ConT GHC.Integer.Type.BigNat)],Left 1)]",-      "    GHC.Integer.Type.Integer -> fromList [(Language.Haskell.TH.Syntax.TyLit,NormalC Language.Haskell.TH.Syntax.NumTyLit [(NotStrict,ConT GHC.Integer.Type.Integer)],Left 1)]",-      "    Language.Haskell.TH.Syntax.ModName -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameG [(NotStrict,ConT Language.Haskell.TH.Syntax.NameSpace),(NotStrict,ConT Language.Haskell.TH.Syntax.PkgName),(NotStrict,ConT Language.Haskell.TH.Syntax.ModName)],Left 3),(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameQ [(NotStrict,ConT Language.Haskell.TH.Syntax.ModName)],Left 1)]",-      "    Language.Haskell.TH.Syntax.Name -> fromList [(Language.Haskell.TH.Syntax.TyVarBndr,NormalC Language.Haskell.TH.Syntax.KindedTV [(NotStrict,ConT Language.Haskell.TH.Syntax.Name),(NotStrict,ConT Language.Haskell.TH.Syntax.Kind)],Left 1),(Language.Haskell.TH.Syntax.TyVarBndr,NormalC Language.Haskell.TH.Syntax.PlainTV [(NotStrict,ConT Language.Haskell.TH.Syntax.Name)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.ConT [(NotStrict,ConT Language.Haskell.TH.Syntax.Name)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.PromotedT [(NotStrict,ConT Language.Haskell.TH.Syntax.Name)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.VarT [(NotStrict,ConT Language.Haskell.TH.Syntax.Name)],Left 1)]",-      "    Language.Haskell.TH.Syntax.NameFlavour -> fromList [(Language.Haskell.TH.Syntax.Name,NormalC Language.Haskell.TH.Syntax.Name [(NotStrict,ConT Language.Haskell.TH.Syntax.OccName),(NotStrict,ConT Language.Haskell.TH.Syntax.NameFlavour)],Left 2)]",-      "    Language.Haskell.TH.Syntax.NameSpace -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameG [(NotStrict,ConT Language.Haskell.TH.Syntax.NameSpace),(NotStrict,ConT Language.Haskell.TH.Syntax.PkgName),(NotStrict,ConT Language.Haskell.TH.Syntax.ModName)],Left 1)]",-      "    Language.Haskell.TH.Syntax.OccName -> fromList [(Language.Haskell.TH.Syntax.Name,NormalC Language.Haskell.TH.Syntax.Name [(NotStrict,ConT Language.Haskell.TH.Syntax.OccName),(NotStrict,ConT Language.Haskell.TH.Syntax.NameFlavour)],Left 1)]",-      "    Language.Haskell.TH.Syntax.PkgName -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,NormalC Language.Haskell.TH.Syntax.NameG [(NotStrict,ConT Language.Haskell.TH.Syntax.NameSpace),(NotStrict,ConT Language.Haskell.TH.Syntax.PkgName),(NotStrict,ConT Language.Haskell.TH.Syntax.ModName)],Left 2)]",-      "    Language.Haskell.TH.Syntax.TyLit -> fromList [(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.LitT [(NotStrict,ConT Language.Haskell.TH.Syntax.TyLit)],Left 1)]",-      "    Language.Haskell.TH.Syntax.Type -> fromList [(Language.Haskell.TH.Syntax.TyVarBndr,NormalC Language.Haskell.TH.Syntax.KindedTV [(NotStrict,ConT Language.Haskell.TH.Syntax.Name),(NotStrict,ConT Language.Haskell.TH.Syntax.Kind)],Left 2),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.AppT [(NotStrict,ConT Language.Haskell.TH.Syntax.Type),(NotStrict,ConT Language.Haskell.TH.Syntax.Type)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.AppT [(NotStrict,ConT Language.Haskell.TH.Syntax.Type),(NotStrict,ConT Language.Haskell.TH.Syntax.Type)],Left 2),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.ForallT [(NotStrict,AppT ListT (ConT Language.Haskell.TH.Syntax.TyVarBndr)),(NotStrict,ConT Language.Haskell.TH.Syntax.Cxt),(NotStrict,ConT Language.Haskell.TH.Syntax.Type)],Left 3),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.SigT [(NotStrict,ConT Language.Haskell.TH.Syntax.Type),(NotStrict,ConT Language.Haskell.TH.Syntax.Kind)],Left 1),(Language.Haskell.TH.Syntax.Type,NormalC Language.Haskell.TH.Syntax.SigT [(NotStrict,ConT Language.Haskell.TH.Syntax.Type),(NotStrict,ConT Language.Haskell.TH.Syntax.Kind)],Left 2)]" ]-#else-    [ "TypeGraphInfo:",-      "  typeSet:",-      "    [GHC.Types.Char]",-      "    [Language.Haskell.TH.Syntax.Pred]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr]",-      "    [Language.Haskell.TH.Syntax.Type]",-      "    GHC.Base.String",-      "    GHC.Prim.ByteArray#",-      "    GHC.Prim.Char#",-      "    GHC.Prim.Int#",-      "    GHC.Types.Char",-      "    GHC.Types.Int",-      "    GHC.Integer.Type.Integer",-      "    Language.Haskell.TH.Syntax.Cxt",-      "    Language.Haskell.TH.Syntax.Kind",-      "    Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.Name",-      "    Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameSpace",-      "    Language.Haskell.TH.Syntax.OccName",-      "    Language.Haskell.TH.Syntax.PkgName",-      "    Language.Haskell.TH.Syntax.Pred",-      "    Language.Haskell.TH.Syntax.TyLit",-      "    Language.Haskell.TH.Syntax.TyVarBndr",-      "    Language.Haskell.TH.Syntax.Type",-      "    []",-      "  infoMap:",-      "    GHC.Base.String -> type GHC.Base.String = [GHC.Types.Char]",-      "    GHC.Prim.ByteArray# -> Primitive unlifted type constructor 'GHC.Prim.ByteArray#' (arity 0)",-      "    GHC.Prim.Char# -> Primitive unlifted type constructor 'GHC.Prim.Char#' (arity 0)",-      "    GHC.Prim.Int# -> Primitive unlifted type constructor 'GHC.Prim.Int#' (arity 0)",-      "    GHC.Types.Char -> data GHC.Types.Char = GHC.Types.C# GHC.Prim.Char#",-      "    GHC.Types.Int -> data GHC.Types.Int = GHC.Types.I# GHC.Prim.Int#",-      "    GHC.Integer.Type.Integer -> data GHC.Integer.Type.Integer",-      "        = GHC.Integer.Type.S# GHC.Prim.Int#",-      "        | GHC.Integer.Type.J# GHC.Prim.Int# GHC.Prim.ByteArray#",-      "    Language.Haskell.TH.Syntax.Cxt -> type Language.Haskell.TH.Syntax.Cxt = [Language.Haskell.TH.Syntax.Pred]",-      "    Language.Haskell.TH.Syntax.Kind -> type Language.Haskell.TH.Syntax.Kind = Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.ModName -> newtype Language.Haskell.TH.Syntax.ModName",-      "      = Language.Haskell.TH.Syntax.ModName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.Name -> data Language.Haskell.TH.Syntax.Name",-      "        = Language.Haskell.TH.Syntax.Name Language.Haskell.TH.Syntax.OccName",-      "                                          Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameFlavour -> data Language.Haskell.TH.Syntax.NameFlavour",-      "        = Language.Haskell.TH.Syntax.NameS",-      "        | Language.Haskell.TH.Syntax.NameQ Language.Haskell.TH.Syntax.ModName",-      "        | Language.Haskell.TH.Syntax.NameU GHC.Prim.Int#",-      "        | Language.Haskell.TH.Syntax.NameL GHC.Prim.Int#",-      "        | Language.Haskell.TH.Syntax.NameG Language.Haskell.TH.Syntax.NameSpace",-      "                                           Language.Haskell.TH.Syntax.PkgName",-      "                                           Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.NameSpace -> data Language.Haskell.TH.Syntax.NameSpace",-      "        = Language.Haskell.TH.Syntax.VarName",-      "        | Language.Haskell.TH.Syntax.DataName",-      "        | Language.Haskell.TH.Syntax.TcClsName",-      "    Language.Haskell.TH.Syntax.OccName -> newtype Language.Haskell.TH.Syntax.OccName",-      "      = Language.Haskell.TH.Syntax.OccName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.PkgName -> newtype Language.Haskell.TH.Syntax.PkgName",-      "      = Language.Haskell.TH.Syntax.PkgName GHC.Base.String",-      "    Language.Haskell.TH.Syntax.Pred -> data Language.Haskell.TH.Syntax.Pred",-      "        = Language.Haskell.TH.Syntax.ClassP Language.Haskell.TH.Syntax.Name",-      "                                            ([Language.Haskell.TH.Syntax.Type])",-      "        | Language.Haskell.TH.Syntax.EqualP Language.Haskell.TH.Syntax.Type",-      "                                            Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.TyLit -> data Language.Haskell.TH.Syntax.TyLit",-      "        = Language.Haskell.TH.Syntax.NumTyLit GHC.Integer.Type.Integer",-      "        | Language.Haskell.TH.Syntax.StrTyLit GHC.Base.String",-      "    Language.Haskell.TH.Syntax.TyVarBndr -> data Language.Haskell.TH.Syntax.TyVarBndr",-      "        = Language.Haskell.TH.Syntax.PlainTV Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.KindedTV Language.Haskell.TH.Syntax.Name",-      "                                              Language.Haskell.TH.Syntax.Kind",-      "    Language.Haskell.TH.Syntax.Type -> data Language.Haskell.TH.Syntax.Type",-      "        = Language.Haskell.TH.Syntax.ForallT ([Language.Haskell.TH.Syntax.TyVarBndr])",-      "                                             Language.Haskell.TH.Syntax.Cxt",-      "                                             Language.Haskell.TH.Syntax.Type",-      "        | Language.Haskell.TH.Syntax.AppT Language.Haskell.TH.Syntax.Type",-      "                                          Language.Haskell.TH.Syntax.Type",-      "        | Language.Haskell.TH.Syntax.SigT Language.Haskell.TH.Syntax.Type",-      "                                          Language.Haskell.TH.Syntax.Kind",-      "        | Language.Haskell.TH.Syntax.VarT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.ConT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.PromotedT Language.Haskell.TH.Syntax.Name",-      "        | Language.Haskell.TH.Syntax.TupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.UnboxedTupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.ArrowT",-      "        | Language.Haskell.TH.Syntax.ListT",-      "        | Language.Haskell.TH.Syntax.PromotedTupleT GHC.Types.Int",-      "        | Language.Haskell.TH.Syntax.PromotedNilT",-      "        | Language.Haskell.TH.Syntax.PromotedConsT",-      "        | Language.Haskell.TH.Syntax.StarT",-      "        | Language.Haskell.TH.Syntax.ConstraintT",-      "        | Language.Haskell.TH.Syntax.LitT Language.Haskell.TH.Syntax.TyLit",-      "  expanded:",-      "    [GHC.Types.Char] -> [GHC.Types.Char]",-      "    [Language.Haskell.TH.Syntax.Pred] -> [Language.Haskell.TH.Syntax.Pred]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr] -> [Language.Haskell.TH.Syntax.TyVarBndr]",-      "    [Language.Haskell.TH.Syntax.Type] -> [Language.Haskell.TH.Syntax.Type]",-      "    GHC.Base.String -> [GHC.Types.Char]",-      "    GHC.Prim.ByteArray# -> GHC.Prim.ByteArray#",-      "    GHC.Prim.Char# -> GHC.Prim.Char#",-      "    GHC.Prim.Int# -> GHC.Prim.Int#",-      "    GHC.Types.Char -> GHC.Types.Char",-      "    GHC.Types.Int -> GHC.Types.Int",-      "    GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer",-      "    Language.Haskell.TH.Syntax.Cxt -> [Language.Haskell.TH.Syntax.Pred]",-      "    Language.Haskell.TH.Syntax.Kind -> Language.Haskell.TH.Syntax.Type",-      "    Language.Haskell.TH.Syntax.ModName -> Language.Haskell.TH.Syntax.ModName",-      "    Language.Haskell.TH.Syntax.Name -> Language.Haskell.TH.Syntax.Name",-      "    Language.Haskell.TH.Syntax.NameFlavour -> Language.Haskell.TH.Syntax.NameFlavour",-      "    Language.Haskell.TH.Syntax.NameSpace -> Language.Haskell.TH.Syntax.NameSpace",-      "    Language.Haskell.TH.Syntax.OccName -> Language.Haskell.TH.Syntax.OccName",-      "    Language.Haskell.TH.Syntax.PkgName -> Language.Haskell.TH.Syntax.PkgName",-      "    Language.Haskell.TH.Syntax.Pred -> Language.Haskell.TH.Syntax.Pred",-      "    Language.Haskell.TH.Syntax.TyLit -> Language.Haskell.TH.Syntax.TyLit",-      "    Language.Haskell.TH.Syntax.TyVarBndr -> Language.Haskell.TH.Syntax.TyVarBndr",-      "    Language.Haskell.TH.Syntax.Type -> Language.Haskell.TH.Syntax.Type",-      "    [] -> []",-      "  synonyms:",-      "    [GHC.Types.Char] -> fromList [GHC.Base.String]",-      "    [Language.Haskell.TH.Syntax.Pred] -> fromList [Language.Haskell.TH.Syntax.Cxt]",-      "    Language.Haskell.TH.Syntax.Type -> fromList [Language.Haskell.TH.Syntax.Kind]",-      "  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.Pred] -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 2)]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr] -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 1)]",-      "    [Language.Haskell.TH.Syntax.Type] -> fromList [(Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.ClassP,Left 2)]",-      "    GHC.Prim.ByteArray# -> fromList [(GHC.Integer.Type.Integer,GHC.Integer.Type.J#,Left 2)]",-      "    GHC.Prim.Char# -> fromList [(GHC.Types.Char,GHC.Types.C#,Left 1)]",-      "    GHC.Prim.Int# -> fromList [(GHC.Types.Int,GHC.Types.I#,Left 1),(GHC.Integer.Type.Integer,GHC.Integer.Type.J#,Left 1),(GHC.Integer.Type.Integer,GHC.Integer.Type.S#,Left 1),(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameL,Left 1),(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameU,Left 1)]",-      "    GHC.Types.Int -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.PromotedTupleT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.TupleT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.UnboxedTupleT,Left 1)]",-      "    GHC.Integer.Type.Integer -> fromList [(Language.Haskell.TH.Syntax.TyLit,Language.Haskell.TH.Syntax.NumTyLit,Left 1)]",-      "    Language.Haskell.TH.Syntax.ModName -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameG,Left 3),(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameQ,Left 1)]",-      "    Language.Haskell.TH.Syntax.Name -> fromList [(Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.ClassP,Left 1),(Language.Haskell.TH.Syntax.TyVarBndr,Language.Haskell.TH.Syntax.KindedTV,Left 1),(Language.Haskell.TH.Syntax.TyVarBndr,Language.Haskell.TH.Syntax.PlainTV,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ConT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.PromotedT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.VarT,Left 1)]",-      "    Language.Haskell.TH.Syntax.NameFlavour -> fromList [(Language.Haskell.TH.Syntax.Name,Language.Haskell.TH.Syntax.Name,Left 2)]",-      "    Language.Haskell.TH.Syntax.NameSpace -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameG,Left 1)]",-      "    Language.Haskell.TH.Syntax.OccName -> fromList [(Language.Haskell.TH.Syntax.Name,Language.Haskell.TH.Syntax.Name,Left 1)]",-      "    Language.Haskell.TH.Syntax.PkgName -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameG,Left 2)]",-      "    Language.Haskell.TH.Syntax.TyLit -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.LitT,Left 1)]",-      "    Language.Haskell.TH.Syntax.Type -> fromList [(Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.EqualP,Left 1),(Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.EqualP,Left 2),(Language.Haskell.TH.Syntax.TyVarBndr,Language.Haskell.TH.Syntax.KindedTV,Left 2),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.AppT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.AppT,Left 2),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 3),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.SigT,Left 1),(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.SigT,Left 2)]" ]-#endif--subtypesOfType :: Set String-subtypesOfType =-    Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     "BigNat","BigNat (field Integer.Jn#[1])","BigNat (field Integer.Jp#[1])","ByteArray#","ByteArray# (field BigNat.BN#[1])","Char","Char#","Char# (field Char.C#[1])","Int","Int (field NameFlavour.NameL[1])","Int (field NameFlavour.NameU[1])","Int (field Type.PromotedTupleT[1])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Int#","Int# (field Int.I#[1])","Int# (field Integer.S#[1])","Integer","Integer (field TyLit.NumTyLit[1])","ModName","ModName (field NameFlavour.NameG[3])","ModName (field NameFlavour.NameQ[1])","Name","Name (field TyVarBndr.KindedTV[1])","Name (field TyVarBndr.PlainTV[1])","Name (field Type.ConT[1])","Name (field Type.PromotedT[1])","Name (field Type.VarT[1])","NameFlavour","NameFlavour (field Name.Name[2])","NameSpace","NameSpace (field NameFlavour.NameG[1])","OccName","OccName (field Name.Name[1])","PkgName","PkgName (field NameFlavour.NameG[2])","TyLit","TyLit (field Type.LitT[1])","TyVarBndr","Type (aka Kind, aka Pred)","Type (aka Kind, aka Pred, field TyVarBndr.KindedTV[2])","Type (aka Kind, aka Pred, field Type.AppT[1])","Type (aka Kind, aka Pred, field Type.AppT[2])","Type (aka Kind, aka Pred, field Type.ForallT[3])","Type (aka Kind, aka Pred, field Type.SigT[1])","Type (aka Kind, aka Pred, field Type.SigT[2])","[Char] (aka String)","[Char] (aka String, field ModName.ModName[1])","[Char] (aka String, field OccName.OccName[1])","[Char] (aka String, field PkgName.PkgName[1])","[Char] (aka String, field TyLit.StrTyLit[1])","[TyVarBndr]","[TyVarBndr] (field Type.ForallT[1])","[Type] (aka Cxt)","[Type] (aka Cxt, field Type.ForallT[2])","[]"-#else-     "ByteArray#","ByteArray# (field Integer.J#[2])","Char","Char#","Char# (field Char.C#[1])","Int","Int (field Type.PromotedTupleT[1])","Int (field Type.TupleT[1])","Int (field Type.UnboxedTupleT[1])","Int#","Int# (field Int.I#[1])","Int# (field Integer.J#[1])","Int# (field Integer.S#[1])","Int# (field NameFlavour.NameL[1])","Int# (field NameFlavour.NameU[1])","Integer","Integer (field TyLit.NumTyLit[1])","ModName","ModName (field NameFlavour.NameG[3])","ModName (field NameFlavour.NameQ[1])","Name","Name (field Pred.ClassP[1])","Name (field TyVarBndr.KindedTV[1])","Name (field TyVarBndr.PlainTV[1])","Name (field Type.ConT[1])","Name (field Type.PromotedT[1])","Name (field Type.VarT[1])","NameFlavour","NameFlavour (field Name.Name[2])","NameSpace","NameSpace (field NameFlavour.NameG[1])","OccName","OccName (field Name.Name[1])","PkgName","PkgName (field NameFlavour.NameG[2])","Pred","TyLit","TyLit (field Type.LitT[1])","TyVarBndr","Type (aka Kind)","Type (aka Kind, field Pred.EqualP[1])","Type (aka Kind, field Pred.EqualP[2])","Type (aka Kind, field TyVarBndr.KindedTV[2])","Type (aka Kind, field Type.AppT[1])","Type (aka Kind, field Type.AppT[2])","Type (aka Kind, field Type.ForallT[3])","Type (aka Kind, field Type.SigT[1])","Type (aka Kind, field Type.SigT[2])","[Char] (aka String)","[Char] (aka String, field ModName.ModName[1])","[Char] (aka String, field OccName.OccName[1])","[Char] (aka String, field PkgName.PkgName[1])","[Char] (aka String, field TyLit.StrTyLit[1])","[Pred] (aka Cxt)","[Pred] (aka Cxt, field Type.ForallT[2])","[TyVarBndr]","[TyVarBndr] (field Type.ForallT[1])","[Type]","[Type] (field Pred.ClassP[2])","[]"-#endif-    ]--simpleTypeEdges :: Set (String, Set String)-simpleTypeEdges =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     ("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#",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, Set String)-typeEdges =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     ("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#",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, Set String)-arity0TypeEdges =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     ("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#",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-    ]--arity0TypeEdges' :: Set (String, [String])-arity0TypeEdges' =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-#else-     ("ByteArray#",[]),-     ("Char",[]),-     ("Char#",[]),-     ("Int",[]),-     ("Int#",[]),-     ("Integer",[]),-     ("ModName",["Char","[]","[Char] (aka String)"]),-     ("Name",["Int#","ModName","NameSpace","PkgName","[Char] (aka String)"]),-     ("NameFlavour",["[Char] (aka String)"]),-     ("NameSpace",[]),-     ("OccName",["Char","[]","[Char] (aka String)"]),-     ("PkgName",["Char","[]","[Char] (aka String)"]),-     ("Pred",["[TyVarBndr]","Int","Name","NameFlavour","OccName","TyLit","[]","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("TyLit",["ByteArray#","Int#","Char","[]","[Char] (aka String)"]),-     ("TyVarBndr",["[TyVarBndr]","Int","Name","NameFlavour","OccName","TyLit","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("Type (aka Kind)",["[TyVarBndr]","Int#","Int","Integer","Name","NameFlavour","OccName","Pred","TyLit","TyVarBndr","[]","[Char] (aka String)","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("[Char] (aka String)",["Char#","Char","[]","[Char] (aka String)"]),-     ("[Pred] (aka Cxt)",["[Type]","Name","Pred","[]","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("[TyVarBndr]",["Name","[]","Type (aka Kind)"]),-     ("[Type]",["[TyVarBndr]","Int","Name","TyLit","[]","[Pred] (aka Cxt)","Type (aka Kind)"])-#endif-    ]--decEdges :: Set (String, [String])-decEdges =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     ("(,)",[]),-     ("(,) Guard",["Guard","(,)"]),-     ("(,) Name",["Name","(,)"]),-     ("(,) Strict",["Strict","(,)"]),-     ("(,,)",[]),-     ("(,,) Name",["Name","(,,)"]),-     ("(,,) Name Strict",["(,,) Name","Strict"]),-     ("(Guard, Exp)",["(,) Guard","Exp"]),-     ("(Name, Exp) (aka FieldExp)",["(,) Name","Exp"]),-     ("(Name, Pat) (aka FieldPat)",["(,) Name","Pat"]),-     ("(Name, Strict, Type) (aka VarStrictType)",["(,,) Name Strict","Type (aka Kind, aka Pred)"]),-     ("(Strict, Type) (aka StrictType)",["(,) Strict","Type (aka Kind, aka Pred)"]),-     ("AnnTarget",["Name"]),-     ("BigNat",["ByteArray#"]),-     ("Body",["[(Guard, Exp)]","Exp"]),-     ("ByteArray#",[]),-     ("Callconv",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Clause",["[Dec]","[Pat]","Body"]),-     ("Con",["[(Name, Strict, Type)]","[(Strict, Type)]","[TyVarBndr]","Name","[Type] (aka Cxt)","(Strict, Type) (aka StrictType)"]),-     ("Dec",["Maybe Type","[Clause]","[Con]","[Dec]","[FunDep]","[Name]","[Role]","[TySynEqn]","[TyVarBndr]","Body","Con","FamFlavour","Fixity","Foreign","Name","Pat","Pragma","TySynEqn","[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),-     ("Exp",["Maybe Exp","[(Guard, Exp)]","[(Name, Exp)]","[Dec]","[Exp]","[Match]","[Pat]","[Stmt]","Lit","Name","Range","Type (aka Kind, aka Pred)"]),-     ("FamFlavour",[]),-     ("Fixity",["Int","FixityDirection"]),-     ("FixityDirection",[]),-     ("Foreign",["Callconv","Name","Safety","[Char] (aka String)","Type (aka Kind, aka Pred)"]),-     ("FunDep",["[Name]"]),-     ("Guard",["[Stmt]","Exp"]),-     ("Inline",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["Int#","BigNat"]),-     ("Lit",["[Word8]","Char","Integer","[Char] (aka String)","Ratio Integer (aka Rational)"]),-     ("Match",["[Dec]","Body","Pat"]),-     ("Maybe",["a"]),-     ("Maybe Exp",["Maybe","Exp"]),-     ("Maybe Inline",["Maybe","Inline"]),-     ("Maybe Type",["Maybe","Type (aka Kind, aka Pred)"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("Pat",["[(Name, Pat)]","[Pat]","Exp","Lit","Name","Type (aka Kind, aka Pred)"]),-     ("Phases",["Int"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pragma",["Maybe Inline","[RuleBndr]","Int","AnnTarget","Exp","Inline","Name","Phases","RuleMatch","[Char] (aka String)","Type (aka Kind, aka Pred)"]),-     ("Range",["Exp"]),-     ("Ratio",["a"]),-     ("Ratio Integer (aka Rational)",["Ratio","Integer"]),-     ("Role",[]),-     ("RuleBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("RuleMatch",[]),-     ("Safety",[]),-     ("Stmt",["[[Stmt]]","[Dec]","Exp","Pat"]),-     ("Strict",[]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TySynEqn",["[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),-     ("TyVarBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("Type (aka Kind, aka Pred)",["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),-     ("Word#",[]),-     ("Word8",["Word#"]),-     ("[(Guard, Exp)]",["(Guard, Exp)","[]"]),-     ("[(Name, Exp)]",["[]","(Name, Exp) (aka FieldExp)"]),-     ("[(Name, Pat)]",["[]","(Name, Pat) (aka FieldPat)"]),-     ("[(Name, Strict, Type)]",["[]","(Name, Strict, Type) (aka VarStrictType)"]),-     ("[(Strict, Type)]",["[]","(Strict, Type) (aka StrictType)"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[Clause]",["Clause","[]"]),-     ("[Con]",["Con","[]"]),-     ("[Dec]",["Dec","[]"]),-     ("[Exp]",["Exp","[]"]),-     ("[FunDep]",["FunDep","[]"]),-     ("[Match]",["Match","[]"]),-     ("[Name]",["Name","[]"]),-     ("[Pat]",["Pat","[]"]),-     ("[Role]",["Role","[]"]),-     ("[RuleBndr]",["RuleBndr","[]"]),-     ("[Stmt]",["Stmt","[]"]),-     ("[TySynEqn]",["TySynEqn","[]"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[Type] (aka Cxt)",["[]","Type (aka Kind, aka Pred)"]),-     ("[Word8]",["Word8","[]"]),-     ("[[Stmt]]",["[Stmt]","[]"]),-     ("[]",[]),-     ("a",[])-#else-     ("(,)",[]),-     ("(,) Guard",["Guard","(,)"]),-     ("(,) Name",["Name","(,)"]),-     ("(,) Strict",["Strict","(,)"]),-     ("(,,)",[]),-     ("(,,) Name",["Name","(,,)"]),-     ("(,,) Name Strict",["(,,) Name","Strict"]),-     ("(Guard, Exp)",["(,) Guard","Exp"]),-     ("(Name, Exp) (aka FieldExp)",["(,) Name","Exp"]),-     ("(Name, Pat) (aka FieldPat)",["(,) Name","Pat"]),-     ("(Name, Strict, Type) (aka VarStrictType)",["(,,) Name Strict","Type (aka Kind)"]),-     ("(Strict, Type) (aka StrictType)",["(,) Strict","Type (aka Kind)"]),-     ("AnnTarget",["Name"]),-     ("Body",["[(Guard, Exp)]","Exp"]),-     ("ByteArray#",[]),-     ("Callconv",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Clause",["[Dec]","[Pat]","Body"]),-     ("Con",["[(Name, Strict, Type)]","[(Strict, Type)]","[TyVarBndr]","Name","[Pred] (aka Cxt)","(Strict, Type) (aka StrictType)"]),-     ("Dec",["Maybe Type","[Clause]","[Con]","[Dec]","[FunDep]","[Name]","[Role]","[TySynEqn]","[TyVarBndr]","[Type]","Body","Con","FamFlavour","Fixity","Foreign","Name","Pat","Pragma","TySynEqn","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("Exp",["Maybe Exp","[(Guard, Exp)]","[(Name, Exp)]","[Dec]","[Exp]","[Match]","[Pat]","[Stmt]","Lit","Name","Range","Type (aka Kind)"]),-     ("FamFlavour",[]),-     ("Fixity",["Int","FixityDirection"]),-     ("FixityDirection",[]),-     ("Foreign",["Callconv","Name","Safety","[Char] (aka String)","Type (aka Kind)"]),-     ("FunDep",["[Name]"]),-     ("Guard",["[Stmt]","Exp"]),-     ("Inline",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["ByteArray#","Int#"]),-     ("Lit",["[Word8]","Char","Integer","[Char] (aka String)","Ratio Integer (aka Rational)"]),-     ("Match",["[Dec]","Body","Pat"]),-     ("Maybe",["a"]),-     ("Maybe Exp",["Maybe","Exp"]),-     ("Maybe Inline",["Maybe","Inline"]),-     ("Maybe Type",["Maybe","Type (aka Kind)"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int#","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("Pat",["[(Name, Pat)]","[Pat]","Exp","Lit","Name","Type (aka Kind)"]),-     ("Phases",["Int"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pragma",["Maybe Inline","[RuleBndr]","AnnTarget","Exp","Inline","Name","Phases","RuleMatch","[Char] (aka String)","Type (aka Kind)"]),-     ("Pred",["[Type]","Name","Type (aka Kind)"]),-     ("Range",["Exp"]),-     ("Ratio",["a"]),-     ("Ratio Integer (aka Rational)",["Ratio","Integer"]),-     ("Role",[]),-     ("RuleBndr",["Name","Type (aka Kind)"]),-     ("RuleMatch",[]),-     ("Safety",[]),-     ("Stmt",["[[Stmt]]","[Dec]","Exp","Pat"]),-     ("Strict",[]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TySynEqn",["[Type]","Type (aka Kind)"]),-     ("TyVarBndr",["Name","Type (aka Kind)"]),-     ("Type (aka Kind)",["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),-     ("Word#",[]),-     ("Word8",["Word#"]),-     ("[(Guard, Exp)]",["(Guard, Exp)","[]"]),-     ("[(Name, Exp)]",["[]","(Name, Exp) (aka FieldExp)"]),-     ("[(Name, Pat)]",["[]","(Name, Pat) (aka FieldPat)"]),-     ("[(Name, Strict, Type)]",["[]","(Name, Strict, Type) (aka VarStrictType)"]),-     ("[(Strict, Type)]",["[]","(Strict, Type) (aka StrictType)"]),-     ("[Char] (aka String)",["Char","[]"]),-     ("[Clause]",["Clause","[]"]),-     ("[Con]",["Con","[]"]),-     ("[Dec]",["Dec","[]"]),-     ("[Exp]",["Exp","[]"]),-     ("[FunDep]",["FunDep","[]"]),-     ("[Match]",["Match","[]"]),-     ("[Name]",["Name","[]"]),-     ("[Pat]",["Pat","[]"]),-     ("[Pred] (aka Cxt)",["Pred","[]"]),-     ("[Role]",["Role","[]"]),-     ("[RuleBndr]",["RuleBndr","[]"]),-     ("[Stmt]",["Stmt","[]"]),-     ("[TySynEqn]",["TySynEqn","[]"]),-     ("[TyVarBndr]",["TyVarBndr","[]"]),-     ("[Type]",["[]","Type (aka Kind)"]),-     ("[Word8]",["Word8","[]"]),-     ("[[Stmt]]",["[Stmt]","[]"]),-     ("[]",[]),-     ("a",[])-#endif-    ]--arity0DecEdges :: Set (String, [String])-arity0DecEdges =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     ("(Guard, Exp)",["Exp","Guard"]),-     ("(Name, Exp) (aka FieldExp)",["Exp","Name"]),-     ("(Name, Pat) (aka FieldPat)",["Name","Pat"]),-     ("(Name, Strict, Type) (aka VarStrictType)",["Name","Strict","Type (aka Kind, aka Pred)"]),-     ("(Strict, Type) (aka StrictType)",["Strict","Type (aka Kind, aka Pred)"]),-     ("AnnTarget",["Name"]),-     ("BigNat",["ByteArray#"]),-     ("Body",["[(Guard, Exp)]","Exp"]),-     ("ByteArray#",[]),-     ("Callconv",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Clause",["[Dec]","[Pat]","Body"]),-     ("Con",["[(Name, Strict, Type)]","[(Strict, Type)]","[TyVarBndr]","Name","[Type] (aka Cxt)","(Strict, Type) (aka StrictType)"]),-     ("Dec",["Maybe Type","[Clause]","[Con]","[Dec]","[FunDep]","[Name]","[Role]","[TySynEqn]","[TyVarBndr]","Body","Con","FamFlavour","Fixity","Foreign","Name","Pat","Pragma","TySynEqn","[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),-     ("Exp",["Maybe Exp","[(Guard, Exp)]","[(Name, Exp)]","[Dec]","[Exp]","[Match]","[Pat]","[Stmt]","Lit","Name","Range","Type (aka Kind, aka Pred)"]),-     ("FamFlavour",[]),-     ("Fixity",["Int","FixityDirection"]),-     ("FixityDirection",[]),-     ("Foreign",["Callconv","Name","Safety","[Char] (aka String)","Type (aka Kind, aka Pred)"]),-     ("FunDep",["[Name]"]),-     ("Guard",["[Stmt]","Exp"]),-     ("Inline",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["Int#","BigNat"]),-     ("Lit",["[Word8]","Char","Integer","[Char] (aka String)","Ratio Integer (aka Rational)"]),-     ("Match",["[Dec]","Body","Pat"]),-     ("Maybe Exp",["Exp"]),-     ("Maybe Inline",["Inline"]),-     ("Maybe Type",["Type (aka Kind, aka Pred)"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("Pat",["[(Name, Pat)]","[Pat]","Exp","Lit","Name","Type (aka Kind, aka Pred)"]),-     ("Phases",["Int"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pragma",["Maybe Inline","[RuleBndr]","Int","AnnTarget","Exp","Inline","Name","Phases","RuleMatch","[Char] (aka String)","Type (aka Kind, aka Pred)"]),-     ("Range",["Exp"]),-     ("Ratio Integer (aka Rational)",["Integer"]),-     ("Role",[]),-     ("RuleBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("RuleMatch",[]),-     ("Safety",[]),-     ("Stmt",["[[Stmt]]","[Dec]","Exp","Pat"]),-     ("Strict",[]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TySynEqn",["[Type] (aka Cxt)","Type (aka Kind, aka Pred)"]),-     ("TyVarBndr",["Name","Type (aka Kind, aka Pred)"]),-     ("Type (aka Kind, aka Pred)",["[TyVarBndr]","Int","Name","TyLit","[Type] (aka Cxt)"]),-     ("Word#",[]),-     ("Word8",["Word#"]),-     ("[(Guard, Exp)]",["(Guard, Exp)"]),-     ("[(Name, Exp)]",["(Name, Exp) (aka FieldExp)"]),-     ("[(Name, Pat)]",["(Name, Pat) (aka FieldPat)"]),-     ("[(Name, Strict, Type)]",["(Name, Strict, Type) (aka VarStrictType)"]),-     ("[(Strict, Type)]",["(Strict, Type) (aka StrictType)"]),-     ("[Char] (aka String)",["Char"]),-     ("[Clause]",["Clause"]),-     ("[Con]",["Con"]),-     ("[Dec]",["Dec"]),-     ("[Exp]",["Exp"]),-     ("[FunDep]",["FunDep"]),-     ("[Match]",["Match"]),-     ("[Name]",["Name"]),-     ("[Pat]",["Pat"]),-     ("[Role]",["Role"]),-     ("[RuleBndr]",["RuleBndr"]),-     ("[Stmt]",["Stmt"]),-     ("[TySynEqn]",["TySynEqn"]),-     ("[TyVarBndr]",["TyVarBndr"]),-     ("[Type] (aka Cxt)",["Type (aka Kind, aka Pred)"]),-     ("[Word8]",["Word8"]),-     ("[[Stmt]]",["[Stmt]"])-#else-     ("(Guard, Exp)",["Exp","Guard"]),-     ("(Name, Exp) (aka FieldExp)",["Exp","Name"]),-     ("(Name, Pat) (aka FieldPat)",["Name","Pat"]),-     ("(Name, Strict, Type) (aka VarStrictType)",["Name","Strict","Type (aka Kind)"]),-     ("(Strict, Type) (aka StrictType)",["Strict","Type (aka Kind)"]),-     ("AnnTarget",["Name"]),-     ("Body",["[(Guard, Exp)]","Exp"]),-     ("ByteArray#",[]),-     ("Callconv",[]),-     ("Char",["Char#"]),-     ("Char#",[]),-     ("Clause",["[Dec]","[Pat]","Body"]),-     ("Con",["[(Name, Strict, Type)]","[(Strict, Type)]","[TyVarBndr]","Name","[Pred] (aka Cxt)","(Strict, Type) (aka StrictType)"]),-     ("Dec",["Maybe Type","[Clause]","[Con]","[Dec]","[FunDep]","[Name]","[Role]","[TySynEqn]","[TyVarBndr]","[Type]","Body","Con","FamFlavour","Fixity","Foreign","Name","Pat","Pragma","TySynEqn","[Pred] (aka Cxt)","Type (aka Kind)"]),-     ("Exp",["Maybe Exp","[(Guard, Exp)]","[(Name, Exp)]","[Dec]","[Exp]","[Match]","[Pat]","[Stmt]","Lit","Name","Range","Type (aka Kind)"]),-     ("FamFlavour",[]),-     ("Fixity",["Int","FixityDirection"]),-     ("FixityDirection",[]),-     ("Foreign",["Callconv","Name","Safety","[Char] (aka String)","Type (aka Kind)"]),-     ("FunDep",["[Name]"]),-     ("Guard",["[Stmt]","Exp"]),-     ("Inline",[]),-     ("Int",["Int#"]),-     ("Int#",[]),-     ("Integer",["ByteArray#","Int#"]),-     ("Lit",["[Word8]","Char","Integer","[Char] (aka String)","Ratio Integer (aka Rational)"]),-     ("Match",["[Dec]","Body","Pat"]),-     ("Maybe Exp",["Exp"]),-     ("Maybe Inline",["Inline"]),-     ("Maybe Type",["Type (aka Kind)"]),-     ("ModName",["[Char] (aka String)"]),-     ("Name",["NameFlavour","OccName"]),-     ("NameFlavour",["Int#","ModName","NameSpace","PkgName"]),-     ("NameSpace",[]),-     ("OccName",["[Char] (aka String)"]),-     ("Pat",["[(Name, Pat)]","[Pat]","Exp","Lit","Name","Type (aka Kind)"]),-     ("Phases",["Int"]),-     ("PkgName",["[Char] (aka String)"]),-     ("Pragma",["Maybe Inline","[RuleBndr]","AnnTarget","Exp","Inline","Name","Phases","RuleMatch","[Char] (aka String)","Type (aka Kind)"]),-     ("Pred",["[Type]","Name","Type (aka Kind)"]),-     ("Range",["Exp"]),-     ("Ratio Integer (aka Rational)",["Integer"]),-     ("Role",[]),-     ("RuleBndr",["Name","Type (aka Kind)"]),-     ("RuleMatch",[]),-     ("Safety",[]),-     ("Stmt",["[[Stmt]]","[Dec]","Exp","Pat"]),-     ("Strict",[]),-     ("TyLit",["Integer","[Char] (aka String)"]),-     ("TySynEqn",["[Type]","Type (aka Kind)"]),-     ("TyVarBndr",["Name","Type (aka Kind)"]),-     ("Type (aka Kind)",["[TyVarBndr]","Int","Name","TyLit","[Pred] (aka Cxt)"]),-     ("Word#",[]),-     ("Word8",["Word#"]),-     ("[(Guard, Exp)]",["(Guard, Exp)"]),-     ("[(Name, Exp)]",["(Name, Exp) (aka FieldExp)"]),-     ("[(Name, Pat)]",["(Name, Pat) (aka FieldPat)"]),-     ("[(Name, Strict, Type)]",["(Name, Strict, Type) (aka VarStrictType)"]),-     ("[(Strict, Type)]",["(Strict, Type) (aka StrictType)"]),-     ("[Char] (aka String)",["Char"]),-     ("[Clause]",["Clause"]),-     ("[Con]",["Con"]),-     ("[Dec]",["Dec"]),-     ("[Exp]",["Exp"]),-     ("[FunDep]",["FunDep"]),-     ("[Match]",["Match"]),-     ("[Name]",["Name"]),-     ("[Pat]",["Pat"]),-     ("[Pred] (aka Cxt)",["Pred"]),-     ("[Role]",["Role"]),-     ("[RuleBndr]",["RuleBndr"]),-     ("[Stmt]",["Stmt"]),-     ("[TySynEqn]",["TySynEqn"]),-     ("[TyVarBndr]",["TyVarBndr"]),-     ("[Type]",["Type (aka Kind)"]),-     ("[Word8]",["Word8"]),-     ("[[Stmt]]",["[Stmt]"])-#endif-    ]--arity0SubtypesOfDec :: Set String-arity0SubtypesOfDec =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     "(Guard, Exp)","(Name, Exp) (aka FieldExp)","(Name, Pat) (aka FieldPat)","(Name, Strict, Type) (aka VarStrictType)","(Strict, Type) (aka StrictType)","AnnTarget","BigNat","Body","ByteArray#","Callconv","Char","Char#","Clause","Con","Dec","Exp","FamFlavour","Fixity","FixityDirection","Foreign","FunDep","Guard","Inline","Int","Int#","Integer","Lit","Match","Maybe Exp","Maybe Inline","Maybe Type","ModName","Name","NameFlavour","NameSpace","OccName","Pat","Phases","PkgName","Pragma","Range","Ratio Integer (aka Rational)","Role","RuleBndr","RuleMatch","Safety","Stmt","Strict","TyLit","TySynEqn","TyVarBndr","Type (aka Kind, aka Pred)","Word#","Word8","[(Guard, Exp)]","[(Name, Exp)]","[(Name, Pat)]","[(Name, Strict, Type)]","[(Strict, Type)]","[Char] (aka String)","[Clause]","[Con]","[Dec]","[Exp]","[FunDep]","[Match]","[Name]","[Pat]","[Role]","[RuleBndr]","[Stmt]","[TySynEqn]","[TyVarBndr]","[Type] (aka Cxt)","[Word8]","[[Stmt]]"-#else-     "(Guard, Exp)","(Name, Exp) (aka FieldExp)","(Name, Pat) (aka FieldPat)","(Name, Strict, Type) (aka VarStrictType)","(Strict, Type) (aka StrictType)","AnnTarget","Body","ByteArray#","Callconv","Char","Char#","Clause","Con","Dec","Exp","FamFlavour","Fixity","FixityDirection","Foreign","FunDep","Guard","Inline","Int","Int#","Integer","Lit","Match","Maybe Exp","Maybe Inline","Maybe Type","ModName","Name","NameFlavour","NameSpace","OccName","Pat","Phases","PkgName","Pragma","Pred","Range","Ratio Integer (aka Rational)","Role","RuleBndr","RuleMatch","Safety","Stmt","Strict","TyLit","TySynEqn","TyVarBndr","Type (aka Kind)","Word#","Word8","[(Guard, Exp)]","[(Name, Exp)]","[(Name, Pat)]","[(Name, Strict, Type)]","[(Strict, Type)]","[Char] (aka String)","[Clause]","[Con]","[Dec]","[Exp]","[FunDep]","[Match]","[Name]","[Pat]","[Pred] (aka Cxt)","[Role]","[RuleBndr]","[Stmt]","[TySynEqn]","[TyVarBndr]","[Type]","[Word8]","[[Stmt]]"-#endif-    ]--subtypesOfDec :: Set String-subtypesOfDec =-    union-       arity0SubtypesOfDec-       (Set.fromList-           [ "(,)"-           , "(,) Guard"-           , "(,) Name"-           , "(,) Strict"-           , "(,,)"-           , "(,,) Name"-           , "(,,) Name Strict"-           , "Maybe"-           , "Ratio"-           , "[]"-           , "a"-           ])--simpleSubtypesOfDec :: Set String-simpleSubtypesOfDec =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-              "BigNat",-              "Type (aka Kind, aka Pred)",-              "[Type] (aka Cxt)",-#else-              "Pred",-              "[Pred] (aka Cxt)",-              "Type (aka Kind)",-              "[Type]",-#endif-              "(,)",-              "(,) Guard",-              "(,) Name",-              "(,) Strict",-              "(,,)",-              "(,,) Name",-              "(,,) Name Strict",-              "(Guard, Exp)",-              "(Name, Exp) (aka FieldExp)",-              "(Name, Pat) (aka FieldPat)",-              "(Name, Strict, Type) (aka VarStrictType)",-              "(Strict, Type) (aka StrictType)",-              "AnnTarget",-              "Body",-              "ByteArray#",-              "Callconv",-              "Char",-              "Char#",-              "Clause",-              "Con",-              "Dec",-              "Exp",-              "FamFlavour",-              "Fixity",-              "FixityDirection",-              "Foreign",-              "FunDep",-              "Guard",-              "Inline",-              "Int",-              "Int#",-              "Integer",-              "Lit",-              "Match",-              "Maybe",-              "Maybe Exp",-              "Maybe Inline",-              "Maybe Type",-              "ModName",-              "Name",-              "NameFlavour",-              "NameSpace",-              "OccName",-              "Pat",-              "Phases",-              "PkgName",-              "Pragma",-              "Range",-              "Ratio",-              "Ratio Integer (aka Rational)",-              "Role",-              "RuleBndr",-              "RuleMatch",-              "Safety",-              "Stmt",-              "Strict",-              "TyLit",-              "TySynEqn",-              "TyVarBndr",-              "Word#",-              "Word8",-              "[(Guard, Exp)]",-              "[(Name, Exp)]",-              "[(Name, Pat)]",-              "[(Name, Strict, Type)]",-              "[(Strict, Type)]",-              "[Char] (aka String)",-              "[Clause]",-              "[Con]",-              "[Dec]",-              "[Exp]",-              "[FunDep]",-              "[Match]",-              "[Name]",-              "[Pat]",-              "[Role]",-              "[RuleBndr]",-              "[Stmt]",-              "[TySynEqn]",-              "[TyVarBndr]",-              "[Word8]",-              "[[Stmt]]",-              "[]",-              "a"-    ]--bitsInstances :: Set String-bitsInstances =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-      "instance Bits CChar","instance Bits CInt","instance Bits CIntMax","instance Bits CIntPtr","instance Bits CLLong","instance Bits CLong","instance Bits CPtrdiff","instance Bits CSChar","instance Bits CShort","instance Bits CSigAtomic","instance Bits CSize","instance Bits CUChar","instance Bits CUInt","instance Bits CUIntMax","instance Bits CUIntPtr","instance Bits CULLong","instance Bits CULong","instance Bits CUShort","instance Bits CWchar",-#endif-      "instance Bits Bool","instance Bits Int","instance Bits Integer","instance Bits Word","instance Bits Word16","instance Bits Word32","instance Bits Word64","instance Bits Word8",-      -- These come and go depending on the version of something.-      "instance Bits Int16","instance Bits Int32","instance Bits Int64","instance Bits Int8","instance Bits Natural"-    ]--enumInstances :: Set String-enumInstances =-  Set.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-      "instance Enum (Fixed a)","instance Enum (Proxy s)","instance Enum (f a) => Enum (Alt f a)","instance Enum CChar","instance Enum CClock","instance Enum CDouble","instance Enum CFloat","instance Enum CInt","instance Enum CIntMax","instance Enum CIntPtr","instance Enum CLLong","instance Enum CLong","instance Enum CPtrdiff","instance Enum CSChar","instance Enum CSUSeconds","instance Enum CShort","instance Enum CSigAtomic","instance Enum CSize","instance Enum CTime","instance Enum CUChar","instance Enum CUInt","instance Enum CUIntMax","instance Enum CUIntPtr","instance Enum CULLong","instance Enum CULong","instance Enum CUSeconds","instance Enum CUShort","instance Enum CWchar","instance Enum Day","instance Enum NominalDiffTime",-#endif-      "instance Enum ()","instance Enum Bool","instance Enum Char","instance Enum Double","instance Enum Float","instance Enum Int","instance Enum Int16","instance Enum Int32","instance Enum Int64","instance Enum Int8","instance Enum Integer","instance Enum Natural","instance Enum Ordering","instance Enum Word","instance Enum Word16","instance Enum Word32","instance Enum Word64","instance Enum Word8","instance Integral a => Enum (Ratio a)"-    ]--arrayInstances :: Set String-arrayInstances =-  Set.fromList-    ["instance IArray UArray (FunPtr a)","instance IArray UArray (Ptr a)","instance IArray UArray (StablePtr a)","instance IArray UArray Bool","instance IArray UArray Char","instance IArray UArray Double","instance IArray UArray Float","instance IArray UArray Int","instance IArray UArray Int16","instance IArray UArray Int32","instance IArray UArray Int64","instance IArray UArray Int8","instance IArray UArray Word","instance IArray UArray Word16","instance IArray UArray Word32","instance IArray UArray Word64","instance IArray UArray Word8"]--decTypeSynonyms :: Map (E Type) ((), Set Name)-decTypeSynonyms =-  Map.fromList-    [-#if MIN_VERSION_template_haskell(2,10,0)-     (E (AppT (AppT (AppT (TupleT 3) (ConT ''Name)) (ConT ''Strict)) (ConT ''Type)), ((), Set.fromList [''VarStrictType])),-     (E (AppT (AppT (TupleT 2) (ConT ''Name)) (ConT ''Exp)),                         ((), Set.fromList [''FieldExp])),-     (E (AppT (AppT (TupleT 2) (ConT ''Name)) (ConT ''Pat)),                         ((), Set.fromList [''FieldPat])),-     (E (AppT (AppT (TupleT 2) (ConT ''Strict)) (ConT ''Type)),                      ((), Set.fromList [''StrictType])),-     (E (AppT (ConT ''Ratio) (ConT ''Integer)),                                      ((), Set.fromList [''Rational])),-     (E (AppT ListT (ConT ''Char)),                                                  ((), Set.fromList [''String])),-     (E (AppT ListT (ConT ''Type)),                                                  ((), Set.fromList [''Cxt])),-     (E (ConT ''Type),                                                               ((), Set.fromList [''Kind,''Pred]))-#else-     (E (AppT (AppT (AppT (TupleT 3) (ConT ''Name)) (ConT ''Strict)) (ConT ''Type)), ((), Set.fromList [''VarStrictType])),-     (E (AppT (AppT (TupleT 2) (ConT ''Name)) (ConT ''Exp)),                         ((), Set.fromList [''FieldExp])),-     (E (AppT (AppT (TupleT 2) (ConT ''Name)) (ConT ''Pat)),                         ((), Set.fromList [''FieldPat])),-     (E (AppT (AppT (TupleT 2) (ConT ''Strict)) (ConT ''Type)),                      ((), Set.fromList [''StrictType])),-     (E (AppT (ConT ''Ratio) (ConT ''Integer)),                                      ((), Set.fromList [''Rational])),-     (E (AppT ListT (ConT ''Char)),                                                  ((), Set.fromList [''String])),-     (E (AppT ListT (ConT ''Pred)),                                                  ((), Set.fromList [''Cxt])),-     (E (ConT ''Type),                                                               ((), Set.fromList [''Kind]))-#endif-    ]
th-typegraph.cabal view
@@ -1,5 +1,5 @@ name:               th-typegraph-version:            0.35.1+version:            1.0 cabal-version:      >= 1.10 build-type:         Simple license:            BSD3@@ -11,52 +11,45 @@ bug-reports:        https://github.com/seereason/th-typegraph/issues stability:          experimental synopsis:           Graph of the subtype relation-description:        Build a graph whose nodes are Types and whose edges represent-                    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+description:        This package is not the successor to th-typegraph-0.43, it is+                    a brand new package which forms the basis of a new package that+                    what will eventually do what th-typegraph was supposed to.  What+                    it *can* do is traverse the type "TypeQ", and includes versions+                    of deriveSafeCopy and derivePathInfo that use the traversal to+                    avoid adding phantom types to the context of the instance. tested-with: GHC == 7.10.3, GHC == 7.11.* library   default-language: Haskell2010-  hs-source-dirs: .+  hs-source-dirs: src   ghc-options: -Wall -O2   exposed-modules:-    Language.Haskell.TH.TypeGraph.Arity-    Language.Haskell.TH.TypeGraph.Edges-    Language.Haskell.TH.TypeGraph.Free-    Language.Haskell.TH.TypeGraph.Lens-    Language.Haskell.TH.TypeGraph.Prelude-    Language.Haskell.TH.TypeGraph.Shape-    Language.Haskell.TH.TypeGraph.Stack-    Language.Haskell.TH.TypeGraph.TypeGraph-    Language.Haskell.TH.TypeGraph.TypeInfo-    Language.Haskell.TH.TypeGraph.Vertex+    Language.Haskell.TH.TypeGraph.Orphans+    Language.Haskell.TH.TypeGraph.Phantom+    Language.Haskell.TH.TypeGraph.SafeCopyDerive+    Language.Haskell.TH.TypeGraph.TypeTraversal+    Language.Haskell.TH.TypeGraph.WebRoutesTH   build-depends:+    aeson,     base >= 4.8 && < 5,-    base-compat,+    cereal,     containers,-    data-default,-    haskell-src-exts,+    fgl,     lens,     mtl,-    mtl-unleashed >= 0.5,+    parsec,     pretty >= 1.1.2,-    set-extra,+    safecopy,+    split,     syb,     template-haskell >= 2.10,-    th-context,+    text,     th-desugar,+    th-lift,     th-lift-instances >= 0.1.7,-    th-orphans >= 0.10.0--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,-                    th-typegraph, th-desugar, th-orphans, th-reify-many-  default-language: Haskell2010+    th-orphans,+    time,+    userid,+    web-routes  source-repository head   type:     git