ManchesterPrint.hs revision 8601c6f4a4c5486e18cdf9810f832630985989f5
{- |
Module : $Header$
Copyright : (c) Felix Gabriel Mance
License : GPLv2 or higher, see LICENSE.txt
Maintainer : f.mance@jacobs-university.de
Stability : provisional
Portability : portable
Contains : Pretty printing for the Manchester Syntax of OWL 2
-}
module OWL2.ManchesterPrint where
import Common.Doc
import Common.DocUtils
import Common.Keywords
import OWL2.AS
import OWL2.MS
import OWL2.Print
import OWL.Keywords
import OWL.ColonKeywords
import qualified Data.Map as Map
printCharact :: String -> Doc
printCharact charact = text charact
instance Pretty Character where
pretty = printCharact . show
instance Pretty AnnotationValue where
pretty x = case x of
AnnValue iri -> pretty iri
AnnValLit lit -> pretty lit
instance Pretty Annotation where
pretty = printAnnotation
printAnnotation :: Annotation -> Doc
printAnnotation (Annotation ans ap av) =
sep [printAnnotations ans, sep [pretty ap, pretty av]]
printAnnotations :: Annotations -> Doc
printAnnotations l = case l of
[] -> empty
_ -> sep [keyword annotationsC, ppWithCommas l]
instance Pretty a => Pretty (AnnotatedList a) where
pretty = printAnnotatedList
printAnnotatedList :: Pretty a => AnnotatedList a -> Doc
printAnnotatedList (AnnotatedList l) =
vcat $ punctuate comma $ map
( \ (ans, a) -> printAnnotations ans $+$ pretty a) l
instance Pretty FrameBit where
pretty = printFrameBit
printFrameBit :: FrameBit -> Doc
printFrameBit fb = case fb of
AnnotationFrameBit x -> pretty x
AnnotationBit ed l -> printRelation ed <+> pretty l
AnnotationDR dr l -> printAnnDomainOrRange dr <+> pretty l
DatatypeBit ans a -> pretty ans $+$ keyword equivalentToC <+> pretty a
ExpressionBit x y -> printRelation x <+> pretty y
ClassDisjointUnion a x -> keyword disjointUnionOfC
<+> (pretty a $+$ vcat(punctuate comma ( map (\p -> pretty p) x )))
ClassHasKey a op dp -> keyword hasKeyC <+> (pretty a
$+$ vcat (punctuate comma $ map pretty op ++ map pretty dp))
ObjectBit dr x -> printRelation dr <+> pretty x
ObjectDomainOrRange dr x -> printObjDomainOrRange dr <+> pretty x
ObjectCharacteristics x -> keyword characteristicsC <+> pretty x
ObjectSubPropertyChain a opl -> keyword subPropertyChainC
<+> (pretty a $+$ fsep (prepPunctuate (keyword oS <> space) $ map pretty opl))
DataBit dr x -> printRelation dr <+> pretty x
DataPropRange x -> keyword rangeC <+> pretty x
DataPropDomain x -> keyword domainC <+> pretty x
DataFunctional x -> keyword characteristicsC <+> (pretty x $+$ printCharact functionalS)
IndividualFacts x -> keyword factsC <+> pretty x
IndividualSameOrDifferent s x -> printSameOrDifferent s <+> pretty x
instance Pretty Fact where
pretty = printFact
printFact :: Fact -> Doc
printFact pf = case pf of
ObjectPropertyFact pn op i -> printPositiveOrNegative pn <+> pretty op <+> pretty i
DataPropertyFact pn dp l -> printPositiveOrNegative pn <+> pretty dp <+> pretty l
printPositiveOrNegative :: PositiveOrNegative -> Doc
printPositiveOrNegative x = case x of
Positive -> empty
Negative -> keyword notS
instance Pretty Frame where
pretty = printFrame
printFrame :: Frame -> Doc
printFrame f = case f of
Frame (Entity e uri) bl -> pretty (showEntityType e) <+> fsep [pretty uri, vcat (map pretty bl)]
MiscFrame e a misc -> case misc of
MiscEquivOrDisjointClasses c -> printEquivOrDisjointClasses e <+> (pretty a $+$ vcat (punctuate comma (map pretty c) ))
MiscEquivOrDisjointObjProp c -> printEquivOrDisjointObj e <+> (pretty a $+$ vcat ( punctuate comma (map pretty c) ))
MiscEquivOrDisjointDataProp c -> printEquivOrDisjointData e <+> (pretty a $+$ vcat ( punctuate comma (map pretty c) ))
MiscSameOrDifferent s a c -> printSameOrDifferentInd s <+> (pretty a $+$ vcat( punctuate comma (map pretty c) ))
printEquivOrDisjointClasses :: Relation -> Doc
printEquivOrDisjointClasses x = case x of
Equivalent -> text "EquivalentClasses:"
Disjoint -> text "DisjointClasses:"
_ -> empty
printEquivOrDisjointObj :: Relation -> Doc
printEquivOrDisjointObj x = case x of
Equivalent -> text "EquivalentProperties:"
Disjoint -> text "DisjointProperties:"
_ -> empty
printEquivOrDisjointData :: Relation -> Doc
printEquivOrDisjointData x = case x of
Equivalent -> text "EquivalentProperties:"
Disjoint -> text "DisjointProperties:"
_ -> empty
printSameOrDifferentInd :: SameOrDifferent -> Doc
printSameOrDifferentInd x = case x of
Same -> keyword sameIndividualC
Different -> keyword differentIndividualsC
Individuals -> keyword individualsC
instance Pretty MOntology where
pretty = printOntology
printImport :: ImportIRI -> Doc
printImport x = keyword importC <+> pretty x
printPrefixes :: PrefixMap -> Doc
printPrefixes x = vcat (map (\(a, b) ->
(text "Prefix:" <+> text a <> colon <+> text ('<' : b ++ ">"))) (Map.toList x))
printOntology :: MOntology -> Doc
printOntology MOntology {muri = a, imports = b, ann = c, ontologyFrame = d} = keyword ontologyC
<+> pretty a $++$ vcat (map printImport b) $++$ vcat (map pretty c) $+$ vcat(map pretty d)
printOntologyDocument :: OntologyDocument -> Doc
printOntologyDocument OntologyDocument {prefixDeclaration = a, mOntology = b} = printPrefixes a $++$ pretty b
instance Pretty OntologyDocument where
pretty = printOntologyDocument