a comorphism from OWL2 to CommonLogic
-- CommonLogic = codomain
data OWL22CommonLogic = OWL22CommonLogic deriving Show
instance Language OWL22CommonLogic
OWL22CommonLogic -- comorphism
ProfSub -- sublogics domain
OntologyDocument -- Basic spec domain
SymbItems -- symbol items domain
SymbMapItems -- symbol map items domain
OWLMorphism -- morphism domain
RawSymb -- rawsymbol domain
ProofTree -- proof tree codomain
CommonLogic -- lid codomain
BASIC_SPEC -- Basic spec codomain
TEXT_META -- sentence codomain
SYMB_ITEMS -- symbol items codomain
SYMB_MAP_ITEMS -- symbol map items codomain
Sign -- signature codomain
Symbol -- symbol codomain
Symbol -- rawsymbol codomain
ProofTree -- proof tree domain
sourceLogic OWL22CommonLogic = OWL2
sourceSublogic OWL22CommonLogic = topS
targetLogic OWL22CommonLogic = CommonLogic
mapSublogic OWL22CommonLogic _ = Just
ClSl.top -- map_theory is not needed when mapMarkedTheory is defined
map_theory OWL22CommonLogic = error "map_theory OWL22CommonLogic"
mapMarkedTheory OWL22CommonLogic = mapTheory
map_morphism OWL22CommonLogic = mapMorphism
map_symbol OWL22CommonLogic _ = mapSymbol
isInclusionComorphism OWL22CommonLogic = True
has_model_expansion OWL22CommonLogic = True
(t4 -> t -> t1 -> t2 -> m t3) -> t4 -> t -> t1 -> t2 -> m (t3, t4)
failMsg :: Pretty a => a -> Result b
failMsg a = fail $ "cannot translate " ++ showDoc a "\n"
voiToTok :: VarOrIndi -> Token
varToInt :: VarOrIndi -> Int
_ -> error $ "could not translate " ++ show v
uriToTokM :: IRI -> Result Token
uriToTokM = return . uriToTok
mkBools :: BOOL_SENT -> SENTENCE
mkBools bs = Bool_sent bs nullRange
mkAtoms :: ATOM -> SENTENCE
mkAtoms as = Atom_sent as nullRange
mkUnivQ :: [NAME_OR_SEQMARK] -> SENTENCE ->
Id.Range -> SENTENCE
mkUnivQ = Quant_sent Universal
mkExist :: [NAME_OR_SEQMARK] -> SENTENCE ->
Id.Range -> SENTENCE
mkExist = Quant_sent Existential
cnjct :: [SENTENCE] -> BOOL_SENT
cnjct = Junction Conjunction
dsjct :: [SENTENCE] -> BOOL_SENT
dsjct = Junction Disjunction
mkNeg :: SENTENCE -> BOOL_SENT
mkImpl :: SENTENCE -> SENTENCE -> BOOL_SENT
mkImpl = BinOp Implication
mkBicnd :: SENTENCE -> SENTENCE -> BOOL_SENT
mkBicnd = BinOp Biconditional
mkNAME :: Int -> NAME_OR_SEQMARK
mkNAME n = Name (mkNName n)
mkNTERM n = Name_term (mkNName n)
mkVTerm :: VarOrIndi -> TERM
mkVTerm = Name_term . voiToTok
mkTermSeq :: NAME -> TERM_SEQ
mkTermSeq = Term_seq . Name_term
senToText :: SENTENCE -> TEXT
senToText s = Text [Sentence s] nullRange
msen2Txt :: [SENTENCE] -> [TEXT]
mk1NAME :: NAME_OR_SEQMARK
mk1QU :: SENTENCE -> SENTENCE
mk1QU s = mkUnivQ [mk1NAME] s nullRange
mkQU :: [NAME_OR_SEQMARK] -> SENTENCE -> SENTENCE
mkQU l s = mkUnivQ l s nullRange
mkBI :: SENTENCE -> SENTENCE -> SENTENCE
mkBI s = mkBools . mkImpl s
mkBN :: SENTENCE -> SENTENCE
mkBD :: [SENTENCE] -> SENTENCE
mkBC :: [SENTENCE] -> SENTENCE
mkBB :: SENTENCE -> SENTENCE -> SENTENCE
mkBB s = mkBools . mkBicnd s
mkQE :: [NAME_OR_SEQMARK] -> SENTENCE -> SENTENCE
mkQE l s = mkExist l s nullRange
mkAE :: TERM -> TERM -> SENTENCE
mkAE t = mkAtoms . Equation t
mkEqual :: NAME -> NAME -> SENTENCE
mkEqual t1 t2 = mkAE (Name_term t1) $ Name_term t2
mkSent :: [NAME_OR_SEQMARK] -> [NAME_OR_SEQMARK] -> SENTENCE -> SENTENCE
mkSent l1 l2 s = mkQU l1 . mkQE l2 . mkBI s
mkQUBI :: [NAME_OR_SEQMARK] -> [SENTENCE] -> TERM -> TERM -> TEXT
mkQUBI l1 l2 a b = senToText $ mkQU l1 $ mkBI (mkBC l2) $ mkAE a b
mkTermAtoms :: NAME -> [TERM] -> SENTENCE
mkTermAtoms ur tl = mkAtoms $ Atom (Name_term ur) $ map Term_seq tl
mk1TermAtom :: NAME -> SENTENCE
mk1TermAtom ur = mkTermAtoms ur [mk1NTERM]
mkSAtom :: String -> SENTENCE
mkSAtom = mk1TermAtom . mkSimpleId
sHead :: [SENTENCE] -> SENTENCE
eqFB :: [Int] -> [SENTENCE] -> TEXT
eqFB nl l = senToText $ mkQU (map mkNAME nl) $ sHead l
mkNNameH :: Int -> String
j -> mkNNameH (j `div` 26) ++ [chr $ j `mod` 26 + 96]
mkNName i = mkSimpleId $ hetsPrefix ++ mkNNameH i
-- | Get all distinct pairs for commutative operations
comPairs :: [t] -> [t1] -> [(t, t1)]
comPairs (a : as) (_ : bs) = mkPairs a bs ++ comPairs as bs
mkPairs :: t -> [t1] -> [(t, t1)]
mkPairs a = map (\ b -> (a, b))
data VarOrIndi = OVar Int | OIndi IRI
-- | Mapping of OWL morphisms to CommonLogic morphisms
dm <- mapSign $ osource oMor
cd <- mapSign $ otarget oMor
mapp <- mapMap $ mmaps oMor
mapSymbol :: Entity ->
Set.Set Symbol
mapSymbol (Entity _ _ iri) =
Set.singleton $ idToRaw $ uriToId iri
in return emptySig { discourseNames = itms }
$ mk1QU $ mkBI (mk1TermAtom $ uriToTok iri) $ mkSAtom "Thing"
$ mk1QU $ mkBI (mk1TermAtom $ uriToTok iri) $ mkSAtom "Datatype"
let [d, pr] = map (`mkTermAtoms` map mkNTERM [1, 2])
[uriToTok prop, mkSimpleId s]
in mkBI d $ if s `elem` [topDataProp, topObjProp] then pr else mkBN pr
++ map dataIncl (map (setPrefix "xsd" . mkQName) datatypeKeys ++ dt)
++ map (propertyIncl topDataProp) dp
++ map (propertyIncl bottomDataProp) dp
++ map (propertyIncl topObjProp) op
++ map (propertyIncl bottomObjProp) op
$ mkBC $ map mkSAtom ["Thing", "Datatype"]
mapTheory (owlSig, owlSens) = do
(cSensI, nSig) <- foldM (\ (x, y) z ->
(sen, sig) <- mapSentence y z
return (x ++ sen, unite sig y)
let sig = unite (emptySig {discourseNames =
Set.fromList $ map (uriToId .
setReservedPrefix . mkQName) $ "Datatype" : predefClass
++ [topDataProp, bottomDataProp, topObjProp, bottomObjProp]
[nothingSent, thingDataDisjoint]
-- | mapping of OWL to CommonLogic_DL formulae
mapSentence :: Sign -- ^ CommonLogic Signature
mapSentence cSig inSen = do
-- | Mapping of Class IRIs
mapClassIRI :: Sign -> Class -> Token -> Result SENTENCE
mapClassIRI _ c tok = fmap (`mkTermAtoms` [Name_term tok]) $ uriToTokM c
-- | Mapping of Individual IRIs
mapIndivIRI :: Sign -> Individual -> Result TERM
mapIndivIRI _ i = fmap Name_term $ uriToTokM i
-- | mapping of individual list
mapComIndivList :: Sign -> SameOrDifferent -> Maybe Individual -> [Individual]
mapComIndivList cSig sod mi inds = do
fs <- mapM (mapIndivIRI cSig) inds
Nothing -> return $ comPairs fs fs
Just i -> fmap (`mkPairs` fs) $ mapIndivIRI cSig i
let sntLst = map (\ (x, y) -> case sod of
Different -> mkBN $ mkAE x y) il
mapLit :: Int -> Literal -> Result (Either (SENTENCE, SENTENCE) TERM)
mapLit i c = return $ case c of
Literal l ty -> case ty of
Typed dt -> Left (mkEqual (mkSimpleId l) $ mkNName i,
mkTermAtoms (uriToTok dt) [mkNTERM i])
Untyped _ -> Right $ Name_term $ mkSimpleId l
NumberLit l -> Left (mkEqual (mkSimpleId $ show l) $ mkNName i,
mkTermAtoms (mkSimpleId $ numberName l) [mkNTERM i])
-- | Mapping of data properties
mapDataProp :: Sign -> DataPropertyExpression -> VarOrIndi -> VarOrIndi
mapDataProp _ dp a b = fmap (`mkTermAtoms` map mkVTerm [a, b])
mapDataPropI :: Sign -> VarOrIndi -> VarOrIndi -> DataPropertyExpression
mapDataPropI cSig a b dp = mapDataProp cSig dp a b
-- | Mapping of obj props
mapObjProp :: Sign -> ObjectPropertyExpression -> VarOrIndi -> VarOrIndi
mapObjProp cSig ob v1 v2 = case ob of
ObjectProp u -> fmap (`mkTermAtoms` map mkVTerm [v1, v2]) $ uriToTokM u
ObjectInverseOf u -> mapObjProp cSig u v2 v1
mapDPE :: Sign -> DataPropertyExpression -> Int -> Int -> Result SENTENCE
mapDPE cSig dpe x y = mapDataProp cSig dpe (OVar x) $ OVar y
mapOPE :: Sign -> ObjectPropertyExpression -> Int -> Int -> Result SENTENCE
mapOPE cSig ope x y = mapObjProp cSig ope (OVar x) $ OVar y
mapOPEList :: Sign -> Int -> Int -> [ObjectPropertyExpression]
mapOPEList s a b = mapM ((\ sig x1 x2 op -> mapOPE sig op x1 x2 ) s a b)
mapDPEList :: Sign -> Int -> Int -> [DataPropertyExpression]
mapDPEList s a b = mapM ((\ sig x1 x2 dp -> mapDPE sig dp x1 x2 ) s a b)
mapObjPropListP :: Sign -> Int -> Int
-> [(ObjectPropertyExpression, ObjectPropertyExpression)]
-> Result [(SENTENCE, SENTENCE)]
mapObjPropListP = mapObjOrDataListP mapOPEList
mapDataPropListP :: Sign -> Int -> Int
-> [(DataPropertyExpression, DataPropertyExpression)]
-> Result [(SENTENCE, SENTENCE)]
mapDataPropListP = mapObjOrDataListP mapDPEList
mapObjOrDataListP :: Monad m => (t -> t1 -> t2 -> [a] -> m [b]) -> t -> t1 -> t2
-> [(a, a)] -> m [(b, b)]
mapObjOrDataListP f cSig a b ls = do
-- | mapping of Data Range
mapDataRange :: Sign -> DataRange -> VarOrIndi -> Result (SENTENCE, Sign)
mapDataRange cSig dr var = let uid = mkVTerm var in case dr of
DataJunction jt drl -> do
(jl, sig) <- mapAndUnzipM ((\ s v r -> mapDataRange s r v) cSig var) drl
IntersectionOf -> (mkBC jl, un)
DataComplementOf cdr -> do
(dc, sig) <- mapDataRange cSig cdr var
let (sens, ts) = (lefts cl, rights cl)
sl = map (\ (s1, s2) -> mkBC [s1, s2]) sens
tl <- mapM (\ x -> return $ mkAtoms $ Atom x [Term_seq uid]) ts
return (mkBD $ tl ++ sl, cSig)
let sent = mkTermAtoms (uriToTok dt) [uid]
(sens, sigL) <- mapAndUnzipM (mapFacet cSig var uid) rlst
return (mkBC $ sent : sens, uniteL $ cSig : sigL)
-- | mapping of a tuple of ConstrainingFacet and RestictionValue
mapFacet :: Sign -> VarOrIndi -> TERM -> (ConstrainingFacet, RestrictionValue)
-> Result (SENTENCE, Sign)
mapFacet sig i var (f, r) = let v = varToInt i + 1 in do
let sign = unite sig $ emptySig {
$ stripReservedPrefix f]}
Right lit -> return (mkTermAtoms (uriToTok f) [lit, var], sign)
Left (s1, s2) -> return (mkBC [mkTermAtoms (uriToTok f)
[mkVTerm $ OVar v, var], s1, s2], sign)
cardProps :: Bool -> Sign
-> Either ObjectPropertyExpression DataPropertyExpression -> Int
-> [VarOrIndi] -> Result [SENTENCE]
cardProps b cSig prop var vLst =
if b then let Left ope = prop in mapM (mapObjProp cSig ope $ OVar var) vLst
else let Right dpe = prop in mapM (mapDataProp cSig dpe $ OVar var) vLst
mapCard :: Bool -> Sign -> CardinalityType -> Int
-> Either ObjectPropertyExpression DataPropertyExpression
-> Maybe (Either ClassExpression DataRange) -> Int
-> Result (SENTENCE, Sign)
mapCard b cSig ct n prop d var = do
let vlst = map (var +) [1 .. n]
vlstM = vlst ++ [n + var + 1]
(dOut, sigL) <- case d of
Nothing -> return ([], [])
if b then let Left ce = y in mapAndUnzipM
(uncurry $ mapDescription cSig ce) $ zip vLst vlst
else let Right dr = y in mapAndUnzipM (mapDataRange cSig dr) vLst
let dlst = map (\ (x, y) -> mkBN $ mkAE (mkNTERM x) $ mkNTERM y)
dlstM = map (\ (x, y) -> mkAE (mkNTERM x) $ mkNTERM y)
qVarsM = map mkNAME vlstM
oProps <- cardProps b cSig prop var vLst
oPropsM <- cardProps b cSig prop var vLstM
let minLst = mkQE qVars $ mkBC $ dlst ++ dOut ++ oProps
maxLst = mkQE qVarsM $ mkBI (mkBC $ oPropsM ++ dOut) $ mkBD dlstM
MinCardinality -> (minLst, cSig)
MaxCardinality -> (maxLst, cSig)
ExactCardinality -> (mkBC [minLst, maxLst], uniteL sigL)
-- | mapping of OWL Descriptions
mapDescription :: Sign -> ClassExpression -> VarOrIndi -> Int
-> Result (SENTENCE, Sign)
mapDescription cSig des oVar aVar =
ne <- mapClassIRI cSig cl varN
ObjectJunction jt desL -> do
(cel, dSig) <- mapAndUnzipM ((\ w x y z -> mapDescription w z x y)
UnionOf -> (mkBD cel, un)
IntersectionOf -> (mkBC cel, un)
ObjectComplementOf descr -> do
(ce, dSig) <- mapDescription cSig descr oVar aVar
nil <- mapM (mapIndivIRI cSig) il
return (mkBD $ map (mkAE $ Name_term varN) nil, cSig)
ObjectValuesFrom qt oprop descr -> let v = var + 1 in do
ope <- mapOPE cSig oprop var v
(ce, dSig) <- mapDescription cSig descr (OVar v) $ aVar + 1
SomeValuesFrom -> (mkQE [mkNAME v] $ mkBC [ope, ce], dSig)
AllValuesFrom -> (mkQU [mkNAME v] $ mkBI ope ce, dSig)
ObjectHasSelf oprop -> smap mapObjProp cSig oprop oVar oVar
ObjectHasValue oprop indiv -> smap mapObjProp cSig oprop oVar (OIndi indiv)
ObjectCardinality (Cardinality ct n oprop d) -> mapCard True cSig ct n
(Left oprop) (fmap Left d) var
DataValuesFrom qt dpe dr -> let varNN = mkNName $ var + 1 in do
(drSent, drSig) <- mapDataRange cSig dr $ OVar $ var + 1
senl <- mapM (mapDataPropI cSig (OVar var) $ OVar $ var + 1) [dpe]
let sent = mkBC $ drSent : senl
AllValuesFrom -> (mkQU [Name varNN] sent, drSig)
SomeValuesFrom -> (mkQE [Name varNN] sent, drSig)
Right lit -> return (mkAtoms $ Atom (Name_term $ uriToTok dpe)
[mkTermSeq varN, Term_seq lit], cSig)
sens <- mapDataProp cSig dpe oVar $ OVar nvar
return (mkBC [sens, s1, s2], cSig)
DataCardinality (Cardinality ct n dpe dr) -> mapCard False cSig ct n
(Right dpe) (fmap Right dr) var
-- | Mapping of a list of descriptions
mapDescriptionList :: Sign -> Int -> [ClassExpression]
-> Result ([SENTENCE], Sign)
mapDescriptionList cSig n lst = do
(sens, lSig) <- mapAndUnzipM ((\ w x y z ->
mapDescription w z x y) cSig (OVar n) n) lst
-- | Mapping of a list of pairs of descriptions
mapDescriptionListP :: Sign -> Int -> [(ClassExpression, ClassExpression)]
-> Result ([(SENTENCE, SENTENCE)], Sign)
mapDescriptionListP cSig n lst = do
(llst, ssSig) <- mapDescriptionList cSig n l
(rlst, tSig) <- mapDescriptionList cSig n r
return (zip llst rlst, unite ssSig tSig)
mapClassAssertion :: TERM -> (ClassExpression, SENTENCE) -> TEXT
mapClassAssertion ind (ce, sent) = case ce of
Expression _ -> senToText sent
_ -> senToText $ (mk1QU . mkBI (mkAE mk1NTERM ind)) sent
mapFact :: Sign -> Extended -> Fact -> Result TEXT
mapFact cSig ex f = case f of
ObjectPropertyFact posneg obe ind -> case ex of
SimpleEntity (Entity _ NamedIndividual siri) -> do
oPropH <- mapObjProp cSig obe (OIndi siri) (OIndi ind)
return $ senToText $ case posneg of
DataPropertyFact posneg dpe lit -> case ex of
SimpleEntity (Entity _ NamedIndividual iri) -> do
inS <- mapIndivIRI cSig iri
Right li -> return $ mkTermAtoms nm [inS, li]
sens <- mapDataProp cSig dpe (OIndi iri) $ OVar 1
return $ mkBC [sens, s1, s2]
return $ senToText $ case posneg of
mapCharact :: Sign -> ObjectPropertyExpression -> Character -> Result TEXT
mapCharact cSig ope c = case c of
so1 <- mapOPE cSig ope 1 2
so2 <- mapOPE cSig ope 1 3
return $ mkQUBI (map mkNAME [1, 2, 3]) [so1, so2]
so1 <- mapOPE cSig ope 1 3
so2 <- mapOPE cSig ope 2 3
return $ mkQUBI (map mkNAME [1, 2, 3]) [so1, so2]
so <- mapOPE cSig ope 1 1
return $ senToText $ mk1QU so
so <- mapOPE cSig ope 1 1
return $ senToText $ mk1QU $ mkBN so
so1 <- mapOPE cSig ope 1 2
so2 <- mapOPE cSig ope 2 1
return $ senToText $ mkQU [mkNAME 1, mkNAME 2] $ mkBI so1 so2
so1 <- mapOPE cSig ope 1 2
so2 <- mapOPE cSig ope 2 1
return $ senToText $ mkQU [mkNAME 1, mkNAME 2] $ mkBI so1 $ mkBN so2
so1 <- mapOPE cSig ope 1 2
so2 <- mapOPE cSig ope 2 1
return $ mkQUBI [mkNAME 1, mkNAME 2] [so1, so2] (mkNTERM 1) (mkNTERM 2)
so1 <- mapOPE cSig ope 1 2
so2 <- mapOPE cSig ope 2 3
so3 <- mapOPE cSig ope 1 3
return $ senToText $ mkQU [mkNAME 1, mkNAME 2, mkNAME 3] $ mkBI
mapKey :: Sign -> ClassExpression -> ([SENTENCE], [SENTENCE]) -> Int -> [Int]
mapKey cSig ce (pl, npl) p i = do
(nce, _) <- mapDescription cSig ce (OVar 1) 1
(c3, _) <- mapDescription cSig ce (OVar p) p
let un = mkQU [mkNAME p] $ mkBI (mkBC $ c3 : npl)
$ mkAE (mkNTERM p) $ mkNTERM 1
return $ mk1QU $ mkBI nce $ mkQE (map mkNAME i) $ mkBC $ pl ++ [un]
mapSubObjProp :: Sign -> ObjectPropertyExpression -> ObjectPropertyExpression
-> Int -> Result SENTENCE
mapSubObjProp cSig sp p a = let b = a + 1 in do
return $ mkQU (map mkNAME [a, b]) $ mkBI l r
mapSubObjPropChain :: Sign -> [ObjectPropertyExpression]
-> ObjectPropertyExpression -> Int -> Result SENTENCE
mapSubObjPropChain cSig opl op a = let b = a + 1 in do
let vars = [a + 2 .. a + length opl]
npl <- sequence $ zipWith3 (mapOPE cSig) opl vl $ tail vl
let lst = map mkNAME $ a : b : vars
return $ mkQU lst $ mkBI (mkBC npl) np
mkEDPairs :: Sign -> [Int] -> Maybe Relation -> [(SENTENCE, SENTENCE)]
mkEDPairs s il med pairs = do
let ls = case fromMaybe (error "expected EDRelation") med of
EDRelation Equivalent -> map (uncurry mkBB) pairs
EDRelation Disjoint -> map (\ (x, y) -> mkBN $ mkBC [x, y]) pairs
_ -> error "expected EDRelation"
-- | Mapping of ListFrameBit
mapListFrameBit :: Sign -> Extended -> Maybe Relation -> ListFrameBit
mapListFrameBit cSig ex rel lfb = case lfb of
AnnotationBit _ -> return ([], cSig)
ExpressionBit cls -> case ex of
Misc _ -> let cel = map snd cls in do
(els, sig) <- mapDescriptionListP cSig 1 $ comPairs cel cel
mkEDPairs sig [1] rel els
SimpleEntity (Entity _ ty iri) -> do
ls <- mapM (\ (_, c) -> mapDescription cSig c (OIndi iri) 1) cls
NamedIndividual | rel == Just Types -> do
inD <- mapIndivIRI cSig iri
let ocls = map (mapClassAssertion inD)
$ zip (map snd cls) $ map fst ls
return (ocls, uniteL $ map snd ls)
DataProperty | rel == (Just $ DRRelation ADomain) -> do
oEx <- mapDPE cSig iri 1 2
return (msen2Txt $ map (mkSent [mk1NAME] [mkNAME 2] oEx
. fst) ls, uniteL $ map snd ls)
ObjectEntity oe -> case rel of
tobjP <- mapOPE cSig oe 1 2
tdsc <- mapM (\ (_, c) -> mapDescription cSig c (case r of
ARange -> OVar 2) $ case r of
return (msen2Txt $ map (mkSent [mkNAME $ fst vars]
[mkNAME $ snd vars] tobjP . fst) tdsc,
ClassEntity ce -> let cel = map snd cls in case rel of
(decrsS, dSig) <- mapDescriptionListP cSig 1 $ mkPairs ce cel
mkEDPairs dSig [1] rel decrsS
(domT, dSig) <- mapDescription cSig ce (OVar 1) 1
ls <- mapM (\ cd -> mapDescription cSig cd (OVar 1) 1) cel
rSig <- sigUnion cSig (unite dSig $ uniteL $ map snd ls)
return (msen2Txt $ map (mk1QU . mkBI domT . fst) ls, rSig)
ObjectBit anl -> let opl = map snd anl in case rel of
pairs <- mapObjPropListP cSig 1 2 $ comPairs opl opl
mkEDPairs cSig [1, 2] rel pairs
ObjectEntity op -> case r of
pairs <- mapObjPropListP cSig 1 2 $ mkPairs op opl
mkEDPairs cSig [1, 2] rel pairs
os <- mapM (\ (o1, o2) -> mapSubObjProp cSig o1 o2 3)
return (msen2Txt os, cSig)
os1 <- mapM (\ o1 -> mapOPE cSig o1 1 2) opl
return (msen2Txt $ map (\ cd -> mkQU (map mkNAME [1, 2])
DataBit anl -> let dl = map snd anl in case rel of
Nothing -> return ([], cSig)
pairs <- mapDataPropListP cSig 1 2 $ comPairs dl dl
mkEDPairs cSig [1, 2] rel pairs
SimpleEntity (Entity _ DataProperty iri) -> case r of
pairs <- mapDataPropListP cSig 1 2 $ mkPairs iri dl
mkEDPairs cSig [1, 2] rel pairs
os1 <- mapM (\ o1 -> mapDPE cSig o1 1 2) dl
o2 <- mapDPE cSig iri 1 2
return (msen2Txt $ map (mkQU (map mkNAME [1, 2])
IndividualSameOrDifferent anl -> case rel of
Just (SDRelation re) -> do
let SimpleEntity (Entity _ NamedIndividual iri) = ex
fs <- mapComIndivList cSig re (Just iri) $ map snd anl
return (msen2Txt fs, cSig)
DataPropRange dpr -> case ex of
SimpleEntity (Entity _ DataProperty iri) -> do
oEx <- mapDPE cSig iri 1 2
ls <- mapM (\ (_, r) -> mapDataRange cSig r $ OVar 2) dpr
return (msen2Txt $ map (mkSent [mkNAME 1] [mkNAME 2] oEx
. fst) ls, uniteL $ map snd ls )
IndividualFacts indf -> do
fl <- mapM (mapFact cSig ex . snd) indf
ObjectCharacteristics ace -> case ex of
cl <- mapM (mapCharact cSig ope . snd) ace
-- | Mapping of AnnFrameBit
mapAnnFrameBit :: Sign -> Extended -> AnnFrameBit -> Result ([TEXT], Sign)
mapAnnFrameBit cSig ex afb =
let err = fail $ "could not translate " ++ show afb in case afb of
AnnotationFrameBit _ -> return ([], cSig)
DataFunctional -> case ex of
SimpleEntity (Entity _ DataProperty iri) -> do
so1 <- mapDPE cSig iri 1 2
so2 <- mapDPE cSig iri 1 3
return ([mkQUBI (map mkNAME [1, 2, 3]) [so1, so2]
(mkNTERM 2) $ mkNTERM 3], cSig)
DatatypeBit dr -> case ex of
SimpleEntity (Entity _ Datatype iri) -> do
(odes, dSig) <- mapDataRange cSig dr $ OVar 1
let dtp = mkTermAtoms (uriToTok iri) [mkVTerm $ OVar 1]
return ([senToText $ mk1QU $ mkBB dtp odes], dSig)
ClassDisjointUnion clsl -> case ex of
ClassEntity (Expression iri) -> do
(decrs, dSig) <- mapDescriptionList cSig 1 clsl
(decrsS, pSig) <- mapDescriptionListP cSig 1 $ comPairs clsl clsl
let decrsP = unzip decrsS
mcls <- mapClassIRI cSig iri $ mkNName 1
return ([senToText $ mk1QU $ mkBB mcls $ mkBC
[mkBD decrs, mkBN $ mkBC $ uncurry (++) decrsP]],
ClassHasKey opl dpl -> do
uptoDP = [lo + 2 .. lo + ld + 1]
(_, sig) <- mapDescription cSig ce (OVar 1) 1
ol <- mapM (\ (n, o) -> mapOPE cSig o 1 n) $ zip uptoOP opl
nol <- mapM (\ (n, o) -> mapOPE cSig o tl n) $ zip uptoOP opl
dl <- mapM (\ (n, d) -> mapDPE cSig d 1 n) $ zip uptoDP dpl
ndl <- mapM (\ (n, d) -> mapDPE cSig d tl n) $ zip uptoDP dpl
keys <- mapKey cSig ce (ol ++ dl, nol ++ ndl) tl
return ([senToText keys], sig)
ObjectSubPropertyChain oplst -> case ex of
os <- mapSubObjPropChain cSig oplst op 3
return ([senToText os], cSig)
mapAxioms :: Sign -> Axiom -> Result ([TEXT], Sign)
mapAxioms cSig (PlainAxiom ex fb) = case fb of
ListFrameBit rel lfb -> mapListFrameBit cSig ex rel lfb
AnnFrameBit _ afb -> mapAnnFrameBit cSig ex afb
addMrs :: TEXT -> TEXT_META
addMrs t = emptyTextMeta { getText = t }