-- | Given a TypedGraphMorphism tgm, creates an isomorphic TypedGraphMorphism
-- tgm' where the mapping between the domain and codomain can be seen as
-- explicit inclusion (the same ids), and those ids are the same as in the type
-- graph.
--
-- Attention: It works only when the typing morphism is injective, otherwise it
-- will produce an invalid TypedGraphMorphism
reflectIdsFromTypeGraph :: TypedGraphMorphism a b -> TypedGraphMorphism a b
reflectIdsFromTypeGraph tgm =
  let
    gmDomain = domainGraph tgm
    gmCodomain = codomainGraph tgm

    newNodes gm = map (GM.applyNodeIdUnsafe gm) (nodeIds gm)
    newEdges gm = map (\x -> (GM.applyEdgeIdUnsafe gm (edgeId x), GM.applyNodeIdUnsafe gm (sourceId x), GM.applyNodeIdUnsafe gm (targetId x))) (Untyped.edges $ toUntypedGraph gm)

    newDomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmDomain)) (newNodes gmDomain)) (newEdges gmDomain)
    newCodomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmCodomain)) (newNodes gmCodomain)) (newEdges gmCodomain)

    newMaps = GM.buildGraphMorphism (toUntypedGraph newDomain) (toUntypedGraph newCodomain) (map (\(NodeId x) -> (x,x)) (nodeIds newDomain)) (map (\(EdgeId x) -> (x,x)) (edgeIds newDomain))
  in buildTypedGraphMorphism newDomain newCodomain newMaps
reflectIdsFromTypeGraph :: TypedGraphMorphism a b -> TypedGraphMorphism a b
reflectIdsFromTypeGraph tgm =
  let
    gmDomain = domainGraph tgm
    gmCodomain = codomainGraph tgm

    newNodes gm = map (GM.applyNodeIdUnsafe gm) (nodeIds gm)
    newEdges gm = map (\x -> (GM.applyEdgeIdUnsafe gm (edgeId x), GM.applyNodeIdUnsafe gm (sourceId x), GM.applyNodeIdUnsafe gm (targetId x))) (Untyped.edges $ toUntypedGraph gm)

    newDomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmDomain)) (newNodes gmDomain)) (newEdges gmDomain)
    newCodomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmCodomain)) (newNodes gmCodomain)) (newEdges gmCodomain)

    newMaps = GM.buildGraphMorphism (toUntypedGraph newDomain) (toUntypedGraph newCodomain) (map (\(NodeId x) -> (x,x)) (nodeIds newDomain)) (map (\(EdgeId x) -> (x,x)) (edgeIds newDomain))
  in buildTypedGraphMorphism newDomain newCodomain newMaps
reflectIdsFromTypeGraph tgm =
  let
    gmDomain = domainGraph tgm
    gmCodomain = codomainGraph tgm

    newNodes gm = map (GM.applyNodeIdUnsafe gm) (nodeIds gm)
    newEdges gm = map (\x -> (GM.applyEdgeIdUnsafe gm (edgeId x), GM.applyNodeIdUnsafe gm (sourceId x), GM.applyNodeIdUnsafe gm (targetId x))) (Untyped.edges $ toUntypedGraph gm)

    newDomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmDomain)) (newNodes gmDomain)) (newEdges gmDomain)
    newCodomain = foldr (\(e,s,t) -> GM.createEdgeOnDomain e s t e) (foldr (\x -> GM.createNodeOnDomain x x) (GM.empty Untyped.empty (toUntypedGraph gmCodomain)) (newNodes gmCodomain)) (newEdges gmCodomain)

    newMaps = GM.buildGraphMorphism (toUntypedGraph newDomain) (toUntypedGraph newCodomain) (map (\(NodeId x) -> (x,x)) (nodeIds newDomain)) (map (\(EdgeId x) -> (x,x)) (edgeIds newDomain))
  in buildTypedGraphMorphism newDomain newCodomain newMaps