forked from GitHub/gf-core
021b5f06d3
The fact that identifiers are represented as ByteStrings is now an internal implentation detail in module GF.Infra.Ident. Conversion between ByteString and identifiers is only needed in the lexer and the Binary instances.
74 lines
2.4 KiB
Haskell
74 lines
2.4 KiB
Haskell
module GF.Infra.Dependencies (
|
|
depGraph
|
|
) where
|
|
|
|
import GF.Grammar.Grammar
|
|
import GF.Infra.Ident(Ident,showIdent)
|
|
|
|
import Data.List (nub,isPrefixOf)
|
|
|
|
-- the list gives the only modules to show, e.g. to hide the library details
|
|
depGraph :: Maybe [String] -> SourceGrammar -> String
|
|
depGraph only = prDepGraph . grammar2moddeps only
|
|
|
|
prDepGraph :: [(Ident,ModDeps)] -> String
|
|
prDepGraph deps = unlines $ [
|
|
"digraph {"
|
|
] ++
|
|
map mkNode deps ++
|
|
concatMap mkArrows deps ++ [
|
|
"}"
|
|
]
|
|
where
|
|
mkNode (i,dep) = unwords [showIdent i, "[",nodeAttr (modtype dep),"]"]
|
|
nodeAttr ty = case ty of
|
|
MTAbstract -> "style = \"solid\", shape = \"box\""
|
|
MTConcrete _ -> "style = \"solid\", shape = \"ellipse\""
|
|
_ -> "style = \"dashed\", shape = \"ellipse\""
|
|
mkArrows (i,dep) =
|
|
[unwords [showIdent i,"->",showIdent j,"[",arrowAttr "of","]"] | j <- ofs dep] ++
|
|
[unwords [showIdent i,"->",showIdent j,"[",arrowAttr "ex","]"] | j <- extendeds dep] ++
|
|
[unwords [showIdent i,"->",showIdent j,"[",arrowAttr "op","]"] | j <- openeds dep] ++
|
|
[unwords [showIdent i,"->",showIdent j,"[",arrowAttr "ed","]"] | j <- extrads dep]
|
|
arrowAttr s = case s of
|
|
"of" -> "style = \"solid\", arrowhead = \"empty\""
|
|
"ex" -> "style = \"solid\""
|
|
"op" -> "style = \"dashed\""
|
|
"ed" -> "style = \"dotted\""
|
|
|
|
data ModDeps = ModDeps {
|
|
modtype :: ModuleType,
|
|
ofs :: [Ident],
|
|
extendeds :: [Ident],
|
|
openeds :: [Ident],
|
|
extrads :: [Ident],
|
|
functors :: [Ident],
|
|
interfaces :: [Ident],
|
|
instances :: [Ident]
|
|
}
|
|
|
|
noModDeps = ModDeps MTAbstract [] [] [] [] [] [] []
|
|
|
|
grammar2moddeps :: Maybe [String] -> SourceGrammar -> [(Ident,ModDeps)]
|
|
grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i]
|
|
where
|
|
depMod i m =
|
|
noModDeps{
|
|
modtype = mtype m,
|
|
ofs = case mtype m of
|
|
MTConcrete i -> [i | yes i]
|
|
MTInstance (i,_) -> [i | yes i]
|
|
_ -> [],
|
|
extendeds = nub $ filter yes $ map fst (mextend m),
|
|
openeds = nub $ filter yes $ map openedModule (mopens m),
|
|
extrads = nub $ filter yes $ mexdeps m
|
|
}
|
|
yes i = case monly of
|
|
Just only -> match (showIdent i) only
|
|
_ -> True
|
|
match s os = any (\x -> doMatch x s) os
|
|
doMatch x s = case last x of
|
|
'*' -> isPrefixOf (init x) s
|
|
_ -> x == s
|
|
|