4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzDescription : Navigation through the Development Graph
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzCopyright : (c) Ewaryst Schulz, DFKI Bremen 2011
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzLicense : GPLv2 or higher, see LICENSE.txt
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzMaintainer : ewaryst.schulz@dfki.de
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzStability : experimental
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzPortability : non-portable (via imports)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzNavigation through the Development Graph based on Node and Link predicates
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulzusing Depth First Search.
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulzimport qualified Data.Set as Set
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz-- * Navigator Class
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulzclass DevGraphNavigator a where
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- | get all the incoming ledges of the given node
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz incoming :: a -> Node -> [LEdge DGLinkLab]
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- | get the label of the given node
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz getLabel :: a -> Node -> DGNodeLab
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz -- | get the local (not referenced) environment of the given node
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz getLocalNode :: a -> Node -> (DGraph, LNode DGNodeLab)
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz getInLibEnv :: a -> (LibEnv -> DGraph -> b) -> b
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz getCurrent :: a -> [LNode DGNodeLab]
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz relocate :: a -> DGraph -> [LNode DGNodeLab] -> a
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | Get all the incoming ledges of the given node and eventually
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroedercross the border to an other 'DGraph'. The new 'DevGraphNavigator'
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederis returned with 'DGraph' set to the new graph and current node to
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederthe given node. -}
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzfollowIncoming :: DevGraphNavigator a => a -> Node
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz -> (a, LNode DGNodeLab, [LEdge DGLinkLab])
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzfollowIncoming dgn n = (dgn', lbln, incoming dgn' n')
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz where (dgn', lbln@(n', _)) = followNode dgn n
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz-- | get the local (not referenced) label of the given node
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzgetLocalLabel :: DevGraphNavigator a => a -> Node -> DGNodeLab
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzgetLocalLabel dgnav = snd . snd . getLocalNode dgnav
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzfollowNode :: DevGraphNavigator a => a -> Node -> (a, LNode DGNodeLab)
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzfollowNode dgnav n = (relocate dgnav dg [lbln], lbln)
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz where (dg, lbln) = getLocalNode dgnav n
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz-- | get all the incoming ledges of the current node
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzdirectInn :: DevGraphNavigator a => a -> [LEdge DGLinkLab]
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzdirectInn dgnav = concatMap (incoming dgnav . fst) $ getCurrent dgnav
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz-- * Navigator Instance
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | The navigator instance consists of a 'LibEnv' a current 'DGraph' and
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroedera current 'Node' which is the starting point for navigation through the DG. -}
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulzdata DGNav = DGNav { dgnLibEnv :: LibEnv
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz , dgnDG :: DGraph
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz , dgnCurrent :: [LNode DGNodeLab] } deriving Show
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulzinstance Pretty DGNav where
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz pretty dgn = d1 <> text ":" <+> pretty (map fst $ dgnCurrent dgn)
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz where d1 = case optLibDefn $ dgnDG dgn of
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Just (Lib_defn ln _ _ _) -> pretty ln
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Nothing -> text "DG"
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzmakeDGNav :: LibEnv -> DGraph -> [LNode DGNodeLab] -> DGNav
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzmakeDGNav le dg cnl = DGNav le dg cnl' where
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz cnl' | null cnl = filter f $ labNodesDG dg
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz | otherwise = cnl
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder where f (n, _) = not $ any isDefLink $ outDG dg n
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzisDefLink :: LEdge DGLinkLab -> Bool
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzisDefLink = isDefEdge . dgl_type . linkLabel
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulzinstance DevGraphNavigator DGNav where
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz -- we consider only the definition links in a DGraph
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz incoming dgn = filter isDefLink . innDG (dgnDG dgn)
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz getLabel = labDG . dgnDG
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder getLocalNode (DGNav {dgnLibEnv = le, dgnDG = dg}) = lookupLocalNode le dg
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder getInLibEnv (DGNav {dgnLibEnv = le, dgnDG = dg}) f = f le dg
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder getCurrent (DGNav {dgnCurrent = lblnl}) = lblnl
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz relocate dgn dg lblnl = dgn { dgnDG = dg, dgnCurrent = lblnl }
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- * Basic search functionality
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | DFS based search
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzfirstMaybe :: (a -> Maybe b) -> [a] -> Maybe b
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzfirstMaybe _ [] = Nothing
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederfirstMaybe f (x : l) =
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz Nothing -> firstMaybe f l
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | Searches all ancestor nodes of the current node and also the current node
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederfor a node matching the given predicate -}
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchNode :: DevGraphNavigator a =>
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz (LNode DGNodeLab -> Bool) -> a -> Maybe (a, LNode DGNodeLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchNode p dgnav =
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz firstMaybe (searchNodeFrom p dgnav . fst) $ getCurrent dgnav
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzsearchNodeFrom :: DevGraphNavigator a => (LNode DGNodeLab -> Bool) -> a
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz -> Node -> Maybe (a, LNode DGNodeLab)
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzsearchNodeFrom p dgnav n =
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz let (dgnav', lbln, ledgs) = followIncoming dgnav n
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz in if p lbln then Just (dgnav', lbln)
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz else firstMaybe (searchNodeFrom p dgnav') $ map linkSource ledgs
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchLink :: DevGraphNavigator a =>
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz (LEdge DGLinkLab -> Bool) -> a -> Maybe (a, LEdge DGLinkLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchLink p dgnav =
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz firstMaybe (searchLinkFrom p dgnav . fst) $ getCurrent dgnav
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchLinkFrom :: DevGraphNavigator a => (LEdge DGLinkLab -> Bool) -> a
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz -> Node -> Maybe (a, LEdge DGLinkLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzsearchLinkFrom p dgnav n =
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz let (dgnav', _, ledgs) = followIncoming dgnav n
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz in case find p ledgs of
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Nothing -> firstMaybe (searchLinkFrom p dgnav') $ map linkSource ledgs
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz x -> fmap ((,) dgnav') x
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- * Predicates to be used with 'searchNode'
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | This predicate is true for nodes with a nodename equal to the given string
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdgnPredName :: String -> LNode DGNodeLab -> Maybe (LNode DGNodeLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdgnPredName n nd@(_, lbl) = if getDGNodeName lbl == n then Just nd else Nothing
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | This predicate is true for nodes which are instantiations of a
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederspecification with the given name -}
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdgnPredParameterized :: String -> LNode DGNodeLab -> Maybe (LNode DGNodeLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdgnPredParameterized n nd@(_, DGNodeLab
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz { nodeInfo = DGNode { node_origin = DGInst sid }
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz | show sid == n = Just nd
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz | otherwise = Nothing
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdgnPredParameterized _ _ = Nothing
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- * Predicates to be used with 'searchLink'
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederThis predicate is true for links which are argument instantiations of a
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederparameterized specification with the given name -}
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredActualParam :: String -> LEdge DGLinkLab -> Maybe (LEdge DGLinkLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredActualParam n edg@(_, _, DGLink { dgl_origin = DGLinkInstArg sid })
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz | show sid == n = Just edg
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz | otherwise = Nothing
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredActualParam _ _ = Nothing
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | This predicate is true for links which are instantiation morphisms
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredInstance :: LEdge DGLinkLab -> Maybe (LEdge DGLinkLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredInstance edg@(_, _, DGLink { dgl_origin = DGLinkMorph _ }) = Just edg
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzdglPredInstance _ = Nothing
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- * Combined Node Queries
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | Search for the given name in an actual parameter link
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzgetActualParameterSpec :: DevGraphNavigator a => String -> a
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz -> Maybe (a, LNode DGNodeLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzgetActualParameterSpec n dgnav =
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- search first actual param
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz case searchLink (isJust . dglPredActualParam n) dgnav of
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz Nothing -> Nothing
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Just (dgn', (sn, _, _)) ->
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- get the spec for the param
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz fmap f $ firstMaybe dglPredInstance $ incoming dgnav sn
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz where f edg = let sn' = linkSource edg
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz in (dgn', (sn', getLabel dgnav sn'))
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | Search for the given name in an instantiation node
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzgetParameterizedSpec :: DevGraphNavigator a => String -> a
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz -> Maybe (a, LNode DGNodeLab)
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst SchulzgetParameterizedSpec n dgnav =
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- search first actual param
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz case searchNode (isJust . dgnPredParameterized n) dgnav of
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz Nothing -> Nothing
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Just (dgn', (sn, _)) ->
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz -- get the spec for the param
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz fmap f $ firstMaybe dglPredInstance $ incoming dgnav sn
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz where f edg = let sn' = linkSource edg
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz in (dgn', (sn', getLabel dgnav sn'))
4042abb1169a3786988de7b61e3af2bf82982654Ewaryst Schulz-- | Search for the given name in any node
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzgetNamedSpec :: DevGraphNavigator a => String -> a -> Maybe (a, LNode DGNodeLab)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedergetNamedSpec n = searchNode (isJust . dgnPredName n)
54af18468065daf78f338739056514353bd3062aEwaryst Schulz-- | Combining a search function with an operation on nodes
54af18468065daf78f338739056514353bd3062aEwaryst SchulzfromSearchResult :: (DevGraphNavigator a) =>
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz (a -> Maybe (a, LNode DGNodeLab))
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz -> (a -> Node -> b) -> a -> Maybe b
018399e5fd62730939076e43df54cef90e4e697eEwaryst SchulzfromSearchResult sf f dgnav = case sf dgnav of
018399e5fd62730939076e43df54cef90e4e697eEwaryst Schulz Just (dgn', (n, _)) -> Just $ f dgn' n
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz-- * Other utils
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzgetLocalSyms :: DevGraphNavigator a => a -> Node -> Set.Set G_symbol
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzgetLocalSyms dgnav n =
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst Schulz case dgn_origin $ getLocalLabel dgnav n of
88e08f20c80fea4b7892bbb5e70c5002f7c1da18Christian Maeder DGBasicSpec _ _ s -> s
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzlinkSource :: LEdge a -> Node
ff2f6cd95824982d1a521e460f0beddb408eb479Ewaryst SchulzlinkLabel :: LEdge a -> a
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederlinkSource (x, _, _) = x
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederlinkLabel (_, _, x) = x