{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./NeSyPatterns/Morphism.hs
Description :  Morphisms in NeSyPatterns logic
Copyright   :  (c) Till Mossakowski, Uni Magdeburg 2022
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till.mossakowski@ovgu.de
Stability   :  experimental
Portability :  portable

  Definition of morphisms for neural-symbolic patterns
-}

module NeSyPatterns.Morphism
  ( Morphism (..)               -- datatype for Morphisms
  , pretty                      -- pretty printing
  , idMor                       -- identity morphism
  , isLegalMorphism             -- check if morhpism is ok
  , composeMor                  -- composition
  , inclusionMap                -- inclusion map
  , applyMap                    -- application function for maps
  , applyMorphism               -- application function for morphism
  , morphismUnion
  , morphism2TokenMap
  , tokenMap2NodeMap
  ) where

import Data.Data
import qualified Data.Map as Map
import qualified Data.Set as Set

import NeSyPatterns.Sign as Sign

import Common.Id as Id
import Common.Result
import Common.Doc
import Common.DocUtils
import qualified Common.Result as Result
import Common.IRI

import Control.Monad (unless, foldM)
import qualified Data.Bifunctor

{- | Morphisms are graph homomorphisms, here: node maps -}
data Morphism = Morphism
  { Morphism -> Sign
source :: Sign.Sign
  , Morphism -> Sign
target :: Sign.Sign
  , Morphism -> Map IRI IRI
owlMap :: Map.Map IRI IRI
  , Morphism -> Map ResolvedNode ResolvedNode
nodeMap :: Map.Map Sign.ResolvedNode Sign.ResolvedNode
  } deriving (Int -> Morphism -> ShowS
[Morphism] -> ShowS
Morphism -> String
(Int -> Morphism -> ShowS)
-> (Morphism -> String) -> ([Morphism] -> ShowS) -> Show Morphism
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Morphism] -> ShowS
$cshowList :: [Morphism] -> ShowS
show :: Morphism -> String
$cshow :: Morphism -> String
showsPrec :: Int -> Morphism -> ShowS
$cshowsPrec :: Int -> Morphism -> ShowS
Show, Morphism -> Morphism -> Bool
(Morphism -> Morphism -> Bool)
-> (Morphism -> Morphism -> Bool) -> Eq Morphism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Morphism -> Morphism -> Bool
$c/= :: Morphism -> Morphism -> Bool
== :: Morphism -> Morphism -> Bool
$c== :: Morphism -> Morphism -> Bool
Eq, Eq Morphism
Eq Morphism =>
(Morphism -> Morphism -> Ordering)
-> (Morphism -> Morphism -> Bool)
-> (Morphism -> Morphism -> Bool)
-> (Morphism -> Morphism -> Bool)
-> (Morphism -> Morphism -> Bool)
-> (Morphism -> Morphism -> Morphism)
-> (Morphism -> Morphism -> Morphism)
-> Ord Morphism
Morphism -> Morphism -> Bool
Morphism -> Morphism -> Ordering
Morphism -> Morphism -> Morphism
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Morphism -> Morphism -> Morphism
$cmin :: Morphism -> Morphism -> Morphism
max :: Morphism -> Morphism -> Morphism
$cmax :: Morphism -> Morphism -> Morphism
>= :: Morphism -> Morphism -> Bool
$c>= :: Morphism -> Morphism -> Bool
> :: Morphism -> Morphism -> Bool
$c> :: Morphism -> Morphism -> Bool
<= :: Morphism -> Morphism -> Bool
$c<= :: Morphism -> Morphism -> Bool
< :: Morphism -> Morphism -> Bool
$c< :: Morphism -> Morphism -> Bool
compare :: Morphism -> Morphism -> Ordering
$ccompare :: Morphism -> Morphism -> Ordering
$cp1Ord :: Eq Morphism
Ord, Typeable)

instance Pretty Morphism where
    pretty :: Morphism -> Doc
pretty = Morphism -> Doc
printMorphism

-- | Constructs an id-morphism
idMor :: Sign -> Morphism
idMor :: Sign -> Morphism
idMor a :: Sign
a = Sign -> Sign -> Morphism
inclusionMap Sign
a Sign
a

-- | convert to token map
morphism2TokenMap :: Morphism -> Map.Map IRI IRI
morphism2TokenMap :: Morphism -> Map IRI IRI
morphism2TokenMap m :: Morphism
m =
 (Map IRI IRI -> (IRI, IRI) -> Map IRI IRI)
-> Map IRI IRI -> [(IRI, IRI)] -> Map IRI IRI
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\aMap :: Map IRI IRI
aMap (x :: IRI
x, fx :: IRI
fx) -> IRI -> IRI -> Map IRI IRI -> Map IRI IRI
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert IRI
x IRI
fx Map IRI IRI
aMap) Map IRI IRI
forall k a. Map k a
Map.empty ([(IRI, IRI)] -> Map IRI IRI) -> [(IRI, IRI)] -> Map IRI IRI
forall a b. (a -> b) -> a -> b
$
 ((ResolvedNode, ResolvedNode) -> (IRI, IRI))
-> [(ResolvedNode, ResolvedNode)] -> [(IRI, IRI)]
forall a b. (a -> b) -> [a] -> [b]
map ((ResolvedNode -> IRI)
-> (ResolvedNode -> IRI)
-> (ResolvedNode, ResolvedNode)
-> (IRI, IRI)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Data.Bifunctor.bimap ResolvedNode -> IRI
resolvedNeSyId ResolvedNode -> IRI
resolvedNeSyId) ([(ResolvedNode, ResolvedNode)] -> [(IRI, IRI)])
-> [(ResolvedNode, ResolvedNode)] -> [(IRI, IRI)]
forall a b. (a -> b) -> a -> b
$
 Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)])
-> Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)]
forall a b. (a -> b) -> a -> b
$ Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
m

tokenMap2NodeMap ::  Set.Set ResolvedNode
                  -> Set.Set ResolvedNode
                  -> Map.Map IRI IRI
                  -> Result (Map.Map ResolvedNode ResolvedNode)
tokenMap2NodeMap :: Set ResolvedNode
-> Set ResolvedNode
-> Map IRI IRI
-> Result (Map ResolvedNode ResolvedNode)
tokenMap2NodeMap sSet :: Set ResolvedNode
sSet tSet :: Set ResolvedNode
tSet tMap :: Map IRI IRI
tMap =
 (Map ResolvedNode ResolvedNode
 -> (IRI, IRI) -> Result (Map ResolvedNode ResolvedNode))
-> Map ResolvedNode ResolvedNode
-> [(IRI, IRI)]
-> Result (Map ResolvedNode ResolvedNode)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\f :: Map ResolvedNode ResolvedNode
f (t1 :: IRI
t1, t2 :: IRI
t2) -> do
                  let findT1 :: Set ResolvedNode
findT1 = IRI -> Set ResolvedNode -> Set ResolvedNode
findNodeId IRI
t1 Set ResolvedNode
sSet
                      findT2 :: Set ResolvedNode
findT2 = IRI -> Set ResolvedNode -> Set ResolvedNode
findNodeId IRI
t2 Set ResolvedNode
tSet
                  case (Set ResolvedNode -> [ResolvedNode]
forall a. Set a -> [a]
Set.toList Set ResolvedNode
findT1, Set ResolvedNode -> [ResolvedNode]
forall a. Set a -> [a]
Set.toList Set ResolvedNode
findT2) of
                    ([x :: ResolvedNode
x], [y :: ResolvedNode
y]) -> Map ResolvedNode ResolvedNode
-> Result (Map ResolvedNode ResolvedNode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ResolvedNode ResolvedNode
 -> Result (Map ResolvedNode ResolvedNode))
-> Map ResolvedNode ResolvedNode
-> Result (Map ResolvedNode ResolvedNode)
forall a b. (a -> b) -> a -> b
$ ResolvedNode
-> ResolvedNode
-> Map ResolvedNode ResolvedNode
-> Map ResolvedNode ResolvedNode
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ResolvedNode
x ResolvedNode
y Map ResolvedNode ResolvedNode
f
                    _ -> String -> Result (Map ResolvedNode ResolvedNode)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "element not found" )
         Map ResolvedNode ResolvedNode
forall k a. Map k a
Map.empty ([(IRI, IRI)] -> Result (Map ResolvedNode ResolvedNode))
-> [(IRI, IRI)] -> Result (Map ResolvedNode ResolvedNode)
forall a b. (a -> b) -> a -> b
$ Map IRI IRI -> [(IRI, IRI)]
forall k a. Map k a -> [(k, a)]
Map.toList Map IRI IRI
tMap

-- | Determines whether a morphism is valid
isLegalMorphism :: Morphism -> Result ()
isLegalMorphism :: Morphism -> Result ()
isLegalMorphism pmor :: Morphism
pmor =
    let psource :: Set ResolvedNode
psource = Sign -> Set ResolvedNode
nodes (Sign -> Set ResolvedNode) -> Sign -> Set ResolvedNode
forall a b. (a -> b) -> a -> b
$ Morphism -> Sign
source Morphism
pmor
        ptarget :: Set ResolvedNode
ptarget = Sign -> Set ResolvedNode
nodes (Sign -> Set ResolvedNode) -> Sign -> Set ResolvedNode
forall a b. (a -> b) -> a -> b
$ Morphism -> Sign
target Morphism
pmor
        pdom :: Set ResolvedNode
pdom = Map ResolvedNode ResolvedNode -> Set ResolvedNode
forall k a. Map k a -> Set k
Map.keysSet (Map ResolvedNode ResolvedNode -> Set ResolvedNode)
-> Map ResolvedNode ResolvedNode -> Set ResolvedNode
forall a b. (a -> b) -> a -> b
$ Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
pmor
        pcodom :: Set ResolvedNode
pcodom = (ResolvedNode -> ResolvedNode)
-> Set ResolvedNode -> Set ResolvedNode
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Morphism -> ResolvedNode -> ResolvedNode
applyMorphism Morphism
pmor) Set ResolvedNode
psource
    in Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set ResolvedNode -> Set ResolvedNode -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set ResolvedNode
pcodom Set ResolvedNode
ptarget Bool -> Bool -> Bool
&& Set ResolvedNode -> Set ResolvedNode -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set ResolvedNode
pdom Set ResolvedNode
psource) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
        String -> Result ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "illegal NeSyPatterns morphism"

-- | Application funtion for morphisms
applyMorphism :: Morphism -> Sign.ResolvedNode -> Sign.ResolvedNode
applyMorphism :: Morphism -> ResolvedNode -> ResolvedNode
applyMorphism mor :: Morphism
mor idt :: ResolvedNode
idt = ResolvedNode
-> ResolvedNode -> Map ResolvedNode ResolvedNode -> ResolvedNode
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ResolvedNode
idt ResolvedNode
idt (Map ResolvedNode ResolvedNode -> ResolvedNode)
-> Map ResolvedNode ResolvedNode -> ResolvedNode
forall a b. (a -> b) -> a -> b
$ Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
mor

-- | Application function for nodeMaps
applyMap :: Map.Map Sign.ResolvedNode Sign.ResolvedNode -> Sign.ResolvedNode -> Sign.ResolvedNode
applyMap :: Map ResolvedNode ResolvedNode -> ResolvedNode -> ResolvedNode
applyMap pmap :: Map ResolvedNode ResolvedNode
pmap idt :: ResolvedNode
idt = ResolvedNode
-> ResolvedNode -> Map ResolvedNode ResolvedNode -> ResolvedNode
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ResolvedNode
idt ResolvedNode
idt Map ResolvedNode ResolvedNode
pmap

-- | Composition of morphisms in propositional Logic
composeMor :: Morphism -> Morphism -> Result Morphism
composeMor :: Morphism -> Morphism -> Result Morphism
composeMor f :: Morphism
f g :: Morphism
g =
  let fSource :: Sign
fSource = Morphism -> Sign
source Morphism
f
      gTarget :: Sign
gTarget = Morphism -> Sign
target Morphism
g
      fMap :: Map ResolvedNode ResolvedNode
fMap = Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
f
      gMap :: Map ResolvedNode ResolvedNode
gMap = Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
g
  in Morphism -> Result Morphism
forall (m :: * -> *) a. Monad m => a -> m a
return Morphism :: Sign
-> Sign -> Map IRI IRI -> Map ResolvedNode ResolvedNode -> Morphism
Morphism
  { source :: Sign
source = Sign
fSource
  , target :: Sign
target = Sign
gTarget
  , owlMap :: Map IRI IRI
owlMap = Map IRI IRI
forall k a. Map k a
Map.empty -- TODO
  , nodeMap :: Map ResolvedNode ResolvedNode
nodeMap = if Map ResolvedNode ResolvedNode -> Bool
forall k a. Map k a -> Bool
Map.null Map ResolvedNode ResolvedNode
gMap then Map ResolvedNode ResolvedNode
fMap else
      (ResolvedNode
 -> Map ResolvedNode ResolvedNode -> Map ResolvedNode ResolvedNode)
-> Map ResolvedNode ResolvedNode
-> Set ResolvedNode
-> Map ResolvedNode ResolvedNode
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold ( \ i :: ResolvedNode
i -> let j :: ResolvedNode
j = Map ResolvedNode ResolvedNode -> ResolvedNode -> ResolvedNode
applyMap Map ResolvedNode ResolvedNode
gMap (Map ResolvedNode ResolvedNode -> ResolvedNode -> ResolvedNode
applyMap Map ResolvedNode ResolvedNode
fMap ResolvedNode
i) in
                        if ResolvedNode
i ResolvedNode -> ResolvedNode -> Bool
forall a. Eq a => a -> a -> Bool
== ResolvedNode
j then Map ResolvedNode ResolvedNode -> Map ResolvedNode ResolvedNode
forall a. a -> a
id else ResolvedNode
-> ResolvedNode
-> Map ResolvedNode ResolvedNode
-> Map ResolvedNode ResolvedNode
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ResolvedNode
i ResolvedNode
j)
                                  Map ResolvedNode ResolvedNode
forall k a. Map k a
Map.empty (Set ResolvedNode -> Map ResolvedNode ResolvedNode)
-> Set ResolvedNode -> Map ResolvedNode ResolvedNode
forall a b. (a -> b) -> a -> b
$ Sign -> Set ResolvedNode
nodes Sign
fSource }

-- | Pretty printing for Morphisms
printMorphism :: Morphism -> Doc
printMorphism :: Morphism -> Doc
printMorphism m :: Morphism
m = Sign -> Doc
forall a. Pretty a => a -> Doc
pretty (Morphism -> Sign
source Morphism
m) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "-->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sign -> Doc
forall a. Pretty a => a -> Doc
pretty (Morphism -> Sign
target Morphism
m)
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
vcat (((ResolvedNode, ResolvedNode) -> Doc)
-> [(ResolvedNode, ResolvedNode)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ( \ (x :: ResolvedNode
x, y :: ResolvedNode
y) -> Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ResolvedNode -> Doc
forall a. Pretty a => a -> Doc
pretty ResolvedNode
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text ","
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ResolvedNode -> Doc
forall a. Pretty a => a -> Doc
pretty ResolvedNode
y Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen) ([(ResolvedNode, ResolvedNode)] -> [Doc])
-> [(ResolvedNode, ResolvedNode)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)])
-> Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)]
forall a b. (a -> b) -> a -> b
$ Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
m)

-- | Inclusion map of a subsig into a supersig
inclusionMap :: Sign.Sign -> Sign.Sign -> Morphism
inclusionMap :: Sign -> Sign -> Morphism
inclusionMap s1 :: Sign
s1 s2 :: Sign
s2 = Morphism :: Sign
-> Sign -> Map IRI IRI -> Map ResolvedNode ResolvedNode -> Morphism
Morphism
  { source :: Sign
source = Sign
s1
  , target :: Sign
target = Sign
s2
  , owlMap :: Map IRI IRI
owlMap = Map IRI IRI
forall k a. Map k a
Map.empty
  , nodeMap :: Map ResolvedNode ResolvedNode
nodeMap = Map ResolvedNode ResolvedNode
forall k a. Map k a
Map.empty }


morphismUnion :: Morphism -> Morphism -> Result.Result Morphism
morphismUnion :: Morphism -> Morphism -> Result Morphism
morphismUnion mor1 :: Morphism
mor1 mor2 :: Morphism
mor2 =
  let pmap1 :: Map ResolvedNode ResolvedNode
pmap1 = Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
mor1
      pmap2 :: Map ResolvedNode ResolvedNode
pmap2 = Morphism -> Map ResolvedNode ResolvedNode
nodeMap Morphism
mor2
      p1 :: Sign
p1 = Morphism -> Sign
source Morphism
mor1
      p2 :: Sign
p2 = Morphism -> Sign
source Morphism
mor2
      up1 :: Set ResolvedNode
up1 = Set ResolvedNode -> Set ResolvedNode -> Set ResolvedNode
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Sign -> Set ResolvedNode
nodes Sign
p1) (Set ResolvedNode -> Set ResolvedNode)
-> Set ResolvedNode -> Set ResolvedNode
forall a b. (a -> b) -> a -> b
$ Map ResolvedNode ResolvedNode -> Set ResolvedNode
forall k a. Map k a -> Set k
Map.keysSet Map ResolvedNode ResolvedNode
pmap1
      up2 :: Set ResolvedNode
up2 = Set ResolvedNode -> Set ResolvedNode -> Set ResolvedNode
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Sign -> Set ResolvedNode
nodes Sign
p2) (Set ResolvedNode -> Set ResolvedNode)
-> Set ResolvedNode -> Set ResolvedNode
forall a b. (a -> b) -> a -> b
$ Map ResolvedNode ResolvedNode -> Set ResolvedNode
forall k a. Map k a -> Set k
Map.keysSet Map ResolvedNode ResolvedNode
pmap2
      (pds :: [Diagnosis]
pds, pmap :: Map ResolvedNode ResolvedNode
pmap) = ((ResolvedNode, ResolvedNode)
 -> ([Diagnosis], Map ResolvedNode ResolvedNode)
 -> ([Diagnosis], Map ResolvedNode ResolvedNode))
-> ([Diagnosis], Map ResolvedNode ResolvedNode)
-> [(ResolvedNode, ResolvedNode)]
-> ([Diagnosis], Map ResolvedNode ResolvedNode)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( \ (i :: ResolvedNode
i, j :: ResolvedNode
j) (ds :: [Diagnosis]
ds, m :: Map ResolvedNode ResolvedNode
m) -> case ResolvedNode -> Map ResolvedNode ResolvedNode -> Maybe ResolvedNode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ResolvedNode
i Map ResolvedNode ResolvedNode
m of
          Nothing -> ([Diagnosis]
ds, ResolvedNode
-> ResolvedNode
-> Map ResolvedNode ResolvedNode
-> Map ResolvedNode ResolvedNode
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ResolvedNode
i ResolvedNode
j Map ResolvedNode ResolvedNode
m)
          Just k :: ResolvedNode
k -> if ResolvedNode
j ResolvedNode -> ResolvedNode -> Bool
forall a. Eq a => a -> a -> Bool
== ResolvedNode
k then ([Diagnosis]
ds, Map ResolvedNode ResolvedNode
m) else
              (DiagKind -> String -> Range -> Diagnosis
Diag DiagKind
Error
               ("incompatible mapping of prop " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ResolvedNode -> String
forall a. Show a => a -> String
show ResolvedNode
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " to "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ ResolvedNode -> String
forall a. Show a => a -> String
show ResolvedNode
j String -> ShowS
forall a. [a] -> [a] -> [a]
++ " and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ResolvedNode -> String
forall a. Show a => a -> String
show ResolvedNode
k)
               Range
nullRange Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: [Diagnosis]
ds, Map ResolvedNode ResolvedNode
m)) ([], Map ResolvedNode ResolvedNode
pmap1)
          (Map ResolvedNode ResolvedNode -> [(ResolvedNode, ResolvedNode)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ResolvedNode ResolvedNode
pmap2 [(ResolvedNode, ResolvedNode)]
-> [(ResolvedNode, ResolvedNode)] -> [(ResolvedNode, ResolvedNode)]
forall a. [a] -> [a] -> [a]
++ (ResolvedNode -> (ResolvedNode, ResolvedNode))
-> [ResolvedNode] -> [(ResolvedNode, ResolvedNode)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a :: ResolvedNode
a -> (ResolvedNode
a, ResolvedNode
a))
                      (Set ResolvedNode -> [ResolvedNode]
forall a. Set a -> [a]
Set.toList (Set ResolvedNode -> [ResolvedNode])
-> Set ResolvedNode -> [ResolvedNode]
forall a b. (a -> b) -> a -> b
$ Set ResolvedNode -> Set ResolvedNode -> Set ResolvedNode
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set ResolvedNode
up1 Set ResolvedNode
up2))
   in if [Diagnosis] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnosis]
pds then Morphism -> Result Morphism
forall (m :: * -> *) a. Monad m => a -> m a
return Morphism :: Sign
-> Sign -> Map IRI IRI -> Map ResolvedNode ResolvedNode -> Morphism
Morphism
      { source :: Sign
source = Sign -> Sign -> Sign
unite Sign
p1 Sign
p2
      , target :: Sign
target = Sign -> Sign -> Sign
unite (Morphism -> Sign
target Morphism
mor1) (Sign -> Sign) -> Sign -> Sign
forall a b. (a -> b) -> a -> b
$ Morphism -> Sign
target Morphism
mor2
      , owlMap :: Map IRI IRI
owlMap = Map IRI IRI
forall k a. Map k a
Map.empty --TODO
      , nodeMap :: Map ResolvedNode ResolvedNode
nodeMap = Map ResolvedNode ResolvedNode
pmap } else [Diagnosis] -> Maybe Morphism -> Result Morphism
forall a. [Diagnosis] -> Maybe a -> Result a
Result [Diagnosis]
pds Maybe Morphism
forall a. Maybe a
Nothing