th-typegraph 0.21 → 0.23
raw patch · 11 files changed
+188/−183 lines, 11 filesdep +memoize
Dependencies added: memoize
Files
- Language/Haskell/TH/TypeGraph/Edges.hs +38/−42
- Language/Haskell/TH/TypeGraph/Expand.hs +13/−2
- Language/Haskell/TH/TypeGraph/Graph.hs +41/−76
- Language/Haskell/TH/TypeGraph/Info.hs +31/−26
- Language/Haskell/TH/TypeGraph/Prelude.hs +9/−1
- Language/Haskell/TH/TypeGraph/Shape.hs +5/−0
- Language/Haskell/TH/TypeGraph/Stack.hs +20/−4
- Language/Haskell/TH/TypeGraph/Vertex.hs +11/−13
- test/Common.hs +4/−4
- test/TypeGraph.hs +14/−14
- th-typegraph.cabal +2/−1
Language/Haskell/TH/TypeGraph/Edges.hs view
@@ -35,13 +35,11 @@ import Control.Monad (filterM) import Control.Monad.Reader (MonadReader) import Control.Monad.State (execStateT, modify, StateT)-import Data.Default (Default(def)) import Data.Foldable import Data.List as List (filter, intercalate, 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.Monoid ((<>)) 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)@@ -49,23 +47,23 @@ import Language.Haskell.TH.TypeGraph.Expand (E(E), expandType) import Language.Haskell.TH.TypeGraph.Info (TypeInfo, infoMap, typeSet, allVertices, fieldVertex, typeVertex') import Language.Haskell.TH.TypeGraph.Prelude (pprint')-import Language.Haskell.TH.TypeGraph.Vertex (simpleVertex, TGV, TGVSimple)+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 node key = Map key (node, Set key)+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 node m. (DsMonad m, Functor m, Default node, MonadReader TypeInfo m) =>- m (GraphEdges node TGV)+typeGraphEdges :: forall m. (DsMonad m, Functor m, MonadReader TypeInfo m) =>+ m (GraphEdges TGV) typeGraphEdges = do execStateT (view typeSet >>= mapM_ (\t -> expandType t >>= doType)) mempty where- doType :: E Type -> StateT (GraphEdges node TGV) m ()+ doType :: E Type -> StateT (GraphEdges TGV) m () doType typ = do vs <- allVertices Nothing typ mapM_ node vs@@ -80,25 +78,25 @@ doType (E typ2) _ -> return () - doInfo :: Set TGV -> Info -> StateT (GraphEdges node TGV) m ()+ doInfo :: Set TGV -> Info -> StateT (GraphEdges TGV) m () doInfo vs (TyConI dec) = doDec vs dec -- doInfo vs (PrimTyConI tname _ _) = return () doInfo _ _ = return () - doDec :: Set TGV -> Dec -> StateT (GraphEdges node TGV) m ()+ doDec :: Set TGV -> Dec -> StateT (GraphEdges TGV) m () doDec _ (TySynD _ _ _) = return () -- This type will be in typeSet doDec vs (NewtypeD _ tname _ constr _) = doCon vs tname constr doDec vs (DataD _ tname _ constrs _) = mapM_ (doCon vs tname) constrs doDec _ _ = return () - doCon :: Set TGV -> Name -> Con -> StateT (GraphEdges node TGV) m ()+ doCon :: Set TGV -> Name -> Con -> StateT (GraphEdges TGV) m () doCon vs tname (ForallC _ _ con) = doCon vs tname con doCon vs tname (NormalC cname flds) = mapM_ (uncurry (doField vs tname cname)) (List.map (\ (n, (_, ftype)) -> (Left n, ftype)) (zip [1..] flds)) doCon vs tname (RecC cname flds) = mapM_ (uncurry (doField vs tname cname)) (List.map (\ (fname, _, ftype) -> (Right fname, ftype)) flds) doCon vs tname (InfixC (_, lhs) cname (_, rhs)) = doField vs tname cname (Left 1) lhs >> doField vs tname cname (Left 2) rhs -- Connect the vertex for this record type to one particular field vertex- doField :: DsMonad m => Set TGV -> Name -> Name -> Either Int Name -> Type -> StateT (GraphEdges node TGV) m ()+ doField :: DsMonad m => Set TGV -> Name -> Name -> Either Int Name -> Type -> StateT (GraphEdges TGV) m () doField vs tname cname fld ftyp = do v2 <- expandType ftyp >>= fieldVertex (tname, cname, fld) v3 <- expandType ftyp >>= typeVertex'@@ -107,64 +105,64 @@ -- Here's where we don't recurse, see? -- doVertex v2 - node :: TGV -> StateT (GraphEdges node TGV) m ()+ node :: TGV -> StateT (GraphEdges TGV) m () -- node v = pass (return ((), (Map.alter (Just . maybe (def, Set.empty) id) v)))- node v = modify (Map.alter (Just . maybe (def, Set.empty) id) v)+ node v = modify (Map.alter (Just . maybe (Set.empty) id) v) - edge :: TGV -> TGV -> StateT (GraphEdges node TGV) m ()+ edge :: TGV -> TGV -> StateT (GraphEdges TGV) m () edge v1 v2 = node v2 >> modify f- where f :: GraphEdges node TGV -> GraphEdges node TGV+ where f :: GraphEdges TGV -> GraphEdges TGV f = Map.alter g v1- g :: (Maybe (node, Set TGV) -> Maybe (node, Set TGV))- g = Just . maybe (def, singleton v2) (over _2 (Set.insert v2))+ g :: (Maybe (Set TGV) -> Maybe (Set TGV))+ g = Just . maybe (singleton v2) (Set.insert v2) -instance Ppr key => Ppr (GraphEdges node key) where+instance Ppr key => Ppr (GraphEdges key) where ppr x = ptext $ intercalate "\n " $ "edges:" : (List.map- (\(k, (_, ks)) -> intercalate "\n " ((pprint' k ++ " ->" ++ if null ks then " []" else "") : List.map pprint' (Set.toList ks)))+ (\(k, ks) -> intercalate "\n " ((pprint' k ++ " ->" ++ if null ks then " []" else "") : List.map pprint' (Set.toList ks))) (Map.toList x)) -- | Isolate and remove matching nodes-cut :: (Eq a, Ord a) => (a -> Bool) -> GraphEdges node a -> GraphEdges node a+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 node a -> m (GraphEdges node a)+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 node a -> (GraphEdges node a)-cutEdges p edges = Map.mapWithKey (\key (hint, gkeys) -> (hint, Set.filter (\gkey -> not (p key gkey)) gkeys)) 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 node a -> m (GraphEdges node a)+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, (h, _)), s') -> (a, (h, Set.fromList s'))) (zip pairs ss)+ 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 node a -> GraphEdges node a+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 node a -> m (GraphEdges node a)+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 node a -> GraphEdges node a+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 node a -> GraphEdges node a+ 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 (node, _)) -> Just (node, s)) a 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 node a -> m (GraphEdges node a)+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@@ -173,18 +171,18 @@ -- | Remove matching nodes and extend each of their in-edges to each of -- their out-edges.-dissolve :: (Eq a, Ord a) => (a -> Bool) -> GraphEdges node a -> GraphEdges node a+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)+ 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 (\(h, s) -> (h, if Set.member v s then Set.union vs (Set.delete v s) else s)) es+ 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 node a -> m (GraphEdges node a)+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@@ -192,9 +190,7 @@ -- | Simplify a graph by throwing away the field information in each -- node. This means the nodes only contain the fully expanded Type -- value (and any type synonyms.)-simpleEdges :: Monoid node => GraphEdges node TGV -> GraphEdges node TGVSimple-simpleEdges = Map.mapWithKey (\v (n, s) -> (n, Set.delete v s)) . -- delete any self edges- Map.mapKeysWith combine simpleVertex . -- simplify each vertex- Map.map (over _2 (Set.map simpleVertex)) -- simplify the out edges- where- combine (n1, s1) (n2, s2) = (n1 <> n2, Set.union s1 s2)+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/Expand.hs view
@@ -33,13 +33,24 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif+import Data.Function.Memoize (deriveMemoizable, memoize) import Language.Haskell.Exts.Syntax () import Language.Haskell.TH import Language.Haskell.TH.Desugar as DS (DsMonad, dsType, expand, typeToTH) import Language.Haskell.TH.Instances ()-import Language.Haskell.TH.Syntax (Lift(lift))+import Language.Haskell.TH.Syntax -- (Lift(lift)) import Prelude hiding (pred) +$(deriveMemoizable ''Type)+$(deriveMemoizable ''Name)+$(deriveMemoizable ''TyLit)+$(deriveMemoizable ''NameFlavour)+$(deriveMemoizable ''OccName)+$(deriveMemoizable ''NameSpace)+$(deriveMemoizable ''TyVarBndr)+$(deriveMemoizable ''ModName)+$(deriveMemoizable ''PkgName)+ -- | This class lets us use the same expand* functions to work with -- specially marked expanded types or with the original types. class Expanded un ex | ex -> un where@@ -48,7 +59,7 @@ -- | Apply the th-desugar expand function to a 'Type' and mark it as expanded. expandType :: (DsMonad m, Expanded Type e) => Type -> m e-expandType typ = markExpanded <$> DS.typeToTH <$> (DS.dsType typ >>= DS.expand)+expandType = memoize $ \typ -> markExpanded <$> DS.typeToTH <$> (DS.dsType typ >>= DS.expand) -- | Apply the th-desugar expand function to a 'Pred' and mark it as expanded. -- Note that the definition of 'Pred' changed in template-haskell-2.10.0.0.
Language/Haskell/TH/TypeGraph/Graph.hs view
@@ -1,7 +1,5 @@ -- | Abstract operations on Maps containing graph edges. --- FIXME: the sense of the predicates are kinda mixed up here- {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-}@@ -13,10 +11,10 @@ {-# LANGUAGE TypeFamilies #-} module Language.Haskell.TH.TypeGraph.Graph- ( TypeGraph, typeInfo, edges, graph, gsimple- , TypeGraph(TypeGraph, _typeInfo, _edges, _graph, _gsimple, _stack) -- temporary+ ( TypeGraph, typeInfo, edges, graph, gsimple, stack , graphFromMap + , allLensKeys , allPathKeys , allPathStarts , reachableFrom@@ -41,7 +39,6 @@ #endif import Control.Lens -- (makeLenses, over, view) import Control.Monad (when)-import Control.Monad as List (filterM) import Control.Monad.Reader (ask, local, MonadReader, ReaderT, runReaderT) import Control.Monad.State (execStateT, modify, StateT) import Control.Monad.Trans (lift)@@ -49,10 +46,10 @@ import Data.Foldable as Foldable import Data.Graph hiding (edges) import Data.List as List (map)-import Data.Map as Map (alter, update)+import Data.Map as Map (alter, fromList, fromListWith, Map, update) import qualified Data.Map as Map (toList) import Data.Maybe (fromJust, mapMaybe)-import Data.Set.Extra as Set (empty, flatten, filterM, fromList, insert, map, mapM, member, Set, singleton, toList, unions)+import Data.Set.Extra as Set (empty, fromList, insert, map, member, Set, singleton, toList, union, unions) import Data.Traversable as Traversable import Language.Haskell.Exts.Syntax () import Language.Haskell.TH@@ -63,9 +60,9 @@ import Language.Haskell.TH.TypeGraph.Edges (GraphEdges, simpleEdges) import Language.Haskell.TH.TypeGraph.Expand (E(E), expandType) import Language.Haskell.TH.TypeGraph.Info (startTypes, TypeInfo, typeVertex', fieldVertex)-import Language.Haskell.TH.TypeGraph.Prelude (HasSet(getSet, modifySet))+import Language.Haskell.TH.TypeGraph.Prelude (HasSet(getSet, modifySet), adjacent', reachable') import Language.Haskell.TH.TypeGraph.Stack (HasStack(withStack, push), StackElement(StackElement))-import Language.Haskell.TH.TypeGraph.Vertex (simpleVertex, TGV, TGVSimple, vsimple, TypeGraphVertex, etype)+import Language.Haskell.TH.TypeGraph.Vertex (TGV, TGVSimple, vsimple, TypeGraphVertex, etype) import Prelude hiding (any, concat, concatMap, elem, exp, foldr, mapM_, null, or) instance Ppr Vertex where@@ -75,21 +72,21 @@ -- 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 node key. (Ord key) =>- GraphEdges node key -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)+graphFromMap :: forall key. (Ord key) =>+ GraphEdges key -> (Graph, Vertex -> ((), key, [key]), key -> Maybe Vertex) graphFromMap mp = graphFromEdges triples where- triples :: [(node, key, [key])]- triples = List.map (\ (k, (node, ks)) -> (node, k, Foldable.toList ks)) $ Map.toList mp+ triples :: [((), key, [key])]+ triples = List.map (\ (k, ks) -> ((), k, Foldable.toList ks)) $ Map.toList mp data TypeGraph = TypeGraph { _typeInfo :: TypeInfo- , _edges :: GraphEdges () TGV+ , _edges :: GraphEdges TGV , _graph :: (Graph, Vertex -> ((), TGV, [TGV]), TGV -> Maybe Vertex) , _gsimple :: (Graph, Vertex -> ((), TGVSimple, [TGVSimple]), TGVSimple -> Maybe Vertex)- , _stack :: [StackElement] -- this is the only type that isn't available in th-typegraph+ , _stack :: [StackElement] } $(makeLenses ''TypeGraph)@@ -98,47 +95,29 @@ withStack f = ask >>= f . view stack push fld con dec action = local (stack %~ (\s -> StackElement fld con dec : s)) action -#if 0--- | All the types for which we will generate Path types, along with--- the corresponding set of goal types.-allKeys :: (DsMonad m, MonadReader TypeGraph m) => m (Set (TGV, Set TGV, Set TGV))-allKeys = do- (g, vf, kf) <- view graph- -- (gs, vfs, kfs) <- view gsimple- ti <- view typeInfo- st <- runReaderT (Traversable.mapM expandType (view startTypes ti) >>= Traversable.mapM (vertex Nothing)) ti- let st' = mapMaybe kf st- let pt = Set.fromList $ concatMap (reachable g) st'- pt' = Set.map (\(_, key, _) -> key) . Set.map vf $ pt- pt'' = Set.map simpleVertex pt'- Set.mapM (\t -> do goals <- Set.filterM (\g -> goalReachableSimple g t) pt''- let Just v = vf t- (_, _, adjacent) <- kf v- return (t, Set.fromList adjacent, goals)) pt''--allPathKeys :: (DsMonad m, MonadReader TypeGraph m) => m (Set (TGV, TGV))-allPathKeys = (Set.flatten . Set.map (\ (t, s) -> Set.map (t,) s)) <$> allKeys- allPathStarts :: forall m. (DsMonad m, MonadReader TypeGraph m) => m (Set TGV)-allPathStarts = Set.map fst <$> allKeys-#else-allPathKeys :: (DsMonad m, MonadReader TypeGraph m) => m (Set (TGV, TGV))-allPathKeys = do- pathKeys <- allPathStarts- Set.fromList <$> List.filterM (uncurry goalReachableSimple') [ (g, k) | g <- Foldable.toList pathKeys,- k <- Foldable.toList pathKeys ]--allPathStarts :: forall m. (DsMonad m, MonadReader TypeGraph m) => m (Set TGV) allPathStarts = do -- (g, vf, kf) <- graphFromMap <$> view edges (g, vf, kf) <- view graph kernel <- view typeInfo >>= \ti -> runReaderT (Traversable.mapM expandType (view startTypes ti) >>= Traversable.mapM typeVertex') ti- let kernel' = mapMaybe kf kernel- let keep = Set.fromList $ concatMap (reachable g) kernel'- keep' = Set.map (\(_, key, _) -> key) . Set.map vf $ keep+ let keep = Set.fromList $ concatMap (reachable g) (mapMaybe kf kernel)+ keep' = Set.map (view _2) . Set.map vf $ keep return keep'-#endif +-- | Lenses represent steps in a path, but the start point is a type+-- vertex and the endpoint is a field vertex.+allLensKeys :: (DsMonad m, MonadReader TypeGraph m) => m (Map TGVSimple (Set TGV))+allLensKeys = do+ g <- view graph+ gs <- view gsimple+ allPathStarts >>= return . Map.fromListWith Set.union . List.map (\x -> (view vsimple x, Set.fromList (adjacent' g x))) . Set.toList++-- | Paths go between simple types.+allPathKeys :: (DsMonad m, MonadReader TypeGraph m) => m (Map TGVSimple (Set TGVSimple))+allPathKeys = do+ gs <- view gsimple+ allPathStarts >>= return . Map.fromList . List.map (\x -> (x, Set.fromList (reachable' gs x))) . Set.toList . Set.map (view vsimple)+ reachableFrom :: forall m. (DsMonad m, MonadReader TypeGraph m) => TGV -> m (Set TGV) reachableFrom v = do -- (g, vf, kf) <- graphFromMap <$> view edges@@ -163,24 +142,11 @@ goalReachableSimple gkey key0 = isReachable gkey key0 <$> view gsimple goalReachableSimple' :: (Functor m, DsMonad m, MonadReader TypeGraph m) => TGV -> TGV -> m Bool-goalReachableSimple' gkey key0 = isReachable (simpleVertex gkey) (simpleVertex key0) <$> view gsimple+goalReachableSimple' gkey key0 = isReachable (view vsimple gkey) (view vsimple key0) <$> view gsimple 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) -#if 0- es <- view edges- let Just v0 = - Just vf = - return $ - case kf key0 of- Nothing -> error ("isReachable - unknown key: " ++ pprint' key0)- Just key -> do- let gvert = fromMaybe (error $ "Unknown goal type: " ++ pprint' gkey ++ "\n" ++ intercalate "\n " ("known:" : List.map pprint' (Map.keys es))) (kf gkey)- -- Can we reach any node whose type matches (ConT gname)? Fields don't matter.- return $ path g key gvert-#endif- -- | Return the TGV associated with a particular type, -- with no field specified. typeGraphVertex :: (MonadReader TypeGraph m, DsMonad m) => Type -> m TGV@@ -210,7 +176,7 @@ instance Default (VertexStatus typ) where def = Vertex ---- type Edges = GraphEdges () TGV+--- type Edges = GraphEdges TGV -- | Return the set of edges implied by the subtype relationship among -- a set of types. This is just the nodes of the type graph. The@@ -229,27 +195,27 @@ -- lens returned by @View's@ method to convert between @a@ -- and @b@ (i.e. to implement the edge in the type graph.) -> [Type]- -> m (GraphEdges () TGV)+ -> m (GraphEdges TGV) typeGraphEdges' augment types = do- execStateT (mapM_ (\typ -> typeGraphVertex typ >>= doNode) types) (mempty :: GraphEdges () TGV)+ execStateT (mapM_ (\typ -> typeGraphVertex typ >>= doNode) types) (mempty :: GraphEdges TGV) where doNode v = do s <- lift $ getSet when (not (member v s)) $- do lift $ modifySet (insert v)+ do lift $ modifySet (Set.insert v) doNode' v- doNode' :: TGV -> StateT (GraphEdges () TGV) m ()+ doNode' :: TGV -> StateT (GraphEdges TGV) m () doNode' typ = do addNode typ vs <- lift $ augment typ mapM_ (addEdge typ) (Set.toList vs) mapM_ doNode (Set.toList vs) - addNode :: TGV -> StateT (GraphEdges () TGV) m ()- addNode a = modify $ Map.alter (maybe (Just (def, Set.empty)) Just) a+ addNode :: TGV -> StateT (GraphEdges TGV) m ()+ addNode a = modify $ Map.alter (maybe (Just Set.empty) Just) a - addEdge :: TGV -> TGV -> StateT (GraphEdges () TGV) m ()- addEdge a b = modify $ Map.update (\(lbl, s) -> Just (lbl, Set.insert b s)) a+ addEdge :: TGV -> TGV -> StateT (GraphEdges TGV) m ()+ addEdge a b = modify $ Map.update (\s -> Just (Set.insert b s)) a -- | Return the set of adjacent vertices according to the default type -- graph - i.e. the one determined only by the type definitions, not@@ -285,10 +251,9 @@ doField tname _dec cname (fld, ftype) = Set.singleton <$> typeGraphVertexOfField (tname, cname, fld) ftype -- FIXME: pass in ti, pass in makeTypeGraphEdges, remove Q, move to TypeGraph.Graph-makeTypeGraph :: (DsMonad m) => ReaderT TypeInfo m (GraphEdges () TGV) -> TypeInfo -> m TypeGraph-makeTypeGraph makeTypeGraphEdges ti = do- -- ti <- typeInfo st- es <- runReaderT makeTypeGraphEdges ti+makeTypeGraph :: MonadReader TypeInfo m => (GraphEdges TGV) -> m TypeGraph+makeTypeGraph es = do+ ti <- ask return $ TypeGraph { _typeInfo = ti , _edges = es
Language/Haskell/TH/TypeGraph/Info.hs view
@@ -28,15 +28,17 @@ import Control.Lens -- (makeLenses, view) import Control.Monad.Reader (MonadReader) import Control.Monad.State (execStateT, StateT)+import Control.Monad.Trans as Monad (lift)+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 as Set (empty, insert, map, member, Set, singleton, toList, union)+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 (Lift(lift), Quasi(..))+import Language.Haskell.TH.Syntax as TH (Lift(lift), Quasi(..)) import Language.Haskell.TH.TypeGraph.Expand (E(E), expandType) import Language.Haskell.TH.TypeGraph.Prelude (pprint') import Language.Haskell.TH.TypeGraph.Shape (Field)@@ -75,22 +77,25 @@ instance Lift TypeInfo where lift (TypeInfo {_startTypes = st, _typeSet = t, _infoMap = i, _expanded = e, _synonyms = s, _fields = f}) =- [| TypeInfo { _startTypes = $(lift st)- , _typeSet = $(lift t)- , _infoMap = $(lift i)- , _expanded = $(lift e)- , _synonyms = $(lift s)- , _fields = $(lift 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.-collectTypeInfo :: forall m. DsMonad m => Type -> StateT TypeInfo m ()-collectTypeInfo typ0 = do+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 = do+ 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 ()@@ -98,18 +103,18 @@ 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'' typ - doType' :: Type -> StateT TypeInfo m ()- doType' (ConT name) = do+ 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: " ++ pprint' typ+ doType'' (AppT typ1 typ2) = doType typ1 >> doType typ2+ doType'' ListT = return ()+ doType'' (VarT _) = return ()+ doType'' (TupleT _) = return ()+ doType'' typ = error $ "makeTypeInfo: " ++ pprint' typ doInfo :: Name -> Info -> StateT TypeInfo m () doInfo _tname (TyConI dec) = doDec dec@@ -123,14 +128,14 @@ synonyms %= Map.insertWith union etyp (singleton tname) doType typ doDec (NewtypeD _ tname _ constr _) = doCon tname constr- doDec (DataD _ tname _ constrs _) = mapM_ (doCon tname) constrs+ doDec (DataD _ tname _ constrs _) = Foldable.mapM_ (doCon tname) constrs doDec dec = error $ "makeTypeInfo: " ++ pprint' dec doCon :: Name -> Con -> StateT TypeInfo m () doCon tname (ForallC _ _ con) = doCon tname con- doCon tname (NormalC cname flds) = mapM_ doField (zip (List.map (\n -> (tname, cname, Left n)) ([1..] :: [Int])) (List.map snd flds))- doCon tname (RecC cname flds) = mapM_ doField (List.map (\ (fname, _, ftype) -> ((tname, cname, Right fname), ftype)) flds)- doCon tname (InfixC (_, lhs) cname (_, rhs)) = mapM_ doField [((tname, cname, Left 1), lhs), ((tname, cname, Left 2), rhs)]+ doCon tname (NormalC cname flds) = Foldable.mapM_ doField (zip (List.map (\n -> (tname, cname, Left n)) ([1..] :: [Int])) (List.map snd flds))+ doCon tname (RecC cname flds) = Foldable.mapM_ doField (List.map (\ (fname, _, ftype) -> ((tname, cname, Right fname), ftype)) flds)+ doCon tname (InfixC (_, lhs) cname (_, rhs)) = Foldable.mapM_ doField [((tname, cname, Left 1), lhs), ((tname, cname, Left 2), rhs)] doField :: ((Name, Name, Either Int Name), Type) -> StateT TypeInfo m () doField (fld, ftyp) = do@@ -139,10 +144,10 @@ doType ftyp -- | Build a TypeInfo value by scanning the supplied types-makeTypeInfo :: forall m. DsMonad m => [Type] -> m TypeInfo-makeTypeInfo types =+makeTypeInfo :: forall m. DsMonad m => (Type -> m (Set Type)) -> [Type] -> m TypeInfo+makeTypeInfo extraTypes types = execStateT- (mapM_ collectTypeInfo types)+ (Foldable.mapM_ (collectTypeInfo extraTypes) types) (TypeInfo { _startTypes = types , _typeSet = mempty , _infoMap = mempty
Language/Haskell/TH/TypeGraph/Prelude.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -15,20 +16,27 @@ , unReifyName , adjacent' , reachable'+ , L(L) ) where import Control.Lens import Data.Generics (Data, everywhere, mkT) import Data.Graph as Graph+import Data.List (intersperse) import Data.Map as Map (Map, fromList, toList) import Data.Maybe (fromMaybe) import Data.Set as Set (fromList, Set, toList) import Language.Haskell.TH-import Language.Haskell.TH.PprLib (ptext)+import Language.Haskell.TH.PprLib (ptext, hcat) import Language.Haskell.TH.Syntax (Lift(lift), Quasi(qReify)) instance Ppr () where ppr () = ptext "()"++newtype L a = L a++instance Ppr a => Ppr (L [a]) where+ ppr (L l) = hcat ([ptext "["] ++ intersperse (ptext ", ") (map ppr l) ++ [ptext "]"]) -- | Pretty print a 'Ppr' value on a single line with each block of -- white space (newlines, tabs, etc.) converted to a single space.
Language/Haskell/TH/TypeGraph/Shape.hs view
@@ -9,6 +9,7 @@ Field , constructorFields , FieldType(..)+ , fieldType , constructorFieldTypes , fPos , fName@@ -54,6 +55,10 @@ 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
Language/Haskell/TH/TypeGraph/Stack.hs view
@@ -13,6 +13,7 @@ {-# OPTIONS_GHC -Wall #-} module Language.Haskell.TH.TypeGraph.Stack ( HasStack(push, withStack)+ , Wrapper(Wrapper), unwrap , StackElement(..) , prettyStack , foldField@@ -27,7 +28,7 @@ import Control.Applicative import Control.Category ((.))-import Control.Lens (iso, Lens', lens, set, view)+import Control.Lens (iso, Lens', lens, makeLenses, set, view) import Control.Monad.Reader (ReaderT, runReaderT, ask, local) import Control.Monad.RWS (RWST) import Control.Monad.State (StateT, evalStateT, get)@@ -38,6 +39,7 @@ import Data.Map as Map (keys) import Data.Maybe (fromMaybe) import Data.Monoid+import Data.Set (Set) import Debug.Trace (trace) import Language.Haskell.Exts.Syntax () import Language.Haskell.TH@@ -72,6 +74,20 @@ withStack f = ask >>= f push fld con dec action = local (\ stk -> StackElement fld con dec : stk) action +-- We can't write @HasStack (ReaderT a m)@ because it overlaps with+-- @HasStack (ReaderT [StackElement] m)@. However, we can write+-- @HasStack (ReaderT (Wrapper a) m@.+instance HasStack m => HasStack (ReaderT (Wrapper a) m) where+ withStack f = lift (withStack return) >>= f+ push fld con dec action =+ do r <- ask+ a <- lift $ push fld con dec (runReaderT action r)+ return a++newtype Wrapper a = Wrapper {_unwrap :: a}++$(makeLenses ''Wrapper)+ instance (HasStack m, Monoid w) => HasStack (WriterT w m) where withStack f = lift (withStack return) >>= f push fld con dec action =@@ -165,9 +181,9 @@ -- The only reason for this function is backwards compatibility, the -- fields should be changed so they begin with _ and the regular -- makeLenses should be used.-makeLenses' :: [Name] -> Q [Dec]-makeLenses' typeNames =- execWriterT $ execStackT $ makeTypeInfo st >>= runReaderT typeGraphEdges >>= \ (g :: GraphEdges () TGV) -> (mapM doType . map (view etype) . Map.keys . simpleEdges $ g)+makeLenses' :: (Type -> Q (Set Type)) -> [Name] -> Q [Dec]+makeLenses' extraTypes typeNames =+ execWriterT $ execStackT $ makeTypeInfo (lift . lift . extraTypes) st >>= runReaderT typeGraphEdges >>= \ (g :: GraphEdges TGV) -> (mapM doType . map (view etype) . Map.keys . simpleEdges $ g) where st = map ConT typeNames
Language/Haskell/TH/TypeGraph/Vertex.hs view
@@ -5,7 +5,6 @@ ( TypeGraphVertex(..) , TGV(..), field, vsimple , TGVSimple(..), syns, etype- , simpleVertex ) where import Control.Lens@@ -20,20 +19,25 @@ import Language.Haskell.TH.TypeGraph.Prelude (unReify, unReifyName) import Language.Haskell.TH.TypeGraph.Shape (Field) --- | For simple type graphs always set _field and _synonyms to Nothing.+-- | 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) --- | For simple type graphs always set _field and _synonyms to Nothing.+-- | 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) +$(makeLenses ''TGV)+$(makeLenses ''TGVSimple)+ instance Ppr TGVSimple where ppr (TGVSimple {_syns = ns, _etype = typ}) = hcat (ppr (unReify (runExpanded typ)) :@@ -55,11 +59,11 @@ maybe [] (\ f -> [ppr f]) fld) ++ [ptext ")"]) -$(makeLenses ''TGV)-$(makeLenses ''TGVSimple)+instance Lift TGV where+ lift (TGV {_field = f, _vsimple = s}) = [|TGV {_field = $(lift f), _vsimple = $(lift s)}|] -simpleVertex :: TGV -> TGVSimple-simpleVertex = _vsimple+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@@ -77,9 +81,3 @@ 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 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)}|]
test/Common.hs view
@@ -52,10 +52,10 @@ pprintPred :: E Pred -> String pprintPred = pprint' . unReify . runExpanded -edgesToStrings :: (TypeGraphVertex v, Ppr v) => GraphEdges label v -> [(String, [String])]-edgesToStrings mp = List.map (\ (t, (_, s)) -> (pprintVertex t, map pprintVertex (Set.toList s))) (Map.toList mp)+edgesToStrings :: (TypeGraphVertex v, Ppr v) => GraphEdges v -> [(String, [String])]+edgesToStrings mp = List.map (\ (t, s) -> (pprintVertex t, map pprintVertex (Set.toList s))) (Map.toList mp) -typeGraphEdges' :: forall m. (DsMonad m, MonadReader TypeInfo m) => m (GraphEdges () TGV)+typeGraphEdges' :: forall m. (DsMonad m, MonadReader TypeInfo m) => m (GraphEdges TGV) typeGraphEdges' = typeGraphEdges -- | Return a mapping from vertex to all the known type synonyms for@@ -66,7 +66,7 @@ (Map.filter (not . Set.null) . Map.fromList . List.map (\node -> (node, view (vsimple . syns) node)) .- Map.keys) <$> (typeGraphEdges :: m (GraphEdges () TGV))+ Map.keys) <$> (typeGraphEdges :: m (GraphEdges TGV)) -- | Like 'typeSynonymMap', but with all field information removed. typeSynonymMapSimple :: forall m. (DsMonad m, MonadReader TypeInfo m) =>
test/TypeGraph.hs view
@@ -17,7 +17,7 @@ import Language.Haskell.TH.TypeGraph.Expand (expandType, runExpanded, E(E)) import Language.Haskell.TH.TypeGraph.Free (freeTypeVars, typeArity) import Language.Haskell.TH.TypeGraph.Info (makeTypeInfo, synonyms, typeVertex')-import Language.Haskell.TH.TypeGraph.Vertex (TypeGraphVertex(..), TGV(..), TGVSimple(..), etype, field, vsimple, syns)+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@@ -31,39 +31,39 @@ tests = do it "records a type synonym 1" $ do- $([t|String|] >>= \string -> makeTypeInfo [string] >>= lift . view synonyms) `shouldBe` (Map.fromList [(E (AppT ListT (ConT ''Char)), Set.singleton ''String)])+ $([t|String|] >>= \string -> makeTypeInfo (const $ return mempty) [string] >>= lift . view synonyms) `shouldBe` (Map.fromList [(E (AppT ListT (ConT ''Char)), Set.singleton ''String)]) it "records a type synonym 2" $ do- $([t|String|] >>= \string -> makeTypeInfo [string] >>= runReaderT (expandType string >>= typeVertex') >>= lift) `shouldBe` (TGV {_field = Nothing, _vsimple = TGVSimple {_syns = singleton ''String, _etype = E (AppT ListT (ConT ''Char))}})+ $([t|String|] >>= \string -> 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 [typ] >>= lift . pprint) `shouldBe` typeInfoOfType+ $(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 [] $ runQ [t|Type|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>= runQ . lift . edgesToStrings)) simpleTypeEdges `shouldBe` noDifferences it "can find the edges of the (unsimplified) subtype graph of Type (typeEdges)" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Type|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= runQ . lift . edgesToStrings)) typeEdges `shouldBe` noDifferences it "can find the subtypesOfType" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Type|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= runQ . lift . List.map pprintVertex . Map.keys)) subtypesOfType `shouldBe` noDifferences it "can find the edges of the arity 0 subtype graph of Type (arity0TypeEdges)" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Type|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>= dissolveM (\ v -> (/= 0) <$> (typeArity . runExpanded . view etype) v) >>= runQ . lift . edgesToStrings)) arity0TypeEdges `shouldBe` noDifferences@@ -71,14 +71,14 @@ it "can find the edges of the simple subtype graph of Dec (decEdges)" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Dec|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>= runQ . lift . edgesToStrings)) decEdges `shouldBe` noDifferences it "can find the edges of the arity 0 subtype graph of Dec (arity0DecEdges)" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Dec|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>=+ makeTypeInfo (const $ return mempty) [typ] >>= runReaderT typeGraphEdges' >>= return . simpleEdges >>= dissolveM (\ v -> (/= 0) <$> (typeArity . runExpanded . _etype) v) >>= runQ . lift . edgesToStrings)) arity0DecEdges `shouldBe` noDifferences@@ -86,14 +86,14 @@ it "can find the subtypesOfDec" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Dec|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphVertices >>=+ 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 [typ] >>= runReaderT typeGraphVertices >>=+ 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@@ -102,13 +102,13 @@ it "can find the simpleSubtypesOfDec" $ do setDifferences (Set.fromList $(withLocalDeclarations [] $ runQ [t|Dec|] >>= \typ ->- makeTypeInfo [typ] >>= runReaderT typeGraphVertices >>=+ 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 [typ] >>= runReaderT (typeSynonymMapSimple >>= runQ . lift)) `shouldBe` decTypeSynonyms+ 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
th-typegraph.cabal view
@@ -1,5 +1,5 @@ name: th-typegraph-version: 0.21+version: 0.23 cabal-version: >= 1.10 build-type: Simple license: BSD3@@ -24,6 +24,7 @@ data-default, haskell-src-exts, lens,+ memoize, mtl, set-extra, syb,