packages feed

th-typegraph 0.33.1 → 0.35.1

raw patch · 13 files changed

+182/−177 lines, 13 filesdep +th-contextdep +th-lift-instancesdep −microlens-compat

Dependencies added: th-context, th-lift-instances

Dependencies removed: microlens-compat

Files

Language/Haskell/TH/TypeGraph/Arity.hs view
@@ -1,3 +1,5 @@+{-# 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@@ -27,8 +29,17 @@       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 view
@@ -45,7 +45,7 @@ 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.TypeGraph.Expand (E(E), ExpandMap, expandType)+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)@@ -83,20 +83,25 @@        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 (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+      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 -> Name -> Either Int Name -> Type -> StateT (GraphEdges TGV') m ()-      doField vs tname cname fld ftyp = do-        v2 <- lift (expandType ftyp) >>= fieldVertex (tname, cname, fld)+      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
− Language/Haskell/TH/TypeGraph/Expand.hs 
@@ -1,74 +0,0 @@--- | The 'Expanded' class helps keep track of which 'Type' values have--- been fully expanded to a canonical form.  This lets us use the 'Eq'--- and 'Ord' relationships on 'Type' and 'Pred' values when reasoning--- about instance context.  What the 'expandType' function does is use--- the function from @th-desugar@ to replace occurrences of @ConT name@--- with the associated 'Type' if @name@ is a declared type synonym--- @TySynD name _ typ@.  For convenience, a wrapper type 'E' is--- provided, along with the 'Expanded' instances @E Type@ and @E--- Pred@.  Now the 'expandType' and 'expandPred' functions can be used--- to return values of type @E Type@ and @E Pred@ respectively.------ Instances @Expanded Type Type@ and @Expanded Pred Pred@ are--- provided in "Language.Haskell.TH.Context.Unsafe", for when less--- type safety is required.--{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}--module Language.Haskell.TH.TypeGraph.Expand-    ( E(E, _unE), unE-    , ExpandMap-    , expandType-    , expandPred-    , expandClassP-    ) where--import Control.Lens (makeLenses)-import Control.Monad.States (MonadStates(getPoly), modifyPoly)-import Data.Data (Data)-import Data.Map as Map (Map, lookup, insert)-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 Prelude hiding (pred)---- | A concrete type used to mark type which have been expanded-newtype E a = E {_unE :: a} deriving (Eq, Ord, Show, Data)--instance Ppr a => Ppr (E a) where-    ppr (E x) = ppr x--instance Lift (E Type) where-    lift etype = [|E $(lift (_unE etype))|]--$(makeLenses ''E)---- | The state type used to memoize expansions.-type ExpandMap = Map Type (E Type)---- | Apply the th-desugar expand function to a 'Type' and mark it as expanded.-expandType :: (DsMonad m, MonadStates ExpandMap m)  => Type -> m (E Type)-expandType typ = do-  getPoly >>= maybe expandType' return . Map.lookup typ-    where-      expandType' =-          do e <- E <$> DS.typeToTH <$> (DS.dsType typ >>= DS.expand)-             modifyPoly (Map.insert typ e)-             return e---- | 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.-expandPred :: (DsMonad m, MonadStates ExpandMap m)  => Type -> m (E Type)-expandPred = expandType---- | Expand a list of 'Type' and build an expanded 'ClassP' 'Pred'.-expandClassP :: forall m. (DsMonad m, MonadStates ExpandMap m)  => Name -> [Type] -> m (E Type)-expandClassP className typeParameters = (expandType $ foldl AppT (ConT className) typeParameters) :: m (E Type)
Language/Haskell/TH/TypeGraph/Free.hs view
@@ -79,6 +79,16 @@ 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@@ -87,6 +97,7 @@   -- 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.@@ -105,7 +116,11 @@ --    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 ()
Language/Haskell/TH/TypeGraph/Lens.hs view
@@ -29,7 +29,7 @@ import Language.Haskell.TH.Desugar (DsMonad) import Language.Haskell.TH.Instances () import Language.Haskell.TH.Syntax hiding (lift)-import Language.Haskell.TH.TypeGraph.Expand (E(E), ExpandMap)+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)@@ -48,8 +48,13 @@     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)@@ -62,8 +67,13 @@     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
Language/Haskell/TH/TypeGraph/Prelude.hs view
@@ -18,7 +18,6 @@     , unReifyName     , adjacent'     , reachable'-    , L(L)     , friendlyNames     ) where @@ -26,7 +25,6 @@ import Control.Monad (foldM) 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 (fromJust, fromMaybe) import Data.Set as Set (fromList, Set, toList)@@ -34,37 +32,53 @@ 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 "()" -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, and--- all the module qualifiers removed from the names.+-- 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 typ = pprintStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode}) $ friendlyNames $ typ+pprint1 = pprintStyle (HPJ.style {HPJ.mode = HPJ.OneLineMode}) . friendlyNames -pprintW :: (Ppr a, Data a) => a -> [Char]-pprintW typ = pprintStyle (HPJ.style {HPJ.lineLength = 250}) $ friendlyNames $ typ+-- | 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 typ = pprintStyle (HPJ.style {HPJ.mode = HPJ.LeftMode}) $ friendlyNames $ typ+pprintL = pprintStyle (HPJ.style {HPJ.mode = HPJ.LeftMode}) . friendlyNames -pprintStyle :: (Data a, Ppr a) => HPJ.Style -> a -> String-pprintStyle style x = HPJ.renderStyle style $ to_HPJ_Doc $ ppr $ friendlyNames x+-- | 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 @@ -108,20 +122,36 @@ 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 (TySynInstD 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@@ -129,12 +159,6 @@ declarationType :: Dec -> Maybe Type declarationType = fmap ConT . declarationName -instance Lift a => Lift (Set a) where-    lift s = [|Set.fromList $(lift (Set.toList s))|]--instance (Lift a, Lift b) => Lift (Map a b) where-    lift mp = [|Map.fromList $(lift (Map.toList mp))|]- unReify :: Data a => a -> a unReify = everywhere (mkT unReifyName) @@ -157,14 +181,3 @@       ks = map (view _2 . vf) $ reachableVerts       reachableVerts = Graph.reachable g v       v = fromMaybe (error "Language.Haskell.TH.TypeGraph.Prelude.reachable") (kf k)---- | 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
Language/Haskell/TH/TypeGraph/Shape.hs view
@@ -7,10 +7,12 @@     (      -- * Field name and position       Field-    , constructorFields     , FieldType(..)     , fieldType+    , constructorName+    , constructorFields     , constructorFieldTypes+    , constructorPat     , fPos     , fName     , fType@@ -26,27 +28,21 @@ import Language.Haskell.TH.PprLib (ptext) import Language.Haskell.TH.Syntax import Language.Haskell.TH.TypeGraph.Prelude (unReifyName)-import Language.Haskell.TH.TypeGraph.Expand (E)+import Language.Haskell.TH.Expand (E)  -- FieldType and Field should be merged, or made less rudundant.  type Field = ( Name, -- type name-               Name, -- constructor name+               Con,  -- constructor                Either Int -- field position                       Name -- field name              ) -constructorFields :: Name -> Con -> [Field]-constructorFields tname (ForallC _ _ con) = constructorFields tname con-constructorFields tname (NormalC cname fields) = map (\(i, _) -> (tname, cname, Left i)) (zip ([1..] :: [Int]) fields)-constructorFields tname (RecC cname fields) = map (\ (fname, _, _typ) -> (tname, cname, Right fname)) fields-constructorFields tname (InfixC (_, _lhs) cname (_, _rhs)) = [(tname, cname, Left 1), (tname, cname, Left 2)]- instance Ppr Field where-    ppr (tname, cname, field) = ptext $+    ppr (tname, con, field) = ptext $         "field " ++         show (unReifyName tname) ++ "." ++-        either (\ n -> show (unReifyName cname) ++ "[" ++ show n ++ "]") (\ f -> show (unReifyName f)) field+        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@@ -101,3 +97,22 @@ 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 view
@@ -91,8 +91,13 @@       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 ++ "))"
Language/Haskell/TH/TypeGraph/TypeGraph.hs view
@@ -66,12 +66,12 @@ import Language.Haskell.TH.Instances () import Language.Haskell.TH.PprLib (ptext, vcat) import Language.Haskell.TH.TypeGraph.Edges (GraphEdges, simpleEdges)-import Language.Haskell.TH.TypeGraph.Expand (ExpandMap, expandType)-import Language.Haskell.TH.TypeGraph.Prelude (adjacent', reachable')+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(bestType), vsimple)+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@@ -157,7 +157,7 @@                  m (Set TGVSimple) allPathStarts = do   ts <- allPathNodes :: m (Set TGV)-  Set.mapM (tgvSimple . bestType) ts+  Set.mapM simplify ts  view' :: MonadReaders s m => Getting b s b -> m b view' lns = view lns <$> askPoly@@ -183,19 +183,17 @@          Nothing -> error $ "tgv: " ++ show mf ++ " " ++ show s  -- | Find the simple graph node corresponding to the given type-tgvSimple :: (MonadStates ExpandMap m, DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m) => Type -> m TGVSimple+tgvSimple :: (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-       let k = maybe (error ("tgvSimple: " ++ show t)) id (kf s)-       return (k, s)--tgvSimple' :: (MonadStates ExpandMap m, DsMonad m, MonadReaders TypeInfo m, MonadReaders TypeGraph m) => Type -> m (Maybe TGVSimple)-tgvSimple' t =-    do (_g, _vf, kf) <- askPoly >>= return . view gsimple-       s <- expandType t >>= typeVertex        return $ fmap (\k -> (k, s)) (kf s) +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)@@ -226,8 +224,14 @@ -- | Return the nodes reachable from x in the path graph. pathKeys' :: (DsMonad m, MonadStates ExpandMap m, MonadReaders TypeGraph m, MonadReaders TypeInfo m) => TGV -> m (Set TGVSimple) pathKeys' s = do-  gs <- view' graph-  Set.fromList <$> Prelude.mapM simplify (reachable' gs s)+#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) @@ -279,8 +283,7 @@         -- magnify typeInfo $ vertex Nothing typ'  -- | Return the TGV associated with a particular type and field.-typeGraphVertexOfField :: ({-MonadReaders TypeGraph m,-} MonadReaders TypeInfo m, MonadStates ExpandMap m, DsMonad m) =>-                          (Name, Name, Either Int Name) -> Type -> m TGV'+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
Language/Haskell/TH/TypeGraph/TypeInfo.hs view
@@ -40,7 +40,7 @@ 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.TypeGraph.Expand (E(E), ExpandMap, expandType)+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)@@ -60,7 +60,7 @@       -- ^ 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 (Name, Name, Either Int Name))+      , _fields :: Map (E Type) (Set Field)       -- ^ Map from field type to field names       } deriving (Show, Eq, Ord) @@ -134,17 +134,22 @@        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 (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)]+      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 :: ((Name, Name, Either Int Name), Type) -> StateT TypeInfo m ()+      doField :: (Field, Type) -> StateT TypeInfo m ()       doField (fld, ftyp) = do         etyp <- expandType ftyp         fields %= Map.insertWith union etyp (singleton fld)
Language/Haskell/TH/TypeGraph/Vertex.hs view
@@ -6,6 +6,7 @@     ( TypeGraphVertex(..)     , TGV'(..), field, vsimple, TGV     , TGVSimple'(..), syns, etype, TGVSimple+    , bestTypeQ     ) where  import Control.Lens@@ -19,7 +20,7 @@ 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.TypeGraph.Expand (E(E), unE)+import Language.Haskell.TH.Expand (E(E), unE) import Language.Haskell.TH.TypeGraph.Prelude (unReify, unReifyName) import Language.Haskell.TH.TypeGraph.Shape (Field) @@ -104,6 +105,9 @@     -- 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
test/Values.hs view
@@ -157,23 +157,23 @@       "    Language.Haskell.TH.Syntax.TyVarBndr -> fromList [Language.Haskell.TH.Syntax.TyVarBndr]",       "    Language.Haskell.TH.Syntax.Type -> fromList [Language.Haskell.TH.Syntax.Kind,Language.Haskell.TH.Syntax.Pred,Language.Haskell.TH.Syntax.Type]",       "  fields:",-      "    [GHC.Types.Char] -> fromList [(Language.Haskell.TH.Syntax.ModName,Language.Haskell.TH.Syntax.ModName,Left 1),(Language.Haskell.TH.Syntax.OccName,Language.Haskell.TH.Syntax.OccName,Left 1),(Language.Haskell.TH.Syntax.PkgName,Language.Haskell.TH.Syntax.PkgName,Left 1),(Language.Haskell.TH.Syntax.TyLit,Language.Haskell.TH.Syntax.StrTyLit,Left 1)]",-      "    [Language.Haskell.TH.Syntax.TyVarBndr] -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 1)]",-      "    [Language.Haskell.TH.Syntax.Type] -> fromList [(Language.Haskell.TH.Syntax.Type,Language.Haskell.TH.Syntax.ForallT,Left 2)]",-      "    GHC.Prim.ByteArray# -> fromList [(GHC.Integer.Type.BigNat,GHC.Integer.Type.BN#,Left 1)]",-      "    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.S#,Left 1)]",-      "    GHC.Types.Int -> fromList [(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameL,Left 1),(Language.Haskell.TH.Syntax.NameFlavour,Language.Haskell.TH.Syntax.NameU,Left 1),(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.BigNat -> fromList [(GHC.Integer.Type.Integer,GHC.Integer.Type.Jn#,Left 1),(GHC.Integer.Type.Integer,GHC.Integer.Type.Jp#,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.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.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)]" ]+      "    [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:",
th-typegraph.cabal view
@@ -1,5 +1,5 @@ name:               th-typegraph-version:            0.33.1+version:            0.35.1 cabal-version:      >= 1.10 build-type:         Simple license:            BSD3@@ -23,7 +23,6 @@   exposed-modules:     Language.Haskell.TH.TypeGraph.Arity     Language.Haskell.TH.TypeGraph.Edges-    Language.Haskell.TH.TypeGraph.Expand     Language.Haskell.TH.TypeGraph.Free     Language.Haskell.TH.TypeGraph.Lens     Language.Haskell.TH.TypeGraph.Prelude@@ -38,32 +37,26 @@     containers,     data-default,     haskell-src-exts,+    lens,     mtl,     mtl-unleashed >= 0.5,     pretty >= 1.1.2,     set-extra,     syb,     template-haskell >= 2.10,+    th-context,     th-desugar,+    th-lift-instances >= 0.1.7,     th-orphans >= 0.10.0-  if impl(ghcjs)-    build-depends: microlens-compat-  else-    build-depends: lens - test-suite th-typegraph-tests   type:             exitcode-stdio-1.0   hs-source-dirs:   test   main-is:          Tests.hs   build-depends:    array, base, bytestring, containers, data-default, deepseq, ghc-prim,-                    hspec, hspec-core, mtl, mtl-unleashed >= 0.5, syb, template-haskell, text,+                    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-  if impl(ghcjs)-    build-depends: microlens-compat-  else-    build-depends: lens  source-repository head   type:     git