1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00

Abstract the selection of the module graph.

This commit is contained in:
Rob Rix 2018-04-02 18:16:25 -04:00
parent d2713eca19
commit 40269c8fc5

View File

@ -82,6 +82,9 @@ instance ( Effectful m
packageGraph :: SomeOrigin term -> ImportGraph packageGraph :: SomeOrigin term -> ImportGraph
packageGraph = maybe empty (vertex . Package . packageName) . withSomeOrigin originPackage packageGraph = maybe empty (vertex . Package . packageName) . withSomeOrigin originPackage
moduleGraph :: SomeOrigin term -> ImportGraph
moduleGraph = maybe empty (vertex . Module . moduleName) . withSomeOrigin originModule
insertVertexName :: forall m location term value effects insertVertexName :: forall m location term value effects
. ( Effectful m . ( Effectful m
, Member (Reader (SomeOrigin term)) effects , Member (Reader (SomeOrigin term)) effects
@ -92,8 +95,7 @@ insertVertexName :: forall m location term value effects
-> ImportGraphing m effects () -> ImportGraphing m effects ()
insertVertexName name = do insertVertexName name = do
o <- raise ask o <- raise ask
let parent = maybe empty (vertex . Module . moduleName) (withSomeOrigin (originModule @term) o) modifyImportGraph (moduleGraph @term o >< vertex (Module name) <>)
modifyImportGraph (parent >< vertex (Module name) <>)
(><) :: Graph a => a -> a -> a (><) :: Graph a => a -> a -> a
(><) = connect (><) = connect