{- |
Module      :  ./OWL2/Medusa.hs
Description :  Convert OWL2 ontology to Medusa data structure
Copyright   :  (c) Till Mossakowski, Uni Magdeburg 2016
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till@iws.cs.ovgu.de
Stability   :  provisional
Portability :  portable

Convert an OWL2 ontology to Medusa data structure,
see https://github.com/ConceptualBlending/monster_render_system
-}

module OWL2.Medusa where

import qualified OWL2.AS as AS
import OWL2.Sign
import OWL2.MS

import Common.AS_Annotation
import Common.IRI as IRI
import Common.Id (stringToId)
import Common.Result

import Data.Maybe
import qualified Data.Set as Set

data Medusa = Medusa {
               Medusa -> Set (IRI, IRI)
indivs :: Set.Set (IRI, IRI),
               Medusa -> Set (IRI, IRI, IRI, IRI)
relations :: Set.Set (IRI, IRI, IRI, IRI)}

-- | given an OWL ontology (iri and theory), compute the medusa data
medusa :: IRI.IRI -> (Sign, [Named AS.Axiom])
                       -> Result Medusa
medusa :: IRI -> (Sign, [Named Axiom]) -> Result Medusa
medusa _ (sig :: Sign
sig, nsens :: [Named Axiom]
nsens) = do
  let inds :: Set IRI
inds = Sign -> Set IRI
individuals Sign
sig
      getC :: IRI -> IRI
getC = [Axiom] -> IRI -> IRI
getClass ((Named Axiom -> Axiom) -> [Named Axiom] -> [Axiom]
forall a b. (a -> b) -> [a] -> [b]
map Named Axiom -> Axiom
forall s a. SenAttr s a -> s
sentence [Named Axiom]
nsens)
      getR :: Set (IRI, IRI) -> IRI -> Set (IRI, IRI, IRI, IRI)
getR tInds :: Set (IRI, IRI)
tInds = [Axiom] -> Set (IRI, IRI) -> IRI -> Set (IRI, IRI, IRI, IRI)
getMeetsFacts ((Named Axiom -> Axiom) -> [Named Axiom] -> [Axiom]
forall a b. (a -> b) -> [a] -> [b]
map Named Axiom -> Axiom
forall s a. SenAttr s a -> s
sentence [Named Axiom]
nsens) Set (IRI, IRI)
tInds
      allInds :: Set (IRI, IRI)
allInds = (IRI -> (IRI, IRI)) -> Set IRI -> Set (IRI, IRI)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\ i :: IRI
i -> (IRI
i,IRI -> IRI
getC IRI
i)) Set IRI
inds
      relTuples :: Set (IRI, IRI, IRI, IRI)
relTuples = (Set (IRI, IRI, IRI, IRI)
 -> Set (IRI, IRI, IRI, IRI) -> Set (IRI, IRI, IRI, IRI))
-> Set (IRI, IRI, IRI, IRI)
-> [Set (IRI, IRI, IRI, IRI)]
-> Set (IRI, IRI, IRI, IRI)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set (IRI, IRI, IRI, IRI)
-> Set (IRI, IRI, IRI, IRI) -> Set (IRI, IRI, IRI, IRI)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (IRI, IRI, IRI, IRI)
forall a. Set a
Set.empty ([Set (IRI, IRI, IRI, IRI)] -> Set (IRI, IRI, IRI, IRI))
-> [Set (IRI, IRI, IRI, IRI)] -> Set (IRI, IRI, IRI, IRI)
forall a b. (a -> b) -> a -> b
$
                  (IRI -> Set (IRI, IRI, IRI, IRI))
-> [IRI] -> [Set (IRI, IRI, IRI, IRI)]
forall a b. (a -> b) -> [a] -> [b]
map (Set (IRI, IRI) -> IRI -> Set (IRI, IRI, IRI, IRI)
getR Set (IRI, IRI)
allInds) ([IRI] -> [Set (IRI, IRI, IRI, IRI)])
-> [IRI] -> [Set (IRI, IRI, IRI, IRI)]
forall a b. (a -> b) -> a -> b
$ Set IRI -> [IRI]
forall a. Set a -> [a]
Set.toList Set IRI
inds
      images :: Set IRI
images = (Set IRI -> Set IRI -> Set IRI)
-> Set IRI -> Set (Set IRI) -> Set IRI
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl Set IRI -> Set IRI -> Set IRI
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set IRI
forall a. Set a
Set.empty (Set (Set IRI) -> Set IRI) -> Set (Set IRI) -> Set IRI
forall a b. (a -> b) -> a -> b
$
               ((IRI, IRI, IRI, IRI) -> Set IRI)
-> Set (IRI, IRI, IRI, IRI) -> Set (Set IRI)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(i1 :: IRI
i1, _, i2 :: IRI
i2, _) -> [IRI] -> Set IRI
forall a. Ord a => [a] -> Set a
Set.fromList [IRI
i1, IRI
i2]) Set (IRI, IRI, IRI, IRI)
relTuples
  Medusa -> Result Medusa
forall (m :: * -> *) a. Monad m => a -> m a
return (Medusa -> Result Medusa) -> Medusa -> Result Medusa
forall a b. (a -> b) -> a -> b
$ Medusa :: Set (IRI, IRI) -> Set (IRI, IRI, IRI, IRI) -> Medusa
Medusa {
            indivs :: Set (IRI, IRI)
indivs = ((IRI, IRI) -> Bool) -> Set (IRI, IRI) -> Set (IRI, IRI)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(i :: IRI
i,_) -> IRI -> Set IRI -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member IRI
i Set IRI
images) Set (IRI, IRI)
allInds ,
            relations :: Set (IRI, IRI, IRI, IRI)
relations = Set (IRI, IRI, IRI, IRI)
relTuples
           }

checkMapMaybe :: (a -> Maybe b) -> [a] -> Maybe b
checkMapMaybe :: (a -> Maybe b) -> [a] -> Maybe b
checkMapMaybe f :: a -> Maybe b
f x :: [a]
x =
 case (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
x of
   (c :: b
c:_) -> b -> Maybe b
forall a. a -> Maybe a
Just b
c
   [] -> Maybe b
forall a. Maybe a
Nothing


getClass :: [AS.Axiom] -> IRI -> IRI
getClass :: [Axiom] -> IRI -> IRI
getClass axs :: [Axiom]
axs ind :: IRI
ind = 
  let n :: IRI
n = IRI
nullIRI { iriPath :: Id
iriPath = String -> Id
stringToId "unknown", isAbbrev :: Bool
isAbbrev = Bool
True }
      f :: Axiom -> Maybe IRI
f ax :: Axiom
ax = case Axiom
ax of
        AS.Assertion (AS.ClassAssertion _ (AS.Expression clIri :: IRI
clIri) indIri :: IRI
indIri) | IRI
indIri IRI -> IRI -> Bool
forall a. Eq a => a -> a -> Bool
== IRI
ind -> IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
clIri
        _ -> Maybe IRI
forall a. Maybe a
Nothing
  in
    IRI -> Maybe IRI -> IRI
forall a. a -> Maybe a -> a
fromMaybe IRI
n (Maybe IRI -> IRI) -> Maybe IRI -> IRI
forall a b. (a -> b) -> a -> b
$ (Axiom -> Maybe IRI) -> [Axiom] -> Maybe IRI
forall a b. (a -> Maybe b) -> [a] -> Maybe b
checkMapMaybe Axiom -> Maybe IRI
f [Axiom]
axs

--  for each individual "p1" that has a fact "meets p2"
--  look for individuals "i1" and "i2" such that
--  i1 has_fiat_boundary p1 and i2 has_fiat_boundary p2
--  and return i1 type(p1) i2 type(p2)
getMeetsFacts :: [AS.Axiom] -> Set.Set (IRI, IRI) -> IRI ->
              Set.Set (IRI, IRI, IRI, IRI)
getMeetsFacts :: [Axiom] -> Set (IRI, IRI) -> IRI -> Set (IRI, IRI, IRI, IRI)
getMeetsFacts axs :: [Axiom]
axs tInds :: Set (IRI, IRI)
tInds n :: IRI
n =
  [(IRI, IRI, IRI, IRI)] -> Set (IRI, IRI, IRI, IRI)
forall a. Ord a => [a] -> Set a
Set.fromList ([(IRI, IRI, IRI, IRI)] -> Set (IRI, IRI, IRI, IRI))
-> [(IRI, IRI, IRI, IRI)] -> Set (IRI, IRI, IRI, IRI)
forall a b. (a -> b) -> a -> b
$ (Axiom -> Maybe (IRI, IRI, IRI, IRI))
-> [Axiom] -> [(IRI, IRI, IRI, IRI)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Axiom]
-> Set (IRI, IRI) -> IRI -> Axiom -> Maybe (IRI, IRI, IRI, IRI)
getMeetsFactsAux [Axiom]
axs Set (IRI, IRI)
tInds IRI
n) [Axiom]
axs

getMeetsFactsAux :: [AS.Axiom] -> Set.Set (IRI, IRI) -> IRI -> AS.Axiom ->
                 Maybe (IRI, IRI, IRI, IRI)
getMeetsFactsAux :: [Axiom]
-> Set (IRI, IRI) -> IRI -> Axiom -> Maybe (IRI, IRI, IRI, IRI)
getMeetsFactsAux axs :: [Axiom]
axs tInds :: Set (IRI, IRI)
tInds point1 :: IRI
point1 ax :: Axiom
ax = case Axiom
ax of
  AS.Assertion (AS.ObjectPropertyAssertion _ (AS.ObjectProp ope :: IRI
ope) sInd :: IRI
sInd tInd :: IRI
tInd)
    | Id -> String
forall a. Show a => a -> String
show (IRI -> Id
iriPath IRI
ope) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "meets" Bool -> Bool -> Bool
&&
      IRI
point1 IRI -> IRI -> Bool
forall a. Eq a => a -> a -> Bool
== IRI
sInd -> [Axiom]
-> Set (IRI, IRI) -> IRI -> IRI -> Maybe (IRI, IRI, IRI, IRI)
getFiatBoundaryFacts [Axiom]
axs Set (IRI, IRI)
tInds IRI
sInd IRI
tInd
  _ -> Maybe (IRI, IRI, IRI, IRI)
forall a. Maybe a
Nothing


getFiatBoundaryFacts :: [AS.Axiom] -> Set.Set (IRI, IRI) -> IRI -> IRI ->
                     Maybe (IRI, IRI, IRI, IRI)
getFiatBoundaryFacts :: [Axiom]
-> Set (IRI, IRI) -> IRI -> IRI -> Maybe (IRI, IRI, IRI, IRI)
getFiatBoundaryFacts axs :: [Axiom]
axs tInds :: Set (IRI, IRI)
tInds point1 :: IRI
point1 point2 :: IRI
point2 =
   let i1 :: Maybe IRI
i1 = (Axiom -> Maybe IRI) -> [Axiom] -> Maybe IRI
forall a b. (a -> Maybe b) -> [a] -> Maybe b
checkMapMaybe (IRI -> Axiom -> Maybe IRI
getFiatBoundaryFactsAux IRI
point1) [Axiom]
axs
       i2 :: Maybe IRI
i2 = (Axiom -> Maybe IRI) -> [Axiom] -> Maybe IRI
forall a b. (a -> Maybe b) -> [a] -> Maybe b
checkMapMaybe (IRI -> Axiom -> Maybe IRI
getFiatBoundaryFactsAux IRI
point2) [Axiom]
axs
       typeOf :: IRI -> IRI
typeOf ind :: IRI
ind =
         case Set (IRI, IRI) -> [(IRI, IRI)]
forall a. Set a -> [a]
Set.toList (Set (IRI, IRI) -> [(IRI, IRI)]) -> Set (IRI, IRI) -> [(IRI, IRI)]
forall a b. (a -> b) -> a -> b
$ ((IRI, IRI) -> Bool) -> Set (IRI, IRI) -> Set (IRI, IRI)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(x :: IRI
x, _) -> IRI
x IRI -> IRI -> Bool
forall a. Eq a => a -> a -> Bool
== IRI
ind) Set (IRI, IRI)
tInds of
           [(_, t :: IRI
t)] -> IRI
t
           _ -> String -> IRI
forall a. HasCallStack => String -> a
error (String -> IRI) -> String -> IRI
forall a b. (a -> b) -> a -> b
$ "could not determine the type of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IRI -> String
forall a. Show a => a -> String
show IRI
ind
   in case (Maybe IRI
i1, Maybe IRI
i2) of
        (Just ind1 :: IRI
ind1, Just ind2 :: IRI
ind2) ->
           (IRI, IRI, IRI, IRI) -> Maybe (IRI, IRI, IRI, IRI)
forall a. a -> Maybe a
Just (IRI
ind1, IRI -> IRI
typeOf IRI
point1, IRI
ind2, IRI -> IRI
typeOf IRI
point2)
        _ -> Maybe (IRI, IRI, IRI, IRI)
forall a. Maybe a
Nothing

getFiatBoundaryFactsAux :: IRI -> AS.Axiom -> Maybe IRI
getFiatBoundaryFactsAux :: IRI -> Axiom -> Maybe IRI
getFiatBoundaryFactsAux point :: IRI
point ax :: Axiom
ax = case Axiom
ax of
  AS.Assertion (AS.ObjectPropertyAssertion _ (AS.ObjectProp ope :: IRI
ope) sInd :: IRI
sInd tInd :: IRI
tInd)
    | Id -> String
forall a. Show a => a -> String
show (IRI -> Id
iriPath IRI
ope) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "has_fiat_boundary" Bool -> Bool -> Bool
&& 
      (IRI -> Id
iriPath IRI
point Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== IRI -> Id
iriPath IRI
tInd) -> IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
sInd
  _ -> Maybe IRI
forall a. Maybe a
Nothing


-- | retrieve the first class of list, somewhat arbitrary
firstClass :: AnnotatedList AS.ClassExpression -> Maybe IRI
firstClass :: AnnotatedList ClassExpression -> Maybe IRI
firstClass ((_,AS.Expression c :: IRI
c):_) = IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
c
firstClass _ = Maybe IRI
forall a. Maybe a
Nothing