Skip to content
Snippets Groups Projects
Commit 0729c2c9 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Write more lenses for Graph type

parent f9b08c37
Branches
Tags
No related merge requests found
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
module Compare.Types.Lenses where module Compare.Types.Lenses
( outLEdges
, inLEdges
, edgeFrom
, edgeTo
, edgeLabel
, inn
, edges
, nodes
, node
) where
import qualified Data.Graph.Inductive as G import qualified Data.Graph.Inductive as G
import Lens.Micro import Lens.Micro
...@@ -39,24 +49,31 @@ edgeLabel = _3 ...@@ -39,24 +49,31 @@ edgeLabel = _3
inn :: G.Node -> Traversal' (Graph n e) (G.LEdge e) inn :: G.Node -> Traversal' (Graph n e) (G.LEdge e)
inn node = inLEdges node . traverse inn node = inLEdges node . traverse
edges :: Traversal' (Graph n e) e ctxEdges :: Traversal (G.Context n e1) (G.Context n e2) e1 e2
edges action g = ctxEdges action (inn, n, a, out) = (,n,a,) <$> lift inn <*> lift out
let where
oldEdges = g^._graph.to G.labEdges lift = (each . _1) action
action' (a,b,l) = (a,b,) <$> action l
newEdges = traverse action' oldEdges edges :: Traversal (Graph n e1) (Graph n e2) e1 e2
in edges = _graph . gContexts . ctxEdges
(\x -> replaceEdges oldEdges x g) <$> newEdges
nodes :: Traversal (Graph n1 e) (Graph n2 e) n1 n2
nodes = _graph . gContexts . _3
gContexts :: G.DynGraph gr => Traversal (gr n1 e1) (gr n2 e2)
(G.Context n1 e1) (G.Context n2 e2)
gContexts action = G.ufold (\ctx g -> (G.&) <$> action ctx <*> g) (pure G.empty)
ctxNode :: G.Node -> Traversal' (G.Context n e) n
ctxNode node act ctx
| ctx^._2 == node = _3 act ctx
| otherwise = pure ctx
gNode :: G.DynGraph gr => G.Node -> Traversal' (gr n e) n
gNode node = gContexts . ctxNode node
-- | See http://stackoverflow.com/questions/22169735/how-to-modify-node-label-in-fgl-package
node :: G.Node -> Traversal' (Graph n e) n node :: G.Node -> Traversal' (Graph n e) n
node n = _graph . change node n = _graph . gNode n
where
change action g = case G.match n (g) of
(Just (p, _, l, s), cg) ->
let newC = (p, n, , s) <$> action l
in (G.& cg) <$> newC
(Nothing, _) -> pure g
replaceEdges :: [G.LEdge e] -> [G.LEdge e] -> Graph n e -> Graph n e replaceEdges :: [G.LEdge e] -> [G.LEdge e] -> Graph n e -> Graph n e
replaceEdges e1 e2 g = g & _graph %~ G.delEdges (map G.toEdge e1) replaceEdges e1 e2 g = g & _graph %~ G.delEdges (map G.toEdge e1)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment