{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{- |
Module      :  ./OWL2/AS.hs
Copyright   :  (c) C. Maeder, Felix Gabriel Mance
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Alexander.Koslowski@st.ovgu.de
Stability   :  provisional
Portability :  portable

OWL 2 Functional Syntax constructs

References:
 <http://www.w3.org/TR/2009/REC-owl2-syntax-20091027/#Functional-Style_Syntax>
 <http://www.w3.org/TR/owl2-manchester-syntax/>
-}

module OWL2.AS where

import Common.Id
import Common.Keywords (stringS)
import Common.IRI

import qualified Common.GlobalAnnotations as GA (PrefixMap)

import Common.Result

import OWL2.ColonKeywords
import OWL2.Keywords

import Data.Char (intToDigit)
import Data.Data
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set

-- | checks if an IRI is an anonymous individual
isAnonymous :: IRI -> Bool
isAnonymous :: IRI -> Bool
isAnonymous i :: IRI
i = IRI -> String
prefixName IRI
i String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "_" Bool -> Bool -> Bool
&& IRI -> Bool
isBlankNode IRI
i

-- | prefix -> localname
type PrefixMap = Map.Map String String

changePrefixMapTypeToString :: GA.PrefixMap -> PrefixMap
changePrefixMapTypeToString :: PrefixMap -> PrefixMap
changePrefixMapTypeToString = (IRI -> String) -> PrefixMap -> PrefixMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IRI -> String
forall a. Show a => a -> String
show

changePrefixMapTypeToGA :: PrefixMap -> GA.PrefixMap
changePrefixMapTypeToGA :: PrefixMap -> PrefixMap
changePrefixMapTypeToGA = (String -> IRI) -> PrefixMap -> PrefixMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\s :: String
s -> case String -> Maybe IRI
parseIRICompoundCurie String
s of
    Just i :: IRI
i -> IRI
i
    Nothing -> case String -> Maybe IRI
parseIRI String
s of 
      Just i :: IRI
i -> IRI
i
      Nothing -> String -> IRI
forall a. HasCallStack => String -> a
error (String -> IRI) -> String -> IRI
forall a b. (a -> b) -> a -> b
$ "Invalid IRI while OWL2.AS.changePrefixMapTypeToGA: "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  )

predefPrefixesGA :: GA.PrefixMap
predefPrefixesGA :: PrefixMap
predefPrefixesGA = PrefixMap -> PrefixMap
changePrefixMapTypeToGA (PrefixMap -> PrefixMap) -> PrefixMap -> PrefixMap
forall a b. (a -> b) -> a -> b
$ (String -> String) -> PrefixMap -> PrefixMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\v :: String
v -> "<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">") PrefixMap
predefPrefixes

predefPrefixes :: PrefixMap
predefPrefixes :: PrefixMap
predefPrefixes = [(String, String)] -> PrefixMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ ("owl", "http://www.w3.org/2002/07/owl#")
      , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
      , ("rdfs", "http://www.w3.org/2000/01/rdf-schema#")
      , ("xsd", "http://www.w3.org/2001/XMLSchema#") ]

plainDatatypeIRI :: IRI
plainDatatypeIRI :: IRI
plainDatatypeIRI = IRI :: Range
-> String
-> Maybe IRIAuth
-> Id
-> String
-> String
-> String
-> String
-> Bool
-> Bool
-> Bool
-> IRI
IRI {
          iriScheme :: String
iriScheme = "http:"
        , iriAuthority :: Maybe IRIAuth
iriAuthority = IRIAuth -> Maybe IRIAuth
forall a. a -> Maybe a
Just (IRIAuth -> Maybe IRIAuth) -> IRIAuth -> Maybe IRIAuth
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> IRIAuth
IRIAuth "" "www.w3.org" ""
        , iriPath :: Id
iriPath = String -> Id
stringToId "/1999/02/22-rdf-syntax-ns"
        , iriQuery :: String
iriQuery = ""
        , iriFragment :: String
iriFragment = "#PlainLiteral"
        , prefixName :: String
prefixName = "rdf"
        , isAbbrev :: Bool
isAbbrev = Bool
True
        , isBlankNode :: Bool
isBlankNode = Bool
False
        , hasAngles :: Bool
hasAngles = Bool
False
        , iriPos :: Range
iriPos = Range
nullRange
        , iFragment :: String
iFragment = "PlainLiteral"
    }

topDataProperty :: IRI
topDataProperty :: IRI
topDataProperty = PrefixMap -> IRI -> IRI
expandIRI' PrefixMap
predefPrefixes (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$
  String -> IRI -> IRI
setPrefix "owl" (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ String -> IRI
mkIRI "topDataProperty"

topObjectProperty :: IRI
topObjectProperty :: IRI
topObjectProperty = PrefixMap -> IRI -> IRI
expandIRI' PrefixMap
predefPrefixes (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$
  String -> IRI -> IRI
setPrefix "owl" (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ String -> IRI
mkIRI "topObjectProperty"

owlThing :: IRI
owlThing :: IRI
owlThing = PrefixMap -> IRI -> IRI
expandIRI' PrefixMap
predefPrefixes (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$
  String -> IRI -> IRI
setPrefix "owl" (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ String -> IRI
mkIRI "Thing"

bottomObjectProperty :: IRI
bottomObjectProperty :: IRI
bottomObjectProperty = PrefixMap -> IRI -> IRI
expandIRI' PrefixMap
predefPrefixes (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$
  String -> IRI -> IRI
setPrefix "owl" (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ String -> IRI
mkIRI "bottomObjectProperty"


type LexicalForm = String
type LanguageTag = String
type ImportIRI = IRI
type OntologyIRI = IRI
type VersionIRI = IRI
type Class = IRI
type Datatype = IRI
type ObjectProperty = IRI
type DataProperty = IRI
type DirectlyImportsDocuments = [IRI]
type AnnotationProperty = IRI
type Individual = IRI
type AnonymousIndividual = IRI
type NamedIndividual = IRI

data EquivOrDisjoint = Equivalent | Disjoint
    deriving (Int -> EquivOrDisjoint -> String -> String
[EquivOrDisjoint] -> String -> String
EquivOrDisjoint -> String
(Int -> EquivOrDisjoint -> String -> String)
-> (EquivOrDisjoint -> String)
-> ([EquivOrDisjoint] -> String -> String)
-> Show EquivOrDisjoint
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EquivOrDisjoint] -> String -> String
$cshowList :: [EquivOrDisjoint] -> String -> String
show :: EquivOrDisjoint -> String
$cshow :: EquivOrDisjoint -> String
showsPrec :: Int -> EquivOrDisjoint -> String -> String
$cshowsPrec :: Int -> EquivOrDisjoint -> String -> String
Show, EquivOrDisjoint -> EquivOrDisjoint -> Bool
(EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> (EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> Eq EquivOrDisjoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c/= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
== :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c== :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
Eq, Eq EquivOrDisjoint
Eq EquivOrDisjoint =>
(EquivOrDisjoint -> EquivOrDisjoint -> Ordering)
-> (EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> (EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> (EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> (EquivOrDisjoint -> EquivOrDisjoint -> Bool)
-> (EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint)
-> (EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint)
-> Ord EquivOrDisjoint
EquivOrDisjoint -> EquivOrDisjoint -> Bool
EquivOrDisjoint -> EquivOrDisjoint -> Ordering
EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint
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 :: EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint
$cmin :: EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint
max :: EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint
$cmax :: EquivOrDisjoint -> EquivOrDisjoint -> EquivOrDisjoint
>= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c>= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
> :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c> :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
<= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c<= :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
< :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
$c< :: EquivOrDisjoint -> EquivOrDisjoint -> Bool
compare :: EquivOrDisjoint -> EquivOrDisjoint -> Ordering
$ccompare :: EquivOrDisjoint -> EquivOrDisjoint -> Ordering
$cp1Ord :: Eq EquivOrDisjoint
Ord, Typeable, Typeable EquivOrDisjoint
Constr
DataType
Typeable EquivOrDisjoint =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EquivOrDisjoint -> c EquivOrDisjoint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EquivOrDisjoint)
-> (EquivOrDisjoint -> Constr)
-> (EquivOrDisjoint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EquivOrDisjoint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EquivOrDisjoint))
-> ((forall b. Data b => b -> b)
    -> EquivOrDisjoint -> EquivOrDisjoint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> EquivOrDisjoint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EquivOrDisjoint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> EquivOrDisjoint -> m EquivOrDisjoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EquivOrDisjoint -> m EquivOrDisjoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EquivOrDisjoint -> m EquivOrDisjoint)
-> Data EquivOrDisjoint
EquivOrDisjoint -> Constr
EquivOrDisjoint -> DataType
(forall b. Data b => b -> b) -> EquivOrDisjoint -> EquivOrDisjoint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EquivOrDisjoint -> c EquivOrDisjoint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EquivOrDisjoint
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EquivOrDisjoint -> u
forall u. (forall d. Data d => d -> u) -> EquivOrDisjoint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EquivOrDisjoint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EquivOrDisjoint -> c EquivOrDisjoint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EquivOrDisjoint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EquivOrDisjoint)
$cDisjoint :: Constr
$cEquivalent :: Constr
$tEquivOrDisjoint :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
gmapMp :: (forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
gmapM :: (forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EquivOrDisjoint -> m EquivOrDisjoint
gmapQi :: Int -> (forall d. Data d => d -> u) -> EquivOrDisjoint -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EquivOrDisjoint -> u
gmapQ :: (forall d. Data d => d -> u) -> EquivOrDisjoint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EquivOrDisjoint -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EquivOrDisjoint -> r
gmapT :: (forall b. Data b => b -> b) -> EquivOrDisjoint -> EquivOrDisjoint
$cgmapT :: (forall b. Data b => b -> b) -> EquivOrDisjoint -> EquivOrDisjoint
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EquivOrDisjoint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EquivOrDisjoint)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EquivOrDisjoint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EquivOrDisjoint)
dataTypeOf :: EquivOrDisjoint -> DataType
$cdataTypeOf :: EquivOrDisjoint -> DataType
toConstr :: EquivOrDisjoint -> Constr
$ctoConstr :: EquivOrDisjoint -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EquivOrDisjoint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EquivOrDisjoint
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EquivOrDisjoint -> c EquivOrDisjoint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EquivOrDisjoint -> c EquivOrDisjoint
$cp1Data :: Typeable EquivOrDisjoint
Data)

showEquivOrDisjoint :: EquivOrDisjoint -> String
showEquivOrDisjoint :: EquivOrDisjoint -> String
showEquivOrDisjoint ed :: EquivOrDisjoint
ed = case EquivOrDisjoint
ed of
    Equivalent -> String
equivalentToC
    Disjoint -> String
disjointWithC

data DomainOrRange = ADomain | ARange
  deriving (Int -> DomainOrRange -> String -> String
[DomainOrRange] -> String -> String
DomainOrRange -> String
(Int -> DomainOrRange -> String -> String)
-> (DomainOrRange -> String)
-> ([DomainOrRange] -> String -> String)
-> Show DomainOrRange
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DomainOrRange] -> String -> String
$cshowList :: [DomainOrRange] -> String -> String
show :: DomainOrRange -> String
$cshow :: DomainOrRange -> String
showsPrec :: Int -> DomainOrRange -> String -> String
$cshowsPrec :: Int -> DomainOrRange -> String -> String
Show, DomainOrRange -> DomainOrRange -> Bool
(DomainOrRange -> DomainOrRange -> Bool)
-> (DomainOrRange -> DomainOrRange -> Bool) -> Eq DomainOrRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainOrRange -> DomainOrRange -> Bool
$c/= :: DomainOrRange -> DomainOrRange -> Bool
== :: DomainOrRange -> DomainOrRange -> Bool
$c== :: DomainOrRange -> DomainOrRange -> Bool
Eq, Eq DomainOrRange
Eq DomainOrRange =>
(DomainOrRange -> DomainOrRange -> Ordering)
-> (DomainOrRange -> DomainOrRange -> Bool)
-> (DomainOrRange -> DomainOrRange -> Bool)
-> (DomainOrRange -> DomainOrRange -> Bool)
-> (DomainOrRange -> DomainOrRange -> Bool)
-> (DomainOrRange -> DomainOrRange -> DomainOrRange)
-> (DomainOrRange -> DomainOrRange -> DomainOrRange)
-> Ord DomainOrRange
DomainOrRange -> DomainOrRange -> Bool
DomainOrRange -> DomainOrRange -> Ordering
DomainOrRange -> DomainOrRange -> DomainOrRange
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 :: DomainOrRange -> DomainOrRange -> DomainOrRange
$cmin :: DomainOrRange -> DomainOrRange -> DomainOrRange
max :: DomainOrRange -> DomainOrRange -> DomainOrRange
$cmax :: DomainOrRange -> DomainOrRange -> DomainOrRange
>= :: DomainOrRange -> DomainOrRange -> Bool
$c>= :: DomainOrRange -> DomainOrRange -> Bool
> :: DomainOrRange -> DomainOrRange -> Bool
$c> :: DomainOrRange -> DomainOrRange -> Bool
<= :: DomainOrRange -> DomainOrRange -> Bool
$c<= :: DomainOrRange -> DomainOrRange -> Bool
< :: DomainOrRange -> DomainOrRange -> Bool
$c< :: DomainOrRange -> DomainOrRange -> Bool
compare :: DomainOrRange -> DomainOrRange -> Ordering
$ccompare :: DomainOrRange -> DomainOrRange -> Ordering
$cp1Ord :: Eq DomainOrRange
Ord, Typeable, Typeable DomainOrRange
Constr
DataType
Typeable DomainOrRange =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DomainOrRange -> c DomainOrRange)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DomainOrRange)
-> (DomainOrRange -> Constr)
-> (DomainOrRange -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DomainOrRange))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DomainOrRange))
-> ((forall b. Data b => b -> b) -> DomainOrRange -> DomainOrRange)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r)
-> (forall u. (forall d. Data d => d -> u) -> DomainOrRange -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DomainOrRange -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange)
-> Data DomainOrRange
DomainOrRange -> Constr
DomainOrRange -> DataType
(forall b. Data b => b -> b) -> DomainOrRange -> DomainOrRange
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DomainOrRange -> c DomainOrRange
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DomainOrRange
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DomainOrRange -> u
forall u. (forall d. Data d => d -> u) -> DomainOrRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DomainOrRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DomainOrRange -> c DomainOrRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DomainOrRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DomainOrRange)
$cARange :: Constr
$cADomain :: Constr
$tDomainOrRange :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
gmapMp :: (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
gmapM :: (forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DomainOrRange -> m DomainOrRange
gmapQi :: Int -> (forall d. Data d => d -> u) -> DomainOrRange -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DomainOrRange -> u
gmapQ :: (forall d. Data d => d -> u) -> DomainOrRange -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DomainOrRange -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DomainOrRange -> r
gmapT :: (forall b. Data b => b -> b) -> DomainOrRange -> DomainOrRange
$cgmapT :: (forall b. Data b => b -> b) -> DomainOrRange -> DomainOrRange
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DomainOrRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DomainOrRange)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DomainOrRange)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DomainOrRange)
dataTypeOf :: DomainOrRange -> DataType
$cdataTypeOf :: DomainOrRange -> DataType
toConstr :: DomainOrRange -> Constr
$ctoConstr :: DomainOrRange -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DomainOrRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DomainOrRange
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DomainOrRange -> c DomainOrRange
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DomainOrRange -> c DomainOrRange
$cp1Data :: Typeable DomainOrRange
Data)

showDomainOrRange :: DomainOrRange -> String
showDomainOrRange :: DomainOrRange -> String
showDomainOrRange dr :: DomainOrRange
dr = case DomainOrRange
dr of
    ADomain -> String
domainC
    ARange -> String
rangeC

data SameOrDifferent = Same | Different
  deriving (Int -> SameOrDifferent -> String -> String
[SameOrDifferent] -> String -> String
SameOrDifferent -> String
(Int -> SameOrDifferent -> String -> String)
-> (SameOrDifferent -> String)
-> ([SameOrDifferent] -> String -> String)
-> Show SameOrDifferent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SameOrDifferent] -> String -> String
$cshowList :: [SameOrDifferent] -> String -> String
show :: SameOrDifferent -> String
$cshow :: SameOrDifferent -> String
showsPrec :: Int -> SameOrDifferent -> String -> String
$cshowsPrec :: Int -> SameOrDifferent -> String -> String
Show, SameOrDifferent -> SameOrDifferent -> Bool
(SameOrDifferent -> SameOrDifferent -> Bool)
-> (SameOrDifferent -> SameOrDifferent -> Bool)
-> Eq SameOrDifferent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SameOrDifferent -> SameOrDifferent -> Bool
$c/= :: SameOrDifferent -> SameOrDifferent -> Bool
== :: SameOrDifferent -> SameOrDifferent -> Bool
$c== :: SameOrDifferent -> SameOrDifferent -> Bool
Eq, Eq SameOrDifferent
Eq SameOrDifferent =>
(SameOrDifferent -> SameOrDifferent -> Ordering)
-> (SameOrDifferent -> SameOrDifferent -> Bool)
-> (SameOrDifferent -> SameOrDifferent -> Bool)
-> (SameOrDifferent -> SameOrDifferent -> Bool)
-> (SameOrDifferent -> SameOrDifferent -> Bool)
-> (SameOrDifferent -> SameOrDifferent -> SameOrDifferent)
-> (SameOrDifferent -> SameOrDifferent -> SameOrDifferent)
-> Ord SameOrDifferent
SameOrDifferent -> SameOrDifferent -> Bool
SameOrDifferent -> SameOrDifferent -> Ordering
SameOrDifferent -> SameOrDifferent -> SameOrDifferent
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 :: SameOrDifferent -> SameOrDifferent -> SameOrDifferent
$cmin :: SameOrDifferent -> SameOrDifferent -> SameOrDifferent
max :: SameOrDifferent -> SameOrDifferent -> SameOrDifferent
$cmax :: SameOrDifferent -> SameOrDifferent -> SameOrDifferent
>= :: SameOrDifferent -> SameOrDifferent -> Bool
$c>= :: SameOrDifferent -> SameOrDifferent -> Bool
> :: SameOrDifferent -> SameOrDifferent -> Bool
$c> :: SameOrDifferent -> SameOrDifferent -> Bool
<= :: SameOrDifferent -> SameOrDifferent -> Bool
$c<= :: SameOrDifferent -> SameOrDifferent -> Bool
< :: SameOrDifferent -> SameOrDifferent -> Bool
$c< :: SameOrDifferent -> SameOrDifferent -> Bool
compare :: SameOrDifferent -> SameOrDifferent -> Ordering
$ccompare :: SameOrDifferent -> SameOrDifferent -> Ordering
$cp1Ord :: Eq SameOrDifferent
Ord, Typeable, Typeable SameOrDifferent
Constr
DataType
Typeable SameOrDifferent =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SameOrDifferent -> c SameOrDifferent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SameOrDifferent)
-> (SameOrDifferent -> Constr)
-> (SameOrDifferent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SameOrDifferent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SameOrDifferent))
-> ((forall b. Data b => b -> b)
    -> SameOrDifferent -> SameOrDifferent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SameOrDifferent -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SameOrDifferent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SameOrDifferent -> m SameOrDifferent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SameOrDifferent -> m SameOrDifferent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SameOrDifferent -> m SameOrDifferent)
-> Data SameOrDifferent
SameOrDifferent -> Constr
SameOrDifferent -> DataType
(forall b. Data b => b -> b) -> SameOrDifferent -> SameOrDifferent
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SameOrDifferent -> c SameOrDifferent
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SameOrDifferent
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SameOrDifferent -> u
forall u. (forall d. Data d => d -> u) -> SameOrDifferent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SameOrDifferent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SameOrDifferent -> c SameOrDifferent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SameOrDifferent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SameOrDifferent)
$cDifferent :: Constr
$cSame :: Constr
$tSameOrDifferent :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
gmapMp :: (forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
gmapM :: (forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SameOrDifferent -> m SameOrDifferent
gmapQi :: Int -> (forall d. Data d => d -> u) -> SameOrDifferent -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SameOrDifferent -> u
gmapQ :: (forall d. Data d => d -> u) -> SameOrDifferent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SameOrDifferent -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SameOrDifferent -> r
gmapT :: (forall b. Data b => b -> b) -> SameOrDifferent -> SameOrDifferent
$cgmapT :: (forall b. Data b => b -> b) -> SameOrDifferent -> SameOrDifferent
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SameOrDifferent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SameOrDifferent)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SameOrDifferent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SameOrDifferent)
dataTypeOf :: SameOrDifferent -> DataType
$cdataTypeOf :: SameOrDifferent -> DataType
toConstr :: SameOrDifferent -> Constr
$ctoConstr :: SameOrDifferent -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SameOrDifferent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SameOrDifferent
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SameOrDifferent -> c SameOrDifferent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SameOrDifferent -> c SameOrDifferent
$cp1Data :: Typeable SameOrDifferent
Data)

showSameOrDifferent :: SameOrDifferent -> String
showSameOrDifferent :: SameOrDifferent -> String
showSameOrDifferent sd :: SameOrDifferent
sd = case SameOrDifferent
sd of
    Same -> String
sameAsC
    Different -> String
differentFromC

data Relation =
    EDRelation EquivOrDisjoint
  | SubPropertyOf
  | InverseOf
  | SubClass
  | Types
  | DRRelation DomainOrRange
  | SDRelation SameOrDifferent
    deriving (Int -> Relation -> String -> String
[Relation] -> String -> String
Relation -> String
(Int -> Relation -> String -> String)
-> (Relation -> String)
-> ([Relation] -> String -> String)
-> Show Relation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Relation] -> String -> String
$cshowList :: [Relation] -> String -> String
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> String -> String
$cshowsPrec :: Int -> Relation -> String -> String
Show, Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation =>
(Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
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 :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
$cp1Ord :: Eq Relation
Ord, Typeable, Typeable Relation
Constr
DataType
Typeable Relation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Relation -> c Relation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Relation)
-> (Relation -> Constr)
-> (Relation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Relation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation))
-> ((forall b. Data b => b -> b) -> Relation -> Relation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Relation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Relation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Relation -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> Data Relation
Relation -> Constr
Relation -> DataType
(forall b. Data b => b -> b) -> Relation -> Relation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u
forall u. (forall d. Data d => d -> u) -> Relation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Relation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
$cSDRelation :: Constr
$cDRRelation :: Constr
$cTypes :: Constr
$cSubClass :: Constr
$cInverseOf :: Constr
$cSubPropertyOf :: Constr
$cEDRelation :: Constr
$tRelation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapMp :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapM :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Relation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u
gmapQ :: (forall d. Data d => d -> u) -> Relation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Relation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
gmapT :: (forall b. Data b => b -> b) -> Relation -> Relation
$cgmapT :: (forall b. Data b => b -> b) -> Relation -> Relation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Relation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Relation)
dataTypeOf :: Relation -> DataType
$cdataTypeOf :: Relation -> DataType
toConstr :: Relation -> Constr
$ctoConstr :: Relation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
$cp1Data :: Typeable Relation
Data)

showRelation :: Relation -> String
showRelation :: Relation -> String
showRelation r :: Relation
r = case Relation
r of
    EDRelation ed :: EquivOrDisjoint
ed -> EquivOrDisjoint -> String
showEquivOrDisjoint EquivOrDisjoint
ed
    SubPropertyOf -> String
subPropertyOfC
    InverseOf -> String
inverseOfC
    SubClass -> String
subClassOfC
    Types -> String
typesC
    DRRelation dr :: DomainOrRange
dr -> DomainOrRange -> String
showDomainOrRange DomainOrRange
dr
    SDRelation sd :: SameOrDifferent
sd -> SameOrDifferent -> String
showSameOrDifferent SameOrDifferent
sd

getED :: Relation -> EquivOrDisjoint
getED :: Relation -> EquivOrDisjoint
getED r :: Relation
r = case Relation
r of
    EDRelation ed :: EquivOrDisjoint
ed -> EquivOrDisjoint
ed
    _ -> String -> EquivOrDisjoint
forall a. HasCallStack => String -> a
error "not domain or range"

getDR :: Relation -> DomainOrRange
getDR :: Relation -> DomainOrRange
getDR r :: Relation
r = case Relation
r of
    DRRelation dr :: DomainOrRange
dr -> DomainOrRange
dr
    _ -> String -> DomainOrRange
forall a. HasCallStack => String -> a
error "not domain or range"

getSD :: Relation -> SameOrDifferent
getSD :: Relation -> SameOrDifferent
getSD s :: Relation
s = case Relation
s of
    SDRelation sd :: SameOrDifferent
sd -> SameOrDifferent
sd
    _ -> String -> SameOrDifferent
forall a. HasCallStack => String -> a
error "not same or different"

data Character =
    Functional
  | InverseFunctional
  | Reflexive
  | Irreflexive
  | Symmetric
  | Asymmetric
  | Antisymmetric
  | Transitive
    deriving (Int -> Character
Character -> Int
Character -> [Character]
Character -> Character
Character -> Character -> [Character]
Character -> Character -> Character -> [Character]
(Character -> Character)
-> (Character -> Character)
-> (Int -> Character)
-> (Character -> Int)
-> (Character -> [Character])
-> (Character -> Character -> [Character])
-> (Character -> Character -> [Character])
-> (Character -> Character -> Character -> [Character])
-> Enum Character
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Character -> Character -> Character -> [Character]
$cenumFromThenTo :: Character -> Character -> Character -> [Character]
enumFromTo :: Character -> Character -> [Character]
$cenumFromTo :: Character -> Character -> [Character]
enumFromThen :: Character -> Character -> [Character]
$cenumFromThen :: Character -> Character -> [Character]
enumFrom :: Character -> [Character]
$cenumFrom :: Character -> [Character]
fromEnum :: Character -> Int
$cfromEnum :: Character -> Int
toEnum :: Int -> Character
$ctoEnum :: Int -> Character
pred :: Character -> Character
$cpred :: Character -> Character
succ :: Character -> Character
$csucc :: Character -> Character
Enum, Character
Character -> Character -> Bounded Character
forall a. a -> a -> Bounded a
maxBound :: Character
$cmaxBound :: Character
minBound :: Character
$cminBound :: Character
Bounded, Int -> Character -> String -> String
[Character] -> String -> String
Character -> String
(Int -> Character -> String -> String)
-> (Character -> String)
-> ([Character] -> String -> String)
-> Show Character
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Character] -> String -> String
$cshowList :: [Character] -> String -> String
show :: Character -> String
$cshow :: Character -> String
showsPrec :: Int -> Character -> String -> String
$cshowsPrec :: Int -> Character -> String -> String
Show, Character -> Character -> Bool
(Character -> Character -> Bool)
-> (Character -> Character -> Bool) -> Eq Character
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Character -> Character -> Bool
$c/= :: Character -> Character -> Bool
== :: Character -> Character -> Bool
$c== :: Character -> Character -> Bool
Eq, Eq Character
Eq Character =>
(Character -> Character -> Ordering)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Character)
-> (Character -> Character -> Character)
-> Ord Character
Character -> Character -> Bool
Character -> Character -> Ordering
Character -> Character -> Character
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 :: Character -> Character -> Character
$cmin :: Character -> Character -> Character
max :: Character -> Character -> Character
$cmax :: Character -> Character -> Character
>= :: Character -> Character -> Bool
$c>= :: Character -> Character -> Bool
> :: Character -> Character -> Bool
$c> :: Character -> Character -> Bool
<= :: Character -> Character -> Bool
$c<= :: Character -> Character -> Bool
< :: Character -> Character -> Bool
$c< :: Character -> Character -> Bool
compare :: Character -> Character -> Ordering
$ccompare :: Character -> Character -> Ordering
$cp1Ord :: Eq Character
Ord, Typeable, Typeable Character
Constr
DataType
Typeable Character =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Character -> c Character)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Character)
-> (Character -> Constr)
-> (Character -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Character))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Character))
-> ((forall b. Data b => b -> b) -> Character -> Character)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Character -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Character -> r)
-> (forall u. (forall d. Data d => d -> u) -> Character -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Character -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Character -> m Character)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Character -> m Character)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Character -> m Character)
-> Data Character
Character -> Constr
Character -> DataType
(forall b. Data b => b -> b) -> Character -> Character
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Character -> c Character
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Character
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Character -> u
forall u. (forall d. Data d => d -> u) -> Character -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Character -> m Character
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Character -> m Character
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Character
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Character -> c Character
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Character)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Character)
$cTransitive :: Constr
$cAntisymmetric :: Constr
$cAsymmetric :: Constr
$cSymmetric :: Constr
$cIrreflexive :: Constr
$cReflexive :: Constr
$cInverseFunctional :: Constr
$cFunctional :: Constr
$tCharacter :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Character -> m Character
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Character -> m Character
gmapMp :: (forall d. Data d => d -> m d) -> Character -> m Character
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Character -> m Character
gmapM :: (forall d. Data d => d -> m d) -> Character -> m Character
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Character -> m Character
gmapQi :: Int -> (forall d. Data d => d -> u) -> Character -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Character -> u
gmapQ :: (forall d. Data d => d -> u) -> Character -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Character -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Character -> r
gmapT :: (forall b. Data b => b -> b) -> Character -> Character
$cgmapT :: (forall b. Data b => b -> b) -> Character -> Character
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Character)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Character)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Character)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Character)
dataTypeOf :: Character -> DataType
$cdataTypeOf :: Character -> DataType
toConstr :: Character -> Constr
$ctoConstr :: Character -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Character
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Character
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Character -> c Character
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Character -> c Character
$cp1Data :: Typeable Character
Data)

data PositiveOrNegative = Positive | Negative
    deriving (Int -> PositiveOrNegative -> String -> String
[PositiveOrNegative] -> String -> String
PositiveOrNegative -> String
(Int -> PositiveOrNegative -> String -> String)
-> (PositiveOrNegative -> String)
-> ([PositiveOrNegative] -> String -> String)
-> Show PositiveOrNegative
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PositiveOrNegative] -> String -> String
$cshowList :: [PositiveOrNegative] -> String -> String
show :: PositiveOrNegative -> String
$cshow :: PositiveOrNegative -> String
showsPrec :: Int -> PositiveOrNegative -> String -> String
$cshowsPrec :: Int -> PositiveOrNegative -> String -> String
Show, PositiveOrNegative -> PositiveOrNegative -> Bool
(PositiveOrNegative -> PositiveOrNegative -> Bool)
-> (PositiveOrNegative -> PositiveOrNegative -> Bool)
-> Eq PositiveOrNegative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c/= :: PositiveOrNegative -> PositiveOrNegative -> Bool
== :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c== :: PositiveOrNegative -> PositiveOrNegative -> Bool
Eq, Eq PositiveOrNegative
Eq PositiveOrNegative =>
(PositiveOrNegative -> PositiveOrNegative -> Ordering)
-> (PositiveOrNegative -> PositiveOrNegative -> Bool)
-> (PositiveOrNegative -> PositiveOrNegative -> Bool)
-> (PositiveOrNegative -> PositiveOrNegative -> Bool)
-> (PositiveOrNegative -> PositiveOrNegative -> Bool)
-> (PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative)
-> (PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative)
-> Ord PositiveOrNegative
PositiveOrNegative -> PositiveOrNegative -> Bool
PositiveOrNegative -> PositiveOrNegative -> Ordering
PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative
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 :: PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative
$cmin :: PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative
max :: PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative
$cmax :: PositiveOrNegative -> PositiveOrNegative -> PositiveOrNegative
>= :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c>= :: PositiveOrNegative -> PositiveOrNegative -> Bool
> :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c> :: PositiveOrNegative -> PositiveOrNegative -> Bool
<= :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c<= :: PositiveOrNegative -> PositiveOrNegative -> Bool
< :: PositiveOrNegative -> PositiveOrNegative -> Bool
$c< :: PositiveOrNegative -> PositiveOrNegative -> Bool
compare :: PositiveOrNegative -> PositiveOrNegative -> Ordering
$ccompare :: PositiveOrNegative -> PositiveOrNegative -> Ordering
$cp1Ord :: Eq PositiveOrNegative
Ord, Typeable, Typeable PositiveOrNegative
Constr
DataType
Typeable PositiveOrNegative =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> PositiveOrNegative
 -> c PositiveOrNegative)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PositiveOrNegative)
-> (PositiveOrNegative -> Constr)
-> (PositiveOrNegative -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PositiveOrNegative))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PositiveOrNegative))
-> ((forall b. Data b => b -> b)
    -> PositiveOrNegative -> PositiveOrNegative)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PositiveOrNegative -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PositiveOrNegative -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PositiveOrNegative -> m PositiveOrNegative)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PositiveOrNegative -> m PositiveOrNegative)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PositiveOrNegative -> m PositiveOrNegative)
-> Data PositiveOrNegative
PositiveOrNegative -> Constr
PositiveOrNegative -> DataType
(forall b. Data b => b -> b)
-> PositiveOrNegative -> PositiveOrNegative
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PositiveOrNegative
-> c PositiveOrNegative
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositiveOrNegative
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PositiveOrNegative -> u
forall u. (forall d. Data d => d -> u) -> PositiveOrNegative -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositiveOrNegative
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PositiveOrNegative
-> c PositiveOrNegative
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PositiveOrNegative)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositiveOrNegative)
$cNegative :: Constr
$cPositive :: Constr
$tPositiveOrNegative :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
gmapMp :: (forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
gmapM :: (forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PositiveOrNegative -> m PositiveOrNegative
gmapQi :: Int -> (forall d. Data d => d -> u) -> PositiveOrNegative -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PositiveOrNegative -> u
gmapQ :: (forall d. Data d => d -> u) -> PositiveOrNegative -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PositiveOrNegative -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositiveOrNegative -> r
gmapT :: (forall b. Data b => b -> b)
-> PositiveOrNegative -> PositiveOrNegative
$cgmapT :: (forall b. Data b => b -> b)
-> PositiveOrNegative -> PositiveOrNegative
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositiveOrNegative)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositiveOrNegative)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PositiveOrNegative)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PositiveOrNegative)
dataTypeOf :: PositiveOrNegative -> DataType
$cdataTypeOf :: PositiveOrNegative -> DataType
toConstr :: PositiveOrNegative -> Constr
$ctoConstr :: PositiveOrNegative -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositiveOrNegative
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositiveOrNegative
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PositiveOrNegative
-> c PositiveOrNegative
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PositiveOrNegative
-> c PositiveOrNegative
$cp1Data :: Typeable PositiveOrNegative
Data)

data QuantifierType = AllValuesFrom | SomeValuesFrom
    deriving (Int -> QuantifierType -> String -> String
[QuantifierType] -> String -> String
QuantifierType -> String
(Int -> QuantifierType -> String -> String)
-> (QuantifierType -> String)
-> ([QuantifierType] -> String -> String)
-> Show QuantifierType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QuantifierType] -> String -> String
$cshowList :: [QuantifierType] -> String -> String
show :: QuantifierType -> String
$cshow :: QuantifierType -> String
showsPrec :: Int -> QuantifierType -> String -> String
$cshowsPrec :: Int -> QuantifierType -> String -> String
Show, QuantifierType -> QuantifierType -> Bool
(QuantifierType -> QuantifierType -> Bool)
-> (QuantifierType -> QuantifierType -> Bool) -> Eq QuantifierType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuantifierType -> QuantifierType -> Bool
$c/= :: QuantifierType -> QuantifierType -> Bool
== :: QuantifierType -> QuantifierType -> Bool
$c== :: QuantifierType -> QuantifierType -> Bool
Eq, Eq QuantifierType
Eq QuantifierType =>
(QuantifierType -> QuantifierType -> Ordering)
-> (QuantifierType -> QuantifierType -> Bool)
-> (QuantifierType -> QuantifierType -> Bool)
-> (QuantifierType -> QuantifierType -> Bool)
-> (QuantifierType -> QuantifierType -> Bool)
-> (QuantifierType -> QuantifierType -> QuantifierType)
-> (QuantifierType -> QuantifierType -> QuantifierType)
-> Ord QuantifierType
QuantifierType -> QuantifierType -> Bool
QuantifierType -> QuantifierType -> Ordering
QuantifierType -> QuantifierType -> QuantifierType
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 :: QuantifierType -> QuantifierType -> QuantifierType
$cmin :: QuantifierType -> QuantifierType -> QuantifierType
max :: QuantifierType -> QuantifierType -> QuantifierType
$cmax :: QuantifierType -> QuantifierType -> QuantifierType
>= :: QuantifierType -> QuantifierType -> Bool
$c>= :: QuantifierType -> QuantifierType -> Bool
> :: QuantifierType -> QuantifierType -> Bool
$c> :: QuantifierType -> QuantifierType -> Bool
<= :: QuantifierType -> QuantifierType -> Bool
$c<= :: QuantifierType -> QuantifierType -> Bool
< :: QuantifierType -> QuantifierType -> Bool
$c< :: QuantifierType -> QuantifierType -> Bool
compare :: QuantifierType -> QuantifierType -> Ordering
$ccompare :: QuantifierType -> QuantifierType -> Ordering
$cp1Ord :: Eq QuantifierType
Ord, Typeable, Typeable QuantifierType
Constr
DataType
Typeable QuantifierType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> QuantifierType -> c QuantifierType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c QuantifierType)
-> (QuantifierType -> Constr)
-> (QuantifierType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c QuantifierType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c QuantifierType))
-> ((forall b. Data b => b -> b)
    -> QuantifierType -> QuantifierType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QuantifierType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QuantifierType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> QuantifierType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> QuantifierType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> QuantifierType -> m QuantifierType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> QuantifierType -> m QuantifierType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> QuantifierType -> m QuantifierType)
-> Data QuantifierType
QuantifierType -> Constr
QuantifierType -> DataType
(forall b. Data b => b -> b) -> QuantifierType -> QuantifierType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuantifierType -> c QuantifierType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuantifierType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> QuantifierType -> u
forall u. (forall d. Data d => d -> u) -> QuantifierType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuantifierType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuantifierType -> c QuantifierType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuantifierType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QuantifierType)
$cSomeValuesFrom :: Constr
$cAllValuesFrom :: Constr
$tQuantifierType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
gmapMp :: (forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
gmapM :: (forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> QuantifierType -> m QuantifierType
gmapQi :: Int -> (forall d. Data d => d -> u) -> QuantifierType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> QuantifierType -> u
gmapQ :: (forall d. Data d => d -> u) -> QuantifierType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QuantifierType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuantifierType -> r
gmapT :: (forall b. Data b => b -> b) -> QuantifierType -> QuantifierType
$cgmapT :: (forall b. Data b => b -> b) -> QuantifierType -> QuantifierType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QuantifierType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QuantifierType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c QuantifierType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuantifierType)
dataTypeOf :: QuantifierType -> DataType
$cdataTypeOf :: QuantifierType -> DataType
toConstr :: QuantifierType -> Constr
$ctoConstr :: QuantifierType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuantifierType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuantifierType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuantifierType -> c QuantifierType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuantifierType -> c QuantifierType
$cp1Data :: Typeable QuantifierType
Data)

showQuantifierType :: QuantifierType -> String
showQuantifierType :: QuantifierType -> String
showQuantifierType ty :: QuantifierType
ty = case QuantifierType
ty of
    AllValuesFrom -> String
onlyS
    SomeValuesFrom -> String
someS

-- * Predefined IRI checkings

thingMap :: PreDefMaps
thingMap :: PreDefMaps
thingMap = [String] -> PreDefMaps
makeOWLPredefMaps [String]
predefClass

isThing :: IRI -> Bool
isThing :: IRI -> Bool
isThing = PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
thingMap

makePredefObjProp :: PreDefMaps
makePredefObjProp :: PreDefMaps
makePredefObjProp = [String] -> PreDefMaps
makeOWLPredefMaps [String]
predefObjProp

isPredefObjProp :: IRI -> Bool
isPredefObjProp :: IRI -> Bool
isPredefObjProp = PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
makePredefObjProp

makePredefDataProp :: PreDefMaps
makePredefDataProp :: PreDefMaps
makePredefDataProp = [String] -> PreDefMaps
makeOWLPredefMaps [String]
predefDataProp

isPredefDataProp :: IRI -> Bool
isPredefDataProp :: IRI -> Bool
isPredefDataProp = PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
makePredefDataProp

makePredefRDFSAnnoProp :: PreDefMaps
makePredefRDFSAnnoProp :: PreDefMaps
makePredefRDFSAnnoProp = [String] -> String -> PreDefMaps
preDefMaps [String]
predefRDFSAnnoProps "rdfs"

isPredefRDFSAnnoProp :: IRI -> Bool
isPredefRDFSAnnoProp :: IRI -> Bool
isPredefRDFSAnnoProp = PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
makePredefRDFSAnnoProp

makePredefOWLAnnoProp :: PreDefMaps
makePredefOWLAnnoProp :: PreDefMaps
makePredefOWLAnnoProp = [String] -> PreDefMaps
makeOWLPredefMaps [String]
predefOWLAnnoProps

isPredefOWLAnnoProp :: IRI -> Bool
isPredefOWLAnnoProp :: IRI -> Bool
isPredefOWLAnnoProp = PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
makePredefOWLAnnoProp

isPredefAnnoProp :: IRI -> Bool
isPredefAnnoProp :: IRI -> Bool
isPredefAnnoProp i :: IRI
i = IRI -> Bool
isPredefOWLAnnoProp IRI
i Bool -> Bool -> Bool
|| IRI -> Bool
isPredefRDFSAnnoProp IRI
i

isPredefPropOrClass :: IRI -> Bool
isPredefPropOrClass :: IRI -> Bool
isPredefPropOrClass i :: IRI
i = IRI -> Bool
isPredefAnnoProp IRI
i Bool -> Bool -> Bool
|| IRI -> Bool
isPredefDataProp IRI
i
    Bool -> Bool -> Bool
|| IRI -> Bool
isPredefObjProp IRI
i Bool -> Bool -> Bool
|| IRI -> Bool
isThing IRI
i

predefIRIs :: Set.Set IRI
predefIRIs :: Set IRI
predefIRIs = [IRI] -> Set IRI
forall a. Ord a => [a] -> Set a
Set.fromList ([IRI] -> Set IRI) -> [IRI] -> Set IRI
forall a b. (a -> b) -> a -> b
$ (String -> IRI) -> [String] -> [IRI]
forall a b. (a -> b) -> [a] -> [b]
map (String -> IRI -> IRI
setPrefix "xsd" (IRI -> IRI) -> (String -> IRI) -> String -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IRI
mkIRI) [String]
xsdKeys
    [IRI] -> [IRI] -> [IRI]
forall a. [a] -> [a] -> [a]
++ (String -> IRI) -> [String] -> [IRI]
forall a b. (a -> b) -> [a] -> [b]
map (String -> IRI -> IRI
setPrefix "owl" (IRI -> IRI) -> (String -> IRI) -> String -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IRI
mkIRI) [String]
owlNumbers
    [IRI] -> [IRI] -> [IRI]
forall a. [a] -> [a] -> [a]
++ (String -> IRI) -> [String] -> [IRI]
forall a b. (a -> b) -> [a] -> [b]
map (String -> IRI -> IRI
setPrefix "rdf" (IRI -> IRI) -> (String -> IRI) -> String -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IRI
mkIRI) [String
rdfsLiteral, String
stringS]
    [IRI] -> [IRI] -> [IRI]
forall a. [a] -> [a] -> [a]
++ [String -> IRI -> IRI
setPrefix "rdfs" (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ String -> IRI
mkIRI String
xmlLiteral]

isDatatypeKey :: IRI -> Bool
isDatatypeKey :: IRI -> Bool
isDatatypeKey = Bool -> Bool
not (Bool -> Bool) -> (IRI -> Bool) -> IRI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, String)] -> Bool)
-> (IRI -> [(String, String)]) -> IRI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> [(String, String)]
isDatatypeKeyAux

isSWRLBuiltIn :: IRI -> Bool
isSWRLBuiltIn :: IRI -> Bool
isSWRLBuiltIn iri :: IRI
iri = IRI -> Bool
isAbbrev IRI
iri Bool -> Bool -> Bool
&& IRI -> String
prefixName IRI
iri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "swrlb" Bool -> Bool -> Bool
||
  "http://www.w3.org/2003/11/swrlb#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` IRI -> String
forall a. Show a => a -> String
show IRI
iri {hasAngles :: Bool
hasAngles = Bool
False}

xsdMap :: PreDefMaps
xsdMap :: PreDefMaps
xsdMap = [String] -> PreDefMaps
makeXsdMap [String]
xsdKeys

owlNumbersMap :: PreDefMaps
owlNumbersMap :: PreDefMaps
owlNumbersMap = [String] -> PreDefMaps
makeOWLPredefMaps [String]
owlNumbers

rdfMap :: PreDefMaps
rdfMap :: PreDefMaps
rdfMap = [String] -> String -> PreDefMaps
preDefMaps [String
xmlLiteral, String
stringS, String
rdfPlainLiteralS] "rdf"

rdfsMap :: PreDefMaps
rdfsMap :: PreDefMaps
rdfsMap = [String] -> String -> PreDefMaps
preDefMaps [String
rdfsLiteral] "rdfs"

isDatatypeKeyAux :: IRI -> [(String, String)]
isDatatypeKeyAux :: IRI -> [(String, String)]
isDatatypeKeyAux i :: IRI
i = (PreDefMaps -> Maybe (String, String))
-> [PreDefMaps] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PreDefMaps -> IRI -> Maybe (String, String)
`checkPredefAux` IRI
i)
  [ PreDefMaps
xsdMap, PreDefMaps
owlNumbersMap, PreDefMaps
rdfMap, PreDefMaps
rdfsMap ]

-- (types, prefixname, prefix iri)
type PreDefMaps = ([String], String, String)

preDefMaps :: [String] -> String -> PreDefMaps
preDefMaps :: [String] -> String -> PreDefMaps
preDefMaps sl :: [String]
sl pref :: String
pref = let
  Just puri :: String
puri = String -> PrefixMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
pref PrefixMap
predefPrefixes
 in ([String]
sl, String
pref, String
puri)

-- returns Maybe (prefix, keyword)
-- e.g. Just ("xsd", "string")
checkPredefAux :: PreDefMaps -> IRI -> Maybe (String, String)
checkPredefAux :: PreDefMaps -> IRI -> Maybe (String, String)
checkPredefAux (sl :: [String]
sl, pref :: String
pref, exPref :: String
exPref) u :: IRI
u =
  let t :: Maybe String
t = String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
exPref (IRI -> String
forall a. Show a => a -> String
show (IRI -> String) -> IRI -> String
forall a b. (a -> b) -> a -> b
$ IRI
u) in
    if IRI -> Bool
isAbbrev IRI
u then
      if IRI -> String
prefixName IRI
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pref Bool -> Bool -> Bool
&& IRI -> String
iFragment IRI
u String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
sl then
        (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
pref, IRI -> String
iFragment IRI
u)
      else Maybe (String, String)
forall a. Maybe a
Nothing
    else case Maybe String
t of
      Just lp :: String
lp | String
lp String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
sl -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
pref, String
lp)
      _ -> Maybe (String, String)
forall a. Maybe a
Nothing


checkPredef :: PreDefMaps -> IRI -> Bool
checkPredef :: PreDefMaps -> IRI -> Bool
checkPredef ms :: PreDefMaps
ms = Maybe (String, String) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (String, String) -> Bool)
-> (IRI -> Maybe (String, String)) -> IRI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreDefMaps -> IRI -> Maybe (String, String)
checkPredefAux PreDefMaps
ms

makeOWLPredefMaps :: [String] -> PreDefMaps
makeOWLPredefMaps :: [String] -> PreDefMaps
makeOWLPredefMaps sl :: [String]
sl = [String] -> String -> PreDefMaps
preDefMaps [String]
sl "owl"

-- | sets the correct prefix for the predefined datatypes
setDatatypePrefix :: IRI -> IRI
setDatatypePrefix :: IRI -> IRI
setDatatypePrefix i :: IRI
i = case IRI -> [(String, String)]
isDatatypeKeyAux IRI
i of
  (p :: String
p, l :: String
l) : _ -> IRI
i {prefixName :: String
prefixName = String
p, iFragment :: String
iFragment = String
l}
  _ -> String -> IRI
forall a. HasCallStack => String -> a
error (String -> IRI) -> String -> IRI
forall a b. (a -> b) -> a -> b
$ IRI -> String
showIRICompact IRI
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not a predefined datatype"

-- | checks if the IRI is part of the built-in ones and puts the correct prefix
setReservedPrefix :: IRI -> IRI
setReservedPrefix :: IRI -> IRI
setReservedPrefix i :: IRI
i = case IRI -> String
prefixName IRI
i of
  ""
    | IRI -> Bool
isDatatypeKey IRI
i -> IRI -> IRI
setDatatypePrefix IRI
i
    | IRI -> Bool
isThing IRI
i Bool -> Bool -> Bool
|| IRI -> Bool
isPredefDataProp IRI
i Bool -> Bool -> Bool
|| IRI -> Bool
isPredefOWLAnnoProp IRI
i
        Bool -> Bool -> Bool
|| IRI -> Bool
isPredefObjProp IRI
i -> String -> IRI -> IRI
setPrefix "owl" IRI
i
    | IRI -> Bool
isPredefRDFSAnnoProp IRI
i -> String -> IRI -> IRI
setPrefix "rdfs" IRI
i
  _ -> IRI
i

stripReservedPrefix :: IRI -> IRI
stripReservedPrefix :: IRI -> IRI
stripReservedPrefix = Id -> IRI
idToIRI (Id -> IRI) -> (IRI -> Id) -> IRI -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> Id
uriToId

{- | Extracts Id from IRI
     returns the name of the predefined IRI (e.g <xsd:string> returns "string"
     or <http://www.w3.org/2002/07/owl#real> returns "real") -}
uriToId :: IRI -> Id
uriToId :: IRI -> Id
uriToId i :: IRI
i =
    if (IRI -> Bool
isAbbrev IRI
i Bool -> Bool -> Bool
|| (Bool -> Bool
not (IRI -> Bool
hasFullIRI IRI
i) Bool -> Bool -> Bool
&& IRI -> String
prefixName IRI
i String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["", "xsd", "rdf", "rdfs", "owl"]))
    then String -> Id
stringToId (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ IRI -> String
iFragment IRI
i
    else String -> Id
stringToId (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ case (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` IRI -> String
showIRICompact IRI
i)
                ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ PrefixMap -> [String]
forall k a. Map k a -> [a]
Map.elems PrefixMap
predefPrefixes of
            [s :: String
s] -> String
s
            _ -> IRI -> String
showIRIFull IRI
i
            
getPredefName :: IRI -> String
getPredefName :: IRI -> String
getPredefName = Id -> String
forall a. Show a => a -> String
show (Id -> String) -> (IRI -> Id) -> IRI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> Id
uriToId

-- | Extracts Token from IRI
uriToTok :: IRI -> Token
uriToTok :: IRI -> Token
uriToTok = String -> Token
mkSimpleId (String -> Token) -> (IRI -> String) -> IRI -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show (String -> String) -> (IRI -> String) -> IRI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> String
getPredefName

-- | Extracts Id from Entities
entityToId :: Entity -> Id
entityToId :: Entity -> Id
entityToId = IRI -> Id
uriToId (IRI -> Id) -> (Entity -> IRI) -> Entity -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> IRI
cutIRI

printDatatype :: IRI -> String
printDatatype :: IRI -> String
printDatatype dt :: IRI
dt = IRI -> String
showIRICompact (IRI -> String) -> IRI -> String
forall a b. (a -> b) -> a -> b
$
    if IRI -> Bool
isDatatypeKey IRI
dt then IRI -> IRI
stripReservedPrefix IRI
dt else IRI
dt

data DatatypeCat = OWL2Number | OWL2String | OWL2Bool | Other
    deriving (Int -> DatatypeCat -> String -> String
[DatatypeCat] -> String -> String
DatatypeCat -> String
(Int -> DatatypeCat -> String -> String)
-> (DatatypeCat -> String)
-> ([DatatypeCat] -> String -> String)
-> Show DatatypeCat
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DatatypeCat] -> String -> String
$cshowList :: [DatatypeCat] -> String -> String
show :: DatatypeCat -> String
$cshow :: DatatypeCat -> String
showsPrec :: Int -> DatatypeCat -> String -> String
$cshowsPrec :: Int -> DatatypeCat -> String -> String
Show, DatatypeCat -> DatatypeCat -> Bool
(DatatypeCat -> DatatypeCat -> Bool)
-> (DatatypeCat -> DatatypeCat -> Bool) -> Eq DatatypeCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatatypeCat -> DatatypeCat -> Bool
$c/= :: DatatypeCat -> DatatypeCat -> Bool
== :: DatatypeCat -> DatatypeCat -> Bool
$c== :: DatatypeCat -> DatatypeCat -> Bool
Eq, Eq DatatypeCat
Eq DatatypeCat =>
(DatatypeCat -> DatatypeCat -> Ordering)
-> (DatatypeCat -> DatatypeCat -> Bool)
-> (DatatypeCat -> DatatypeCat -> Bool)
-> (DatatypeCat -> DatatypeCat -> Bool)
-> (DatatypeCat -> DatatypeCat -> Bool)
-> (DatatypeCat -> DatatypeCat -> DatatypeCat)
-> (DatatypeCat -> DatatypeCat -> DatatypeCat)
-> Ord DatatypeCat
DatatypeCat -> DatatypeCat -> Bool
DatatypeCat -> DatatypeCat -> Ordering
DatatypeCat -> DatatypeCat -> DatatypeCat
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 :: DatatypeCat -> DatatypeCat -> DatatypeCat
$cmin :: DatatypeCat -> DatatypeCat -> DatatypeCat
max :: DatatypeCat -> DatatypeCat -> DatatypeCat
$cmax :: DatatypeCat -> DatatypeCat -> DatatypeCat
>= :: DatatypeCat -> DatatypeCat -> Bool
$c>= :: DatatypeCat -> DatatypeCat -> Bool
> :: DatatypeCat -> DatatypeCat -> Bool
$c> :: DatatypeCat -> DatatypeCat -> Bool
<= :: DatatypeCat -> DatatypeCat -> Bool
$c<= :: DatatypeCat -> DatatypeCat -> Bool
< :: DatatypeCat -> DatatypeCat -> Bool
$c< :: DatatypeCat -> DatatypeCat -> Bool
compare :: DatatypeCat -> DatatypeCat -> Ordering
$ccompare :: DatatypeCat -> DatatypeCat -> Ordering
$cp1Ord :: Eq DatatypeCat
Ord, Typeable, Typeable DatatypeCat
Constr
DataType
Typeable DatatypeCat =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DatatypeCat -> c DatatypeCat)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DatatypeCat)
-> (DatatypeCat -> Constr)
-> (DatatypeCat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DatatypeCat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DatatypeCat))
-> ((forall b. Data b => b -> b) -> DatatypeCat -> DatatypeCat)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r)
-> (forall u. (forall d. Data d => d -> u) -> DatatypeCat -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DatatypeCat -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat)
-> Data DatatypeCat
DatatypeCat -> Constr
DatatypeCat -> DataType
(forall b. Data b => b -> b) -> DatatypeCat -> DatatypeCat
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeCat -> c DatatypeCat
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeCat
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DatatypeCat -> u
forall u. (forall d. Data d => d -> u) -> DatatypeCat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeCat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeCat -> c DatatypeCat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeCat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeCat)
$cOther :: Constr
$cOWL2Bool :: Constr
$cOWL2String :: Constr
$cOWL2Number :: Constr
$tDatatypeCat :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
gmapMp :: (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
gmapM :: (forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DatatypeCat -> m DatatypeCat
gmapQi :: Int -> (forall d. Data d => d -> u) -> DatatypeCat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DatatypeCat -> u
gmapQ :: (forall d. Data d => d -> u) -> DatatypeCat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeCat -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeCat -> r
gmapT :: (forall b. Data b => b -> b) -> DatatypeCat -> DatatypeCat
$cgmapT :: (forall b. Data b => b -> b) -> DatatypeCat -> DatatypeCat
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeCat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeCat)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DatatypeCat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeCat)
dataTypeOf :: DatatypeCat -> DataType
$cdataTypeOf :: DatatypeCat -> DataType
toConstr :: DatatypeCat -> Constr
$ctoConstr :: DatatypeCat -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeCat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeCat
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeCat -> c DatatypeCat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeCat -> c DatatypeCat
$cp1Data :: Typeable DatatypeCat
Data)

getDatatypeCat :: IRI -> DatatypeCat
getDatatypeCat :: IRI -> DatatypeCat
getDatatypeCat i :: IRI
i = case IRI -> Bool
isDatatypeKey IRI
i of
    True
        | PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
xsdBooleanMap IRI
i -> DatatypeCat
OWL2Bool
        | PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
xsdNumbersMap IRI
i Bool -> Bool -> Bool
|| PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
owlNumbersMap IRI
i
            -> DatatypeCat
OWL2Number
        | PreDefMaps -> IRI -> Bool
checkPredef PreDefMaps
xsdStringsMap IRI
i -> DatatypeCat
OWL2String
        | Bool
otherwise -> DatatypeCat
Other
    False -> DatatypeCat
Other

makeXsdMap :: [String] -> PreDefMaps
makeXsdMap :: [String] -> PreDefMaps
makeXsdMap sl :: [String]
sl = [String] -> String -> PreDefMaps
preDefMaps [String]
sl "xsd"

xsdBooleanMap :: PreDefMaps
xsdBooleanMap :: PreDefMaps
xsdBooleanMap = [String] -> PreDefMaps
makeXsdMap [String
booleanS]

xsdNumbersMap :: PreDefMaps
xsdNumbersMap :: PreDefMaps
xsdNumbersMap = [String] -> PreDefMaps
makeXsdMap [String]
xsdNumbers

xsdStringsMap :: PreDefMaps
xsdStringsMap :: PreDefMaps
xsdStringsMap = [String] -> PreDefMaps
makeXsdMap [String]
xsdStrings

facetToIRI :: DatatypeFacet -> ConstrainingFacet
facetToIRI :: DatatypeFacet -> IRI
facetToIRI f :: DatatypeFacet
f = PrefixMap -> IRI -> IRI
expandIRI PrefixMap
predefPrefixesGA (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ IRI
nullIRI {
    prefixName :: String
prefixName = "xsd"
  , iFragment :: String
iFragment = DatatypeFacet -> String
showFacet DatatypeFacet
f
  , isAbbrev :: Bool
isAbbrev = Bool
True
}

facetToIRINoSign :: DatatypeFacet -> ConstrainingFacet
facetToIRINoSign :: DatatypeFacet -> IRI
facetToIRINoSign f :: DatatypeFacet
f = PrefixMap -> IRI -> IRI
expandIRI PrefixMap
predefPrefixesGA (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ IRI
nullIRI {
    prefixName :: String
prefixName = "xsd"
  , iFragment :: String
iFragment = DatatypeFacet -> String
showFacetAsText DatatypeFacet
f
  , isAbbrev :: Bool
isAbbrev = Bool
True
}

-- * Extracting Symbols


-- symsOfAxiom :: Axiom -> Set.Set AS.Entity
-- symsOfAxiom (PlainAxiom e f) = Set.union (symsOfExtended e) $ symsOfFrameBit f

symsOfAxiom :: Axiom -> Set.Set Entity
symsOfAxiom :: Axiom -> Set Entity
symsOfAxiom ax :: Axiom
ax = case Axiom
ax of
    Declaration anns :: AxiomAnnotations
anns e :: Entity
e -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns) (Entity -> Set Entity
forall a. a -> Set a
Set.singleton Entity
e) 
    ClassAxiom cax :: ClassAxiom
cax -> case ClassAxiom
cax of
        SubClassOf anns :: AxiomAnnotations
anns supClExpr :: ClassExpression
supClExpr subClExpr :: ClassExpression
subClExpr -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
            (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns),
            (ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
supClExpr),
            (ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
subClExpr)
          ]
        EquivalentClasses anns :: AxiomAnnotations
anns clExprs :: [ClassExpression]
clExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ((ClassExpression -> Set Entity)
-> [ClassExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ClassExpression -> Set Entity
symsOfClassExpression [ClassExpression]
clExprs) 
        DisjointClasses anns :: AxiomAnnotations
anns clExprs :: [ClassExpression]
clExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ((ClassExpression -> Set Entity)
-> [ClassExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ClassExpression -> Set Entity
symsOfClassExpression [ClassExpression]
clExprs) 
        DisjointUnion anns :: AxiomAnnotations
anns clIri :: IRI
clIri clExprs :: [ClassExpression]
clExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
Class (IRI -> Entity) -> IRI -> Entity
forall a b. (a -> b) -> a -> b
$ IRI
clIri) (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ((ClassExpression -> Set Entity)
-> [ClassExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ClassExpression -> Set Entity
symsOfClassExpression [ClassExpression]
clExprs)

    ObjectPropertyAxiom opax :: ObjectPropertyAxiom
opax -> case ObjectPropertyAxiom
opax of
        SubObjectPropertyOf anns :: AxiomAnnotations
anns subOpExpr :: SubObjectPropertyExpression
subOpExpr supOpExpr :: ObjectPropertyExpression
supOpExpr ->
          let opExprs :: [ObjectPropertyExpression]
opExprs = case SubObjectPropertyExpression
subOpExpr of
                SubObjPropExpr_obj opExpr :: ObjectPropertyExpression
opExpr -> [ObjectPropertyExpression
opExpr]
                SubObjPropExpr_exprchain opExprCh :: [ObjectPropertyExpression]
opExprCh -> [ObjectPropertyExpression]
opExprCh
          in
            (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
              ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ([ObjectPropertyExpression] -> [Set Entity])
-> ([[ObjectPropertyExpression]] -> [ObjectPropertyExpression])
-> [[ObjectPropertyExpression]]
-> [Set Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ObjectPropertyExpression]] -> [ObjectPropertyExpression]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ObjectPropertyExpression]] -> [Set Entity])
-> [[ObjectPropertyExpression]] -> [Set Entity]
forall a b. (a -> b) -> a -> b
$ [[ObjectPropertyExpression]
opExprs, [ObjectPropertyExpression
supOpExpr]]
        EquivalentObjectProperties anns :: AxiomAnnotations
anns opExprs :: [ObjectPropertyExpression]
opExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression [ObjectPropertyExpression]
opExprs
        DisjointObjectProperties anns :: AxiomAnnotations
anns opExprs :: [ObjectPropertyExpression]
opExprs -> 
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns) 
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression [ObjectPropertyExpression]
opExprs
        InverseObjectProperties anns :: AxiomAnnotations
anns opExpr1 :: ObjectPropertyExpression
opExpr1 opExpr2 :: ObjectPropertyExpression
opExpr2 ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression [ObjectPropertyExpression
opExpr1, ObjectPropertyExpression
opExpr2]
        ObjectPropertyDomain anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr clExpr :: ClassExpression
clExpr ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            [ ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr
            , ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
clExpr] 
        ObjectPropertyRange anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr clExpr :: ClassExpression
clExpr ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            [ ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr
            , ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
clExpr] 
        FunctionalObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr) 
        InverseFunctionalObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr) 
        ReflexiveObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr)  
        IrreflexiveObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr)  
        SymmetricObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr)  
        AsymmetricObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr)  
        TransitiveObjectProperty anns :: AxiomAnnotations
anns opExpr :: ObjectPropertyExpression
opExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
opExpr)  
    DataPropertyAxiom a :: DataPropertyAxiom
a -> case DataPropertyAxiom
a of
        SubDataPropertyOf anns :: AxiomAnnotations
anns dpExpr1 :: IRI
dpExpr1 dpExpr2 :: IRI
dpExpr2 ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (IRI -> Set Entity) -> [IRI] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype) [IRI
dpExpr1, IRI
dpExpr2] 
        EquivalentDataProperties anns :: AxiomAnnotations
anns dpExprs :: [IRI]
dpExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (IRI -> Set Entity) -> [IRI] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype) [IRI]
dpExprs 
        DisjointDataProperties anns :: AxiomAnnotations
anns dpExprs :: [IRI]
dpExprs ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (IRI -> Set Entity) -> [IRI] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype) [IRI]
dpExprs
        DataPropertyDomain anns :: AxiomAnnotations
anns dpExpr :: IRI
dpExpr clExpr :: ClassExpression
clExpr ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            [ Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype (IRI -> Set Entity) -> IRI -> Set Entity
forall a b. (a -> b) -> a -> b
$ IRI
dpExpr
            , ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
clExpr] 
        DataPropertyRange anns :: AxiomAnnotations
anns dpExpr :: IRI
dpExpr dr :: DataRange
dr ->
          (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            [ Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype (IRI -> Set Entity) -> IRI -> Set Entity
forall a b. (a -> b) -> a -> b
$ IRI
dpExpr
            , DataRange -> Set Entity
symsOfDataRange DataRange
dr] 
        FunctionalDataProperty anns :: AxiomAnnotations
anns dpExpr :: IRI
dpExpr ->
          Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            (Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype (IRI -> Set Entity) -> IRI -> Set Entity
forall a b. (a -> b) -> a -> b
$ IRI
dpExpr)
    DatatypeDefinition anns :: AxiomAnnotations
anns dt :: IRI
dt dr :: DataRange
dr ->
      (Set Entity -> Set Entity -> Set Entity)
-> Set Entity -> [Set Entity] -> Set Entity
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
            [ Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> (IRI -> Entity) -> IRI -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> IRI -> Entity
mkEntity EntityType
Datatype (IRI -> Set Entity) -> IRI -> Set Entity
forall a b. (a -> b) -> a -> b
$ IRI
dt
            , DataRange -> Set Entity
symsOfDataRange DataRange
dr] 
    HasKey anns :: AxiomAnnotations
anns c :: ClassExpression
c os :: [ObjectPropertyExpression]
os ds :: [IRI]
ds -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
        AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
        ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
c,
        [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectPropertyExpression]
os),
        [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI]
ds)
      ]
    Assertion a :: Assertion
a -> case Assertion
a of
        SameIndividual anns :: AxiomAnnotations
anns inds :: [IRI]
inds -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union
          (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
          ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI]
inds))
        DifferentIndividuals anns :: AxiomAnnotations
anns inds :: [IRI]
inds -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union
          (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
          ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI]
inds))
        ClassAssertion anns :: AxiomAnnotations
anns _ i :: IRI
i -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
i) (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$
          Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
i) (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
        ObjectPropertyAssertion anns :: AxiomAnnotations
anns o :: ObjectPropertyExpression
o s :: IRI
s t :: IRI
t -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
            AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
            ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
o,
            [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI
s, IRI
t])
          ]
        NegativeObjectPropertyAssertion anns :: AxiomAnnotations
anns o :: ObjectPropertyExpression
o s :: IRI
s t :: IRI
t -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
            AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
            ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
o,
            [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI
s, IRI
t])
          ]
        DataPropertyAssertion anns :: AxiomAnnotations
anns d :: IRI
d s :: IRI
s _ -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
            AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
            Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty IRI
d,
            Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
s
          ]
        NegativeDataPropertyAssertion anns :: AxiomAnnotations
anns d :: IRI
d s :: IRI
s _ -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
            AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
            Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty IRI
d,
            Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
s
          ]
    AnnotationAxiom a :: AnnotationAxiom
a -> case AnnotationAxiom
a of
        AnnotationAssertion anns :: AxiomAnnotations
anns p :: IRI
p _ v :: AnnotationValue
v -> Annotation -> Set Entity
symsOfAnnotation (Annotation -> Set Entity) -> Annotation -> Set Entity
forall a b. (a -> b) -> a -> b
$ AxiomAnnotations -> IRI -> AnnotationValue -> Annotation
Annotation AxiomAnnotations
anns IRI
p AnnotationValue
v
        SubAnnotationPropertyOf anns :: AxiomAnnotations
anns p1 :: IRI
p1 p2 :: IRI
p2 -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union
          (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
          ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
AnnotationProperty (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI
p1, IRI
p2]))
        AnnotationPropertyDomain anns :: AxiomAnnotations
anns p :: IRI
p _ -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert
          (EntityType -> IRI -> Entity
mkEntity EntityType
AnnotationProperty IRI
p)
          (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
        AnnotationPropertyRange anns :: AxiomAnnotations
anns p :: IRI
p _ -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert
          (EntityType -> IRI -> Entity
mkEntity EntityType
AnnotationProperty IRI
p)
          (AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns)
    Rule a :: Rule
a -> case Rule
a of
      DLSafeRule anns :: AxiomAnnotations
anns b :: Body
b h :: Body
h -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
          AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
          Body -> Set Entity
symsOfDLSafeAtoms Body
b,
          Body -> Set Entity
symsOfDLSafeAtoms Body
h
        ]
      DGRule anns :: AxiomAnnotations
anns b :: DGBody
b h :: DGBody
h -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
          AxiomAnnotations -> Set Entity
symsOfAnnotations AxiomAnnotations
anns,
          DGBody -> Set Entity
symsOfDGAtoms DGBody
b,
          DGBody -> Set Entity
symsOfDGAtoms DGBody
h
        ]
    DGAxiom _ _ _ e :: DGEdges
e c :: [IRI]
c -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
        DGEdges -> Set Entity
symsOfDGEdges DGEdges
e,
        [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList (EntityType -> IRI -> Entity
mkEntity EntityType
Class (IRI -> Entity) -> [IRI] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRI]
c)
      ]

symsOfDGAtoms :: [DGAtom] -> Set.Set Entity
symsOfDGAtoms :: DGBody -> Set Entity
symsOfDGAtoms = [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Entity] -> Set Entity)
-> (DGBody -> [Set Entity]) -> DGBody -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DGAtom -> Set Entity) -> DGBody -> [Set Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a :: DGAtom
a -> case DGAtom
a of
    DGClassAtom e :: ClassExpression
e i :: IndividualArg
i -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
e) (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i)
    DGObjectPropertyAtom o :: ObjectPropertyExpression
o i1 :: IndividualArg
i1 i2 :: IndividualArg
i2 -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
        ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
o,
        IndividualArg -> Set Entity
symsOfIArg IndividualArg
i1,
        IndividualArg -> Set Entity
symsOfIArg IndividualArg
i2
      ]
  )

symsOfDLSafeAtoms :: [Atom] -> Set.Set Entity
symsOfDLSafeAtoms :: Body -> Set Entity
symsOfDLSafeAtoms = [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Entity] -> Set Entity)
-> (Body -> [Set Entity]) -> Body -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Atom -> Set Entity) -> Body -> [Set Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a :: Atom
a -> case Atom
a of
    ClassAtom e :: ClassExpression
e  i :: IndividualArg
i-> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
e) (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i)
    ObjectPropertyAtom o :: ObjectPropertyExpression
o i1 :: IndividualArg
i1 i2 :: IndividualArg
i2 -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [
        ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
o,
        IndividualArg -> Set Entity
symsOfIArg IndividualArg
i1,
        IndividualArg -> Set Entity
symsOfIArg IndividualArg
i2
      ]
    DataPropertyAtom d :: IRI
d i :: IndividualArg
i _ -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty IRI
d) (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i)
    SameIndividualAtom i1 :: IndividualArg
i1 i2 :: IndividualArg
i2 -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i1) (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i2)
    DifferentIndividualsAtom i1 :: IndividualArg
i1 i2 :: IndividualArg
i2 -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i1) (IndividualArg -> Set Entity
symsOfIArg IndividualArg
i2)
    _ -> Set Entity
forall a. Monoid a => a
mempty
  )

symsOfIArg :: IndividualArg -> Set.Set Entity
symsOfIArg :: IndividualArg -> Set Entity
symsOfIArg a :: IndividualArg
a = case IndividualArg
a of
  IArg i :: IRI
i -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
i
  _ -> Set Entity
forall a. Monoid a => a
mempty 

symsOfDGEdges :: DGEdges -> Set.Set Entity
symsOfDGEdges :: DGEdges -> Set Entity
symsOfDGEdges = [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList ([Entity] -> Set Entity)
-> (DGEdges -> [Entity]) -> DGEdges -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DGEdgeAssertion -> Entity) -> DGEdges -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DGEdgeAssertion o :: IRI
o _ _) ->
  EntityType -> IRI -> Entity
mkEntity EntityType
ObjectProperty IRI
o)

symsOfObjectPropertyExpression :: ObjectPropertyExpression -> Set.Set Entity
symsOfObjectPropertyExpression :: ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression o :: ObjectPropertyExpression
o = case ObjectPropertyExpression
o of
  ObjectProp i :: IRI
i -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
ObjectProperty IRI
i
  ObjectInverseOf i :: ObjectPropertyExpression
i -> ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
i

symsOfClassExpression :: ClassExpression -> Set.Set Entity
symsOfClassExpression :: ClassExpression -> Set Entity
symsOfClassExpression ce :: ClassExpression
ce = case ClassExpression
ce of
  Expression c :: IRI
c -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
Class IRI
c
  ObjectJunction _ cs :: [ClassExpression]
cs -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (ClassExpression -> Set Entity)
-> [ClassExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ClassExpression -> Set Entity
symsOfClassExpression [ClassExpression]
cs
  ObjectComplementOf c :: ClassExpression
c -> ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
c
  ObjectOneOf is :: [IRI]
is -> [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList ([Entity] -> Set Entity) -> [Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (IRI -> Entity) -> [IRI] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual) [IRI]
is
  ObjectValuesFrom _ oe :: ObjectPropertyExpression
oe c :: ClassExpression
c -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
c
  ObjectHasValue oe :: ObjectPropertyExpression
oe i :: IRI
i -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
NamedIndividual IRI
i)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe
  ObjectHasSelf oe :: ObjectPropertyExpression
oe -> ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe
  ObjectCardinality (Cardinality _ _ oe :: ObjectPropertyExpression
oe mc :: Maybe ClassExpression
mc) -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    (ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ Set Entity
-> (ClassExpression -> Set Entity)
-> Maybe ClassExpression
-> Set Entity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Entity
forall a. Set a
Set.empty ClassExpression -> Set Entity
symsOfClassExpression Maybe ClassExpression
mc
  DataValuesFrom _ de :: [IRI]
de dr :: DataRange
dr -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList ([Entity] -> Set Entity) -> [Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (IRI -> Entity) -> [IRI] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty) [IRI]
de)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ DataRange -> Set Entity
symsOfDataRange DataRange
dr
  DataHasValue de :: IRI
de _ -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty IRI
de
  DataCardinality (Cardinality _ _ d :: IRI
d m :: Maybe DataRange
m) -> Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert (EntityType -> IRI -> Entity
mkEntity EntityType
DataProperty IRI
d)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ Set Entity
-> (DataRange -> Set Entity) -> Maybe DataRange -> Set Entity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Entity
forall a. Set a
Set.empty DataRange -> Set Entity
symsOfDataRange Maybe DataRange
m

symsOfDataRange :: DataRange -> Set.Set Entity
symsOfDataRange :: DataRange -> Set Entity
symsOfDataRange dr :: DataRange
dr = case DataRange
dr of
  DataType t :: IRI
t _ -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton (Entity -> Set Entity) -> Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ EntityType -> IRI -> Entity
mkEntity EntityType
Datatype IRI
t
  DataJunction _ ds :: [DataRange]
ds -> [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall a b. (a -> b) -> a -> b
$ (DataRange -> Set Entity) -> [DataRange] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map DataRange -> Set Entity
symsOfDataRange [DataRange]
ds
  DataComplementOf d :: DataRange
d -> DataRange -> Set Entity
symsOfDataRange DataRange
d
  DataOneOf _ -> Set Entity
forall a. Set a
Set.empty

symsOfAnnotation :: Annotation -> Set.Set Entity
symsOfAnnotation :: Annotation -> Set Entity
symsOfAnnotation (Annotation as :: AxiomAnnotations
as p :: IRI
p _) = Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert
   (EntityType -> IRI -> Entity
mkEntity EntityType
AnnotationProperty IRI
p) (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((Annotation -> Set Entity) -> AxiomAnnotations -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Set Entity
symsOfAnnotation AxiomAnnotations
as)

symsOfAnnotations :: [Annotation] -> Set.Set Entity
symsOfAnnotations :: AxiomAnnotations -> Set Entity
symsOfAnnotations = [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Entity] -> Set Entity)
-> (AxiomAnnotations -> [Set Entity])
-> AxiomAnnotations
-> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation -> Set Entity) -> AxiomAnnotations -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Set Entity
symsOfAnnotation


-- * Cardinalities

data CardinalityType = MinCardinality | MaxCardinality | ExactCardinality
    deriving (Int -> CardinalityType -> String -> String
[CardinalityType] -> String -> String
CardinalityType -> String
(Int -> CardinalityType -> String -> String)
-> (CardinalityType -> String)
-> ([CardinalityType] -> String -> String)
-> Show CardinalityType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CardinalityType] -> String -> String
$cshowList :: [CardinalityType] -> String -> String
show :: CardinalityType -> String
$cshow :: CardinalityType -> String
showsPrec :: Int -> CardinalityType -> String -> String
$cshowsPrec :: Int -> CardinalityType -> String -> String
Show, CardinalityType -> CardinalityType -> Bool
(CardinalityType -> CardinalityType -> Bool)
-> (CardinalityType -> CardinalityType -> Bool)
-> Eq CardinalityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardinalityType -> CardinalityType -> Bool
$c/= :: CardinalityType -> CardinalityType -> Bool
== :: CardinalityType -> CardinalityType -> Bool
$c== :: CardinalityType -> CardinalityType -> Bool
Eq, Eq CardinalityType
Eq CardinalityType =>
(CardinalityType -> CardinalityType -> Ordering)
-> (CardinalityType -> CardinalityType -> Bool)
-> (CardinalityType -> CardinalityType -> Bool)
-> (CardinalityType -> CardinalityType -> Bool)
-> (CardinalityType -> CardinalityType -> Bool)
-> (CardinalityType -> CardinalityType -> CardinalityType)
-> (CardinalityType -> CardinalityType -> CardinalityType)
-> Ord CardinalityType
CardinalityType -> CardinalityType -> Bool
CardinalityType -> CardinalityType -> Ordering
CardinalityType -> CardinalityType -> CardinalityType
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 :: CardinalityType -> CardinalityType -> CardinalityType
$cmin :: CardinalityType -> CardinalityType -> CardinalityType
max :: CardinalityType -> CardinalityType -> CardinalityType
$cmax :: CardinalityType -> CardinalityType -> CardinalityType
>= :: CardinalityType -> CardinalityType -> Bool
$c>= :: CardinalityType -> CardinalityType -> Bool
> :: CardinalityType -> CardinalityType -> Bool
$c> :: CardinalityType -> CardinalityType -> Bool
<= :: CardinalityType -> CardinalityType -> Bool
$c<= :: CardinalityType -> CardinalityType -> Bool
< :: CardinalityType -> CardinalityType -> Bool
$c< :: CardinalityType -> CardinalityType -> Bool
compare :: CardinalityType -> CardinalityType -> Ordering
$ccompare :: CardinalityType -> CardinalityType -> Ordering
$cp1Ord :: Eq CardinalityType
Ord, Typeable, Typeable CardinalityType
Constr
DataType
Typeable CardinalityType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CardinalityType -> c CardinalityType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CardinalityType)
-> (CardinalityType -> Constr)
-> (CardinalityType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CardinalityType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CardinalityType))
-> ((forall b. Data b => b -> b)
    -> CardinalityType -> CardinalityType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CardinalityType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CardinalityType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CardinalityType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CardinalityType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CardinalityType -> m CardinalityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CardinalityType -> m CardinalityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CardinalityType -> m CardinalityType)
-> Data CardinalityType
CardinalityType -> Constr
CardinalityType -> DataType
(forall b. Data b => b -> b) -> CardinalityType -> CardinalityType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CardinalityType -> c CardinalityType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CardinalityType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CardinalityType -> u
forall u. (forall d. Data d => d -> u) -> CardinalityType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CardinalityType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CardinalityType -> c CardinalityType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CardinalityType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CardinalityType)
$cExactCardinality :: Constr
$cMaxCardinality :: Constr
$cMinCardinality :: Constr
$tCardinalityType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
gmapMp :: (forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
gmapM :: (forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CardinalityType -> m CardinalityType
gmapQi :: Int -> (forall d. Data d => d -> u) -> CardinalityType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CardinalityType -> u
gmapQ :: (forall d. Data d => d -> u) -> CardinalityType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CardinalityType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CardinalityType -> r
gmapT :: (forall b. Data b => b -> b) -> CardinalityType -> CardinalityType
$cgmapT :: (forall b. Data b => b -> b) -> CardinalityType -> CardinalityType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CardinalityType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CardinalityType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CardinalityType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CardinalityType)
dataTypeOf :: CardinalityType -> DataType
$cdataTypeOf :: CardinalityType -> DataType
toConstr :: CardinalityType -> Constr
$ctoConstr :: CardinalityType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CardinalityType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CardinalityType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CardinalityType -> c CardinalityType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CardinalityType -> c CardinalityType
$cp1Data :: Typeable CardinalityType
Data)

showCardinalityType :: CardinalityType -> String
showCardinalityType :: CardinalityType -> String
showCardinalityType ty :: CardinalityType
ty = case CardinalityType
ty of
    MinCardinality -> String
minS
    MaxCardinality -> String
maxS
    ExactCardinality -> String
exactlyS

data Cardinality a b = Cardinality CardinalityType Int a (Maybe b)
    deriving (Int -> Cardinality a b -> String -> String
[Cardinality a b] -> String -> String
Cardinality a b -> String
(Int -> Cardinality a b -> String -> String)
-> (Cardinality a b -> String)
-> ([Cardinality a b] -> String -> String)
-> Show (Cardinality a b)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall a b.
(Show a, Show b) =>
Int -> Cardinality a b -> String -> String
forall a b.
(Show a, Show b) =>
[Cardinality a b] -> String -> String
forall a b. (Show a, Show b) => Cardinality a b -> String
showList :: [Cardinality a b] -> String -> String
$cshowList :: forall a b.
(Show a, Show b) =>
[Cardinality a b] -> String -> String
show :: Cardinality a b -> String
$cshow :: forall a b. (Show a, Show b) => Cardinality a b -> String
showsPrec :: Int -> Cardinality a b -> String -> String
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> Cardinality a b -> String -> String
Show, Cardinality a b -> Cardinality a b -> Bool
(Cardinality a b -> Cardinality a b -> Bool)
-> (Cardinality a b -> Cardinality a b -> Bool)
-> Eq (Cardinality a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
Cardinality a b -> Cardinality a b -> Bool
/= :: Cardinality a b -> Cardinality a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
Cardinality a b -> Cardinality a b -> Bool
== :: Cardinality a b -> Cardinality a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
Cardinality a b -> Cardinality a b -> Bool
Eq, Eq (Cardinality a b)
Eq (Cardinality a b) =>
(Cardinality a b -> Cardinality a b -> Ordering)
-> (Cardinality a b -> Cardinality a b -> Bool)
-> (Cardinality a b -> Cardinality a b -> Bool)
-> (Cardinality a b -> Cardinality a b -> Bool)
-> (Cardinality a b -> Cardinality a b -> Bool)
-> (Cardinality a b -> Cardinality a b -> Cardinality a b)
-> (Cardinality a b -> Cardinality a b -> Cardinality a b)
-> Ord (Cardinality a b)
Cardinality a b -> Cardinality a b -> Bool
Cardinality a b -> Cardinality a b -> Ordering
Cardinality a b -> Cardinality a b -> Cardinality a b
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
forall a b. (Ord a, Ord b) => Eq (Cardinality a b)
forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Bool
forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Ordering
forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Cardinality a b
min :: Cardinality a b -> Cardinality a b -> Cardinality a b
$cmin :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Cardinality a b
max :: Cardinality a b -> Cardinality a b -> Cardinality a b
$cmax :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Cardinality a b
>= :: Cardinality a b -> Cardinality a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Bool
> :: Cardinality a b -> Cardinality a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Bool
<= :: Cardinality a b -> Cardinality a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Bool
< :: Cardinality a b -> Cardinality a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Bool
compare :: Cardinality a b -> Cardinality a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
Cardinality a b -> Cardinality a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (Cardinality a b)
Ord, Typeable, Typeable (Cardinality a b)
Constr
DataType
Typeable (Cardinality a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Cardinality a b))
-> (Cardinality a b -> Constr)
-> (Cardinality a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Cardinality a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Cardinality a b)))
-> ((forall b. Data b => b -> b)
    -> Cardinality a b -> Cardinality a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Cardinality a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Cardinality a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Cardinality a b -> m (Cardinality a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Cardinality a b -> m (Cardinality a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Cardinality a b -> m (Cardinality a b))
-> Data (Cardinality a b)
Cardinality a b -> Constr
Cardinality a b -> DataType
(forall b. Data b => b -> b) -> Cardinality a b -> Cardinality a b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cardinality a b)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Cardinality a b))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Cardinality a b -> u
forall u. (forall d. Data d => d -> u) -> Cardinality a b -> [u]
forall a b. (Data a, Data b) => Typeable (Cardinality a b)
forall a b. (Data a, Data b) => Cardinality a b -> Constr
forall a b. (Data a, Data b) => Cardinality a b -> DataType
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Cardinality a b -> Cardinality a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Cardinality a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Cardinality a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cardinality a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Cardinality a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Cardinality a b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cardinality a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Cardinality a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Cardinality a b))
$cCardinality :: Constr
$tCardinality :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
gmapMp :: (forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
gmapM :: (forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> Cardinality a b -> m (Cardinality a b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Cardinality a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Cardinality a b -> u
gmapQ :: (forall d. Data d => d -> u) -> Cardinality a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Cardinality a b -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality a b -> r
gmapT :: (forall b. Data b => b -> b) -> Cardinality a b -> Cardinality a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Cardinality a b -> Cardinality a b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Cardinality a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Cardinality a b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Cardinality a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Cardinality a b))
dataTypeOf :: Cardinality a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Cardinality a b -> DataType
toConstr :: Cardinality a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Cardinality a b -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cardinality a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Cardinality a b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality a b -> c (Cardinality a b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (Cardinality a b)
Data)

data JunctionType = UnionOf | IntersectionOf
    deriving (Int -> JunctionType -> String -> String
[JunctionType] -> String -> String
JunctionType -> String
(Int -> JunctionType -> String -> String)
-> (JunctionType -> String)
-> ([JunctionType] -> String -> String)
-> Show JunctionType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [JunctionType] -> String -> String
$cshowList :: [JunctionType] -> String -> String
show :: JunctionType -> String
$cshow :: JunctionType -> String
showsPrec :: Int -> JunctionType -> String -> String
$cshowsPrec :: Int -> JunctionType -> String -> String
Show, JunctionType -> JunctionType -> Bool
(JunctionType -> JunctionType -> Bool)
-> (JunctionType -> JunctionType -> Bool) -> Eq JunctionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JunctionType -> JunctionType -> Bool
$c/= :: JunctionType -> JunctionType -> Bool
== :: JunctionType -> JunctionType -> Bool
$c== :: JunctionType -> JunctionType -> Bool
Eq, Eq JunctionType
Eq JunctionType =>
(JunctionType -> JunctionType -> Ordering)
-> (JunctionType -> JunctionType -> Bool)
-> (JunctionType -> JunctionType -> Bool)
-> (JunctionType -> JunctionType -> Bool)
-> (JunctionType -> JunctionType -> Bool)
-> (JunctionType -> JunctionType -> JunctionType)
-> (JunctionType -> JunctionType -> JunctionType)
-> Ord JunctionType
JunctionType -> JunctionType -> Bool
JunctionType -> JunctionType -> Ordering
JunctionType -> JunctionType -> JunctionType
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 :: JunctionType -> JunctionType -> JunctionType
$cmin :: JunctionType -> JunctionType -> JunctionType
max :: JunctionType -> JunctionType -> JunctionType
$cmax :: JunctionType -> JunctionType -> JunctionType
>= :: JunctionType -> JunctionType -> Bool
$c>= :: JunctionType -> JunctionType -> Bool
> :: JunctionType -> JunctionType -> Bool
$c> :: JunctionType -> JunctionType -> Bool
<= :: JunctionType -> JunctionType -> Bool
$c<= :: JunctionType -> JunctionType -> Bool
< :: JunctionType -> JunctionType -> Bool
$c< :: JunctionType -> JunctionType -> Bool
compare :: JunctionType -> JunctionType -> Ordering
$ccompare :: JunctionType -> JunctionType -> Ordering
$cp1Ord :: Eq JunctionType
Ord, Typeable, Typeable JunctionType
Constr
DataType
Typeable JunctionType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JunctionType -> c JunctionType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JunctionType)
-> (JunctionType -> Constr)
-> (JunctionType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JunctionType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JunctionType))
-> ((forall b. Data b => b -> b) -> JunctionType -> JunctionType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JunctionType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JunctionType -> r)
-> (forall u. (forall d. Data d => d -> u) -> JunctionType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JunctionType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType)
-> Data JunctionType
JunctionType -> Constr
JunctionType -> DataType
(forall b. Data b => b -> b) -> JunctionType -> JunctionType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JunctionType -> c JunctionType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JunctionType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JunctionType -> u
forall u. (forall d. Data d => d -> u) -> JunctionType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JunctionType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JunctionType -> c JunctionType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JunctionType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JunctionType)
$cIntersectionOf :: Constr
$cUnionOf :: Constr
$tJunctionType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
gmapMp :: (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
gmapM :: (forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JunctionType -> m JunctionType
gmapQi :: Int -> (forall d. Data d => d -> u) -> JunctionType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JunctionType -> u
gmapQ :: (forall d. Data d => d -> u) -> JunctionType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JunctionType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JunctionType -> r
gmapT :: (forall b. Data b => b -> b) -> JunctionType -> JunctionType
$cgmapT :: (forall b. Data b => b -> b) -> JunctionType -> JunctionType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JunctionType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JunctionType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JunctionType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JunctionType)
dataTypeOf :: JunctionType -> DataType
$cdataTypeOf :: JunctionType -> DataType
toConstr :: JunctionType -> Constr
$ctoConstr :: JunctionType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JunctionType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JunctionType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JunctionType -> c JunctionType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JunctionType -> c JunctionType
$cp1Data :: Typeable JunctionType
Data)

type ConstrainingFacet = IRI
type RestrictionValue = Literal

-- * ENTITIES

data Entity = Entity
  { Entity -> Maybe String
label :: Maybe String
  , Entity -> EntityType
entityKind :: EntityType
  , Entity -> IRI
cutIRI :: IRI }
  deriving (Int -> Entity -> String -> String
[Entity] -> String -> String
Entity -> String
(Int -> Entity -> String -> String)
-> (Entity -> String)
-> ([Entity] -> String -> String)
-> Show Entity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Entity] -> String -> String
$cshowList :: [Entity] -> String -> String
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> String -> String
$cshowsPrec :: Int -> Entity -> String -> String
Show, Typeable, Typeable Entity
Constr
DataType
Typeable Entity =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Entity -> c Entity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Entity)
-> (Entity -> Constr)
-> (Entity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Entity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entity))
-> ((forall b. Data b => b -> b) -> Entity -> Entity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Entity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Entity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Entity -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Entity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Entity -> m Entity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entity -> m Entity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entity -> m Entity)
-> Data Entity
Entity -> Constr
Entity -> DataType
(forall b. Data b => b -> b) -> Entity -> Entity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entity -> c Entity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entity
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Entity -> u
forall u. (forall d. Data d => d -> u) -> Entity -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entity -> m Entity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entity -> m Entity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entity -> c Entity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entity)
$cEntity :: Constr
$tEntity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Entity -> m Entity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entity -> m Entity
gmapMp :: (forall d. Data d => d -> m d) -> Entity -> m Entity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entity -> m Entity
gmapM :: (forall d. Data d => d -> m d) -> Entity -> m Entity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entity -> m Entity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Entity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entity -> u
gmapQ :: (forall d. Data d => d -> u) -> Entity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Entity -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entity -> r
gmapT :: (forall b. Data b => b -> b) -> Entity -> Entity
$cgmapT :: (forall b. Data b => b -> b) -> Entity -> Entity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Entity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entity)
dataTypeOf :: Entity -> DataType
$cdataTypeOf :: Entity -> DataType
toConstr :: Entity -> Constr
$ctoConstr :: Entity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entity -> c Entity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entity -> c Entity
$cp1Data :: Typeable Entity
Data)

mkEntity :: EntityType -> IRI -> Entity
mkEntity :: EntityType -> IRI -> Entity
mkEntity = Maybe String -> EntityType -> IRI -> Entity
Entity Maybe String
forall a. Maybe a
Nothing

mkEntityLbl :: String -> EntityType -> IRI -> Entity
mkEntityLbl :: String -> EntityType -> IRI -> Entity
mkEntityLbl = Maybe String -> EntityType -> IRI -> Entity
Entity (Maybe String -> EntityType -> IRI -> Entity)
-> (String -> Maybe String)
-> String
-> EntityType
-> IRI
-> Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

instance Ord Entity where
  compare :: Entity -> Entity -> Ordering
compare (Entity _ ek1 :: EntityType
ek1 ir1 :: IRI
ir1) (Entity _ ek2 :: EntityType
ek2 ir2 :: IRI
ir2) = (EntityType, IRI) -> (EntityType, IRI) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (EntityType
ek1, IRI
ir1) (EntityType
ek2, IRI
ir2)

instance Eq Entity where
  e1 :: Entity
e1 == :: Entity -> Entity -> Bool
== e2 :: Entity
e2 = Entity -> Entity -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Entity
e1 Entity
e2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance GetRange Entity where
  getRange :: Entity -> Range
getRange = IRI -> Range
iriPos (IRI -> Range) -> (Entity -> IRI) -> Entity -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> IRI
cutIRI
  rangeSpan :: Entity -> [Pos]
rangeSpan = IRI -> [Pos]
iRIRange (IRI -> [Pos]) -> (Entity -> IRI) -> Entity -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> IRI
cutIRI

data EntityType =
    Datatype
  | Class
  | ObjectProperty
  | DataProperty
  | AnnotationProperty
  | NamedIndividual
    deriving (Int -> EntityType
EntityType -> Int
EntityType -> [EntityType]
EntityType -> EntityType
EntityType -> EntityType -> [EntityType]
EntityType -> EntityType -> EntityType -> [EntityType]
(EntityType -> EntityType)
-> (EntityType -> EntityType)
-> (Int -> EntityType)
-> (EntityType -> Int)
-> (EntityType -> [EntityType])
-> (EntityType -> EntityType -> [EntityType])
-> (EntityType -> EntityType -> [EntityType])
-> (EntityType -> EntityType -> EntityType -> [EntityType])
-> Enum EntityType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EntityType -> EntityType -> EntityType -> [EntityType]
$cenumFromThenTo :: EntityType -> EntityType -> EntityType -> [EntityType]
enumFromTo :: EntityType -> EntityType -> [EntityType]
$cenumFromTo :: EntityType -> EntityType -> [EntityType]
enumFromThen :: EntityType -> EntityType -> [EntityType]
$cenumFromThen :: EntityType -> EntityType -> [EntityType]
enumFrom :: EntityType -> [EntityType]
$cenumFrom :: EntityType -> [EntityType]
fromEnum :: EntityType -> Int
$cfromEnum :: EntityType -> Int
toEnum :: Int -> EntityType
$ctoEnum :: Int -> EntityType
pred :: EntityType -> EntityType
$cpred :: EntityType -> EntityType
succ :: EntityType -> EntityType
$csucc :: EntityType -> EntityType
Enum, EntityType
EntityType -> EntityType -> Bounded EntityType
forall a. a -> a -> Bounded a
maxBound :: EntityType
$cmaxBound :: EntityType
minBound :: EntityType
$cminBound :: EntityType
Bounded, Int -> EntityType -> String -> String
[EntityType] -> String -> String
EntityType -> String
(Int -> EntityType -> String -> String)
-> (EntityType -> String)
-> ([EntityType] -> String -> String)
-> Show EntityType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EntityType] -> String -> String
$cshowList :: [EntityType] -> String -> String
show :: EntityType -> String
$cshow :: EntityType -> String
showsPrec :: Int -> EntityType -> String -> String
$cshowsPrec :: Int -> EntityType -> String -> String
Show, ReadPrec [EntityType]
ReadPrec EntityType
Int -> ReadS EntityType
ReadS [EntityType]
(Int -> ReadS EntityType)
-> ReadS [EntityType]
-> ReadPrec EntityType
-> ReadPrec [EntityType]
-> Read EntityType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityType]
$creadListPrec :: ReadPrec [EntityType]
readPrec :: ReadPrec EntityType
$creadPrec :: ReadPrec EntityType
readList :: ReadS [EntityType]
$creadList :: ReadS [EntityType]
readsPrec :: Int -> ReadS EntityType
$creadsPrec :: Int -> ReadS EntityType
Read, EntityType -> EntityType -> Bool
(EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool) -> Eq EntityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityType -> EntityType -> Bool
$c/= :: EntityType -> EntityType -> Bool
== :: EntityType -> EntityType -> Bool
$c== :: EntityType -> EntityType -> Bool
Eq, Eq EntityType
Eq EntityType =>
(EntityType -> EntityType -> Ordering)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> EntityType)
-> (EntityType -> EntityType -> EntityType)
-> Ord EntityType
EntityType -> EntityType -> Bool
EntityType -> EntityType -> Ordering
EntityType -> EntityType -> EntityType
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 :: EntityType -> EntityType -> EntityType
$cmin :: EntityType -> EntityType -> EntityType
max :: EntityType -> EntityType -> EntityType
$cmax :: EntityType -> EntityType -> EntityType
>= :: EntityType -> EntityType -> Bool
$c>= :: EntityType -> EntityType -> Bool
> :: EntityType -> EntityType -> Bool
$c> :: EntityType -> EntityType -> Bool
<= :: EntityType -> EntityType -> Bool
$c<= :: EntityType -> EntityType -> Bool
< :: EntityType -> EntityType -> Bool
$c< :: EntityType -> EntityType -> Bool
compare :: EntityType -> EntityType -> Ordering
$ccompare :: EntityType -> EntityType -> Ordering
$cp1Ord :: Eq EntityType
Ord, Typeable, Typeable EntityType
Constr
DataType
Typeable EntityType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EntityType -> c EntityType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EntityType)
-> (EntityType -> Constr)
-> (EntityType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EntityType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EntityType))
-> ((forall b. Data b => b -> b) -> EntityType -> EntityType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EntityType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EntityType -> r)
-> (forall u. (forall d. Data d => d -> u) -> EntityType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EntityType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EntityType -> m EntityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntityType -> m EntityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntityType -> m EntityType)
-> Data EntityType
EntityType -> Constr
EntityType -> DataType
(forall b. Data b => b -> b) -> EntityType -> EntityType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityType -> c EntityType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EntityType -> u
forall u. (forall d. Data d => d -> u) -> EntityType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntityType -> m EntityType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityType -> m EntityType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityType -> c EntityType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntityType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntityType)
$cNamedIndividual :: Constr
$cAnnotationProperty :: Constr
$cDataProperty :: Constr
$cObjectProperty :: Constr
$cClass :: Constr
$cDatatype :: Constr
$tEntityType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> EntityType -> m EntityType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityType -> m EntityType
gmapMp :: (forall d. Data d => d -> m d) -> EntityType -> m EntityType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityType -> m EntityType
gmapM :: (forall d. Data d => d -> m d) -> EntityType -> m EntityType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntityType -> m EntityType
gmapQi :: Int -> (forall d. Data d => d -> u) -> EntityType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntityType -> u
gmapQ :: (forall d. Data d => d -> u) -> EntityType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EntityType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityType -> r
gmapT :: (forall b. Data b => b -> b) -> EntityType -> EntityType
$cgmapT :: (forall b. Data b => b -> b) -> EntityType -> EntityType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntityType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EntityType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EntityType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntityType)
dataTypeOf :: EntityType -> DataType
$cdataTypeOf :: EntityType -> DataType
toConstr :: EntityType -> Constr
$ctoConstr :: EntityType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityType -> c EntityType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityType -> c EntityType
$cp1Data :: Typeable EntityType
Data)

showEntityType :: EntityType -> String
showEntityType :: EntityType -> String
showEntityType e :: EntityType
e = case EntityType
e of
    Datatype -> String
datatypeC
    Class -> String
classC
    ObjectProperty -> String
objectPropertyC
    DataProperty -> String
dataPropertyC
    AnnotationProperty -> String
annotationPropertyC
    NamedIndividual -> String
individualC

entityTypes :: [EntityType]
entityTypes :: [EntityType]
entityTypes = [EntityType
forall a. Bounded a => a
minBound .. EntityType
forall a. Bounded a => a
maxBound]

pairSymbols :: Entity -> Entity -> Result Entity -- TODO: improve!
pairSymbols :: Entity -> Entity -> Result Entity
pairSymbols (Entity lb1 :: Maybe String
lb1 k1 :: EntityType
k1 i1 :: IRI
i1) (Entity lb2 :: Maybe String
lb2 k2 :: EntityType
k2 i2 :: IRI
i2) =
  if EntityType
k1 EntityType -> EntityType -> Bool
forall a. Eq a => a -> a -> Bool
/= EntityType
k2 then
    String -> Result Entity
forall a. HasCallStack => String -> a
error "can't pair symbols of different kind"
   else do
    let rest :: String -> String
rest x :: String
x = Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '#') String
x
        pairLables :: Maybe String -> Maybe String -> Maybe String
pairLables lbl1 :: Maybe String
lbl1 lbl2 :: Maybe String
lbl2 = case (Maybe String
lbl1, Maybe String
lbl2) of
            (Nothing, _) -> Maybe String -> Maybe String -> Maybe String
pairLables Maybe String
lbl2 Maybe String
lbl1
            (Just l1 :: String
l1, Just l2 :: String
l2) | String
l1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
l2 -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
l1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l2
            _ -> Maybe String
lbl1
        pairIRIs :: IRI -> IRI -> IRI
pairIRIs iri1 :: IRI
iri1 iri2 :: IRI
iri2 = IRI
nullIRI
          { prefixName :: String
prefixName = IRI -> String
prefixName IRI
iri1
          , iriPath :: Id
iriPath = if String -> String
rest (Id -> String
forall a. Show a => a -> String
show (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ IRI -> Id
iriPath IRI
iri1) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==
                            String -> String
rest (Id -> String
forall a. Show a => a -> String
show (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ IRI -> Id
iriPath IRI
iri2)
                          then IRI -> Id
iriPath IRI
iri1
                          else Id -> Id -> Id
appendId (IRI -> Id
iriPath IRI
iri1) (IRI -> Id
iriPath IRI
iri2)
          } -- TODO: improve, see #1597
    Entity -> Result Entity
forall (m :: * -> *) a. Monad m => a -> m a
return (Entity -> Result Entity) -> Entity -> Result Entity
forall a b. (a -> b) -> a -> b
$ Maybe String -> EntityType -> IRI -> Entity
Entity (Maybe String -> Maybe String -> Maybe String
pairLables Maybe String
lb1 Maybe String
lb2) EntityType
k1 (IRI -> Entity) -> IRI -> Entity
forall a b. (a -> b) -> a -> b
$ IRI -> IRI -> IRI
pairIRIs IRI
i1 IRI
i2

-- * LITERALS

data TypedOrUntyped = Typed Datatype | Untyped (Maybe LanguageTag)
    deriving (Int -> TypedOrUntyped -> String -> String
[TypedOrUntyped] -> String -> String
TypedOrUntyped -> String
(Int -> TypedOrUntyped -> String -> String)
-> (TypedOrUntyped -> String)
-> ([TypedOrUntyped] -> String -> String)
-> Show TypedOrUntyped
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TypedOrUntyped] -> String -> String
$cshowList :: [TypedOrUntyped] -> String -> String
show :: TypedOrUntyped -> String
$cshow :: TypedOrUntyped -> String
showsPrec :: Int -> TypedOrUntyped -> String -> String
$cshowsPrec :: Int -> TypedOrUntyped -> String -> String
Show, TypedOrUntyped -> TypedOrUntyped -> Bool
(TypedOrUntyped -> TypedOrUntyped -> Bool)
-> (TypedOrUntyped -> TypedOrUntyped -> Bool) -> Eq TypedOrUntyped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c/= :: TypedOrUntyped -> TypedOrUntyped -> Bool
== :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c== :: TypedOrUntyped -> TypedOrUntyped -> Bool
Eq, Eq TypedOrUntyped
Eq TypedOrUntyped =>
(TypedOrUntyped -> TypedOrUntyped -> Ordering)
-> (TypedOrUntyped -> TypedOrUntyped -> Bool)
-> (TypedOrUntyped -> TypedOrUntyped -> Bool)
-> (TypedOrUntyped -> TypedOrUntyped -> Bool)
-> (TypedOrUntyped -> TypedOrUntyped -> Bool)
-> (TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped)
-> (TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped)
-> Ord TypedOrUntyped
TypedOrUntyped -> TypedOrUntyped -> Bool
TypedOrUntyped -> TypedOrUntyped -> Ordering
TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped
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 :: TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped
$cmin :: TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped
max :: TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped
$cmax :: TypedOrUntyped -> TypedOrUntyped -> TypedOrUntyped
>= :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c>= :: TypedOrUntyped -> TypedOrUntyped -> Bool
> :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c> :: TypedOrUntyped -> TypedOrUntyped -> Bool
<= :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c<= :: TypedOrUntyped -> TypedOrUntyped -> Bool
< :: TypedOrUntyped -> TypedOrUntyped -> Bool
$c< :: TypedOrUntyped -> TypedOrUntyped -> Bool
compare :: TypedOrUntyped -> TypedOrUntyped -> Ordering
$ccompare :: TypedOrUntyped -> TypedOrUntyped -> Ordering
$cp1Ord :: Eq TypedOrUntyped
Ord, Typeable, Typeable TypedOrUntyped
Constr
DataType
Typeable TypedOrUntyped =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TypedOrUntyped -> c TypedOrUntyped)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypedOrUntyped)
-> (TypedOrUntyped -> Constr)
-> (TypedOrUntyped -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypedOrUntyped))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TypedOrUntyped))
-> ((forall b. Data b => b -> b)
    -> TypedOrUntyped -> TypedOrUntyped)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TypedOrUntyped -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypedOrUntyped -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TypedOrUntyped -> m TypedOrUntyped)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypedOrUntyped -> m TypedOrUntyped)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypedOrUntyped -> m TypedOrUntyped)
-> Data TypedOrUntyped
TypedOrUntyped -> Constr
TypedOrUntyped -> DataType
(forall b. Data b => b -> b) -> TypedOrUntyped -> TypedOrUntyped
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedOrUntyped -> c TypedOrUntyped
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedOrUntyped
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TypedOrUntyped -> u
forall u. (forall d. Data d => d -> u) -> TypedOrUntyped -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedOrUntyped
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedOrUntyped -> c TypedOrUntyped
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypedOrUntyped)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypedOrUntyped)
$cUntyped :: Constr
$cTyped :: Constr
$tTypedOrUntyped :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
gmapMp :: (forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
gmapM :: (forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypedOrUntyped -> m TypedOrUntyped
gmapQi :: Int -> (forall d. Data d => d -> u) -> TypedOrUntyped -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypedOrUntyped -> u
gmapQ :: (forall d. Data d => d -> u) -> TypedOrUntyped -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypedOrUntyped -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedOrUntyped -> r
gmapT :: (forall b. Data b => b -> b) -> TypedOrUntyped -> TypedOrUntyped
$cgmapT :: (forall b. Data b => b -> b) -> TypedOrUntyped -> TypedOrUntyped
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypedOrUntyped)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypedOrUntyped)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TypedOrUntyped)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypedOrUntyped)
dataTypeOf :: TypedOrUntyped -> DataType
$cdataTypeOf :: TypedOrUntyped -> DataType
toConstr :: TypedOrUntyped -> Constr
$ctoConstr :: TypedOrUntyped -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedOrUntyped
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedOrUntyped
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedOrUntyped -> c TypedOrUntyped
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedOrUntyped -> c TypedOrUntyped
$cp1Data :: Typeable TypedOrUntyped
Data)

data Literal = Literal LexicalForm TypedOrUntyped | NumberLit FloatLit
    deriving (Int -> Literal -> String -> String
[Literal] -> String -> String
Literal -> String
(Int -> Literal -> String -> String)
-> (Literal -> String)
-> ([Literal] -> String -> String)
-> Show Literal
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Literal] -> String -> String
$cshowList :: [Literal] -> String -> String
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> String -> String
$cshowsPrec :: Int -> Literal -> String -> String
Show, Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, Eq Literal
Eq Literal =>
(Literal -> Literal -> Ordering)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Literal)
-> (Literal -> Literal -> Literal)
-> Ord Literal
Literal -> Literal -> Bool
Literal -> Literal -> Ordering
Literal -> Literal -> Literal
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 :: Literal -> Literal -> Literal
$cmin :: Literal -> Literal -> Literal
max :: Literal -> Literal -> Literal
$cmax :: Literal -> Literal -> Literal
>= :: Literal -> Literal -> Bool
$c>= :: Literal -> Literal -> Bool
> :: Literal -> Literal -> Bool
$c> :: Literal -> Literal -> Bool
<= :: Literal -> Literal -> Bool
$c<= :: Literal -> Literal -> Bool
< :: Literal -> Literal -> Bool
$c< :: Literal -> Literal -> Bool
compare :: Literal -> Literal -> Ordering
$ccompare :: Literal -> Literal -> Ordering
$cp1Ord :: Eq Literal
Ord, Typeable, Typeable Literal
Constr
DataType
Typeable Literal =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Literal -> c Literal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Literal)
-> (Literal -> Constr)
-> (Literal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Literal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal))
-> ((forall b. Data b => b -> b) -> Literal -> Literal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Literal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> Data Literal
Literal -> Constr
Literal -> DataType
(forall b. Data b => b -> b) -> Literal -> Literal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
forall u. (forall d. Data d => d -> u) -> Literal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cNumberLit :: Constr
$cLiteral :: Constr
$tLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMp :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapM :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapQi :: Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataTypeOf :: Literal -> DataType
$cdataTypeOf :: Literal -> DataType
toConstr :: Literal -> Constr
$ctoConstr :: Literal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cp1Data :: Typeable Literal
Data)

-- | non-negative integers given by the sequence of digits
data NNInt = NNInt [Int] deriving (NNInt -> NNInt -> Bool
(NNInt -> NNInt -> Bool) -> (NNInt -> NNInt -> Bool) -> Eq NNInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NNInt -> NNInt -> Bool
$c/= :: NNInt -> NNInt -> Bool
== :: NNInt -> NNInt -> Bool
$c== :: NNInt -> NNInt -> Bool
Eq, Eq NNInt
Eq NNInt =>
(NNInt -> NNInt -> Ordering)
-> (NNInt -> NNInt -> Bool)
-> (NNInt -> NNInt -> Bool)
-> (NNInt -> NNInt -> Bool)
-> (NNInt -> NNInt -> Bool)
-> (NNInt -> NNInt -> NNInt)
-> (NNInt -> NNInt -> NNInt)
-> Ord NNInt
NNInt -> NNInt -> Bool
NNInt -> NNInt -> Ordering
NNInt -> NNInt -> NNInt
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 :: NNInt -> NNInt -> NNInt
$cmin :: NNInt -> NNInt -> NNInt
max :: NNInt -> NNInt -> NNInt
$cmax :: NNInt -> NNInt -> NNInt
>= :: NNInt -> NNInt -> Bool
$c>= :: NNInt -> NNInt -> Bool
> :: NNInt -> NNInt -> Bool
$c> :: NNInt -> NNInt -> Bool
<= :: NNInt -> NNInt -> Bool
$c<= :: NNInt -> NNInt -> Bool
< :: NNInt -> NNInt -> Bool
$c< :: NNInt -> NNInt -> Bool
compare :: NNInt -> NNInt -> Ordering
$ccompare :: NNInt -> NNInt -> Ordering
$cp1Ord :: Eq NNInt
Ord, Typeable, Typeable NNInt
Constr
DataType
Typeable NNInt =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NNInt -> c NNInt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NNInt)
-> (NNInt -> Constr)
-> (NNInt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NNInt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NNInt))
-> ((forall b. Data b => b -> b) -> NNInt -> NNInt)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r)
-> (forall u. (forall d. Data d => d -> u) -> NNInt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NNInt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NNInt -> m NNInt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NNInt -> m NNInt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NNInt -> m NNInt)
-> Data NNInt
NNInt -> Constr
NNInt -> DataType
(forall b. Data b => b -> b) -> NNInt -> NNInt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NNInt -> c NNInt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NNInt
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NNInt -> u
forall u. (forall d. Data d => d -> u) -> NNInt -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NNInt -> m NNInt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NNInt -> m NNInt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NNInt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NNInt -> c NNInt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NNInt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NNInt)
$cNNInt :: Constr
$tNNInt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NNInt -> m NNInt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NNInt -> m NNInt
gmapMp :: (forall d. Data d => d -> m d) -> NNInt -> m NNInt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NNInt -> m NNInt
gmapM :: (forall d. Data d => d -> m d) -> NNInt -> m NNInt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NNInt -> m NNInt
gmapQi :: Int -> (forall d. Data d => d -> u) -> NNInt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NNInt -> u
gmapQ :: (forall d. Data d => d -> u) -> NNInt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NNInt -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NNInt -> r
gmapT :: (forall b. Data b => b -> b) -> NNInt -> NNInt
$cgmapT :: (forall b. Data b => b -> b) -> NNInt -> NNInt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NNInt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NNInt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NNInt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NNInt)
dataTypeOf :: NNInt -> DataType
$cdataTypeOf :: NNInt -> DataType
toConstr :: NNInt -> Constr
$ctoConstr :: NNInt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NNInt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NNInt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NNInt -> c NNInt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NNInt -> c NNInt
$cp1Data :: Typeable NNInt
Data)

instance Show NNInt where
  show :: NNInt -> String
show (NNInt l :: [Int]
l) = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
l

zeroNNInt :: NNInt
zeroNNInt :: NNInt
zeroNNInt = [Int] -> NNInt
NNInt []

isZeroNNInt :: NNInt -> Bool
isZeroNNInt :: NNInt -> Bool
isZeroNNInt (NNInt l :: [Int]
l) = [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
l

data IntLit = IntLit
  { IntLit -> NNInt
absInt :: NNInt
  , IntLit -> Bool
isNegInt :: Bool }
  deriving (IntLit -> IntLit -> Bool
(IntLit -> IntLit -> Bool)
-> (IntLit -> IntLit -> Bool) -> Eq IntLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntLit -> IntLit -> Bool
$c/= :: IntLit -> IntLit -> Bool
== :: IntLit -> IntLit -> Bool
$c== :: IntLit -> IntLit -> Bool
Eq, Eq IntLit
Eq IntLit =>
(IntLit -> IntLit -> Ordering)
-> (IntLit -> IntLit -> Bool)
-> (IntLit -> IntLit -> Bool)
-> (IntLit -> IntLit -> Bool)
-> (IntLit -> IntLit -> Bool)
-> (IntLit -> IntLit -> IntLit)
-> (IntLit -> IntLit -> IntLit)
-> Ord IntLit
IntLit -> IntLit -> Bool
IntLit -> IntLit -> Ordering
IntLit -> IntLit -> IntLit
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 :: IntLit -> IntLit -> IntLit
$cmin :: IntLit -> IntLit -> IntLit
max :: IntLit -> IntLit -> IntLit
$cmax :: IntLit -> IntLit -> IntLit
>= :: IntLit -> IntLit -> Bool
$c>= :: IntLit -> IntLit -> Bool
> :: IntLit -> IntLit -> Bool
$c> :: IntLit -> IntLit -> Bool
<= :: IntLit -> IntLit -> Bool
$c<= :: IntLit -> IntLit -> Bool
< :: IntLit -> IntLit -> Bool
$c< :: IntLit -> IntLit -> Bool
compare :: IntLit -> IntLit -> Ordering
$ccompare :: IntLit -> IntLit -> Ordering
$cp1Ord :: Eq IntLit
Ord, Typeable, Typeable IntLit
Constr
DataType
Typeable IntLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IntLit -> c IntLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IntLit)
-> (IntLit -> Constr)
-> (IntLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IntLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IntLit))
-> ((forall b. Data b => b -> b) -> IntLit -> IntLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IntLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IntLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> IntLit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IntLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IntLit -> m IntLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntLit -> m IntLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntLit -> m IntLit)
-> Data IntLit
IntLit -> Constr
IntLit -> DataType
(forall b. Data b => b -> b) -> IntLit -> IntLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntLit -> c IntLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntLit
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IntLit -> u
forall u. (forall d. Data d => d -> u) -> IntLit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntLit -> m IntLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntLit -> m IntLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntLit -> c IntLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IntLit)
$cIntLit :: Constr
$tIntLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IntLit -> m IntLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntLit -> m IntLit
gmapMp :: (forall d. Data d => d -> m d) -> IntLit -> m IntLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntLit -> m IntLit
gmapM :: (forall d. Data d => d -> m d) -> IntLit -> m IntLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntLit -> m IntLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> IntLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IntLit -> u
gmapQ :: (forall d. Data d => d -> u) -> IntLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IntLit -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IntLit -> r
gmapT :: (forall b. Data b => b -> b) -> IntLit -> IntLit
$cgmapT :: (forall b. Data b => b -> b) -> IntLit -> IntLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IntLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IntLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IntLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntLit)
dataTypeOf :: IntLit -> DataType
$cdataTypeOf :: IntLit -> DataType
toConstr :: IntLit -> Constr
$ctoConstr :: IntLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntLit -> c IntLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntLit -> c IntLit
$cp1Data :: Typeable IntLit
Data)

instance Show IntLit where
  show :: IntLit -> String
show (IntLit n :: NNInt
n b :: Bool
b) = (if Bool
b then ('-' Char -> String -> String
forall a. a -> [a] -> [a]
:) else String -> String
forall a. a -> a
id) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NNInt -> String
forall a. Show a => a -> String
show NNInt
n

zeroInt :: IntLit
zeroInt :: IntLit
zeroInt = NNInt -> Bool -> IntLit
IntLit NNInt
zeroNNInt Bool
False

isZeroInt :: IntLit -> Bool
isZeroInt :: IntLit -> Bool
isZeroInt (IntLit n :: NNInt
n _) = NNInt -> Bool
isZeroNNInt NNInt
n

negNNInt :: Bool -> NNInt -> IntLit
negNNInt :: Bool -> NNInt -> IntLit
negNNInt b :: Bool
b n :: NNInt
n = NNInt -> Bool -> IntLit
IntLit NNInt
n Bool
b

negInt :: IntLit -> IntLit
negInt :: IntLit -> IntLit
negInt (IntLit n :: NNInt
n b :: Bool
b) = NNInt -> Bool -> IntLit
IntLit NNInt
n (Bool -> IntLit) -> Bool -> IntLit
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b

data DecLit = DecLit
  { DecLit -> IntLit
truncDec :: IntLit
  , DecLit -> NNInt
fracDec :: NNInt }
  deriving (DecLit -> DecLit -> Bool
(DecLit -> DecLit -> Bool)
-> (DecLit -> DecLit -> Bool) -> Eq DecLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecLit -> DecLit -> Bool
$c/= :: DecLit -> DecLit -> Bool
== :: DecLit -> DecLit -> Bool
$c== :: DecLit -> DecLit -> Bool
Eq, Eq DecLit
Eq DecLit =>
(DecLit -> DecLit -> Ordering)
-> (DecLit -> DecLit -> Bool)
-> (DecLit -> DecLit -> Bool)
-> (DecLit -> DecLit -> Bool)
-> (DecLit -> DecLit -> Bool)
-> (DecLit -> DecLit -> DecLit)
-> (DecLit -> DecLit -> DecLit)
-> Ord DecLit
DecLit -> DecLit -> Bool
DecLit -> DecLit -> Ordering
DecLit -> DecLit -> DecLit
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 :: DecLit -> DecLit -> DecLit
$cmin :: DecLit -> DecLit -> DecLit
max :: DecLit -> DecLit -> DecLit
$cmax :: DecLit -> DecLit -> DecLit
>= :: DecLit -> DecLit -> Bool
$c>= :: DecLit -> DecLit -> Bool
> :: DecLit -> DecLit -> Bool
$c> :: DecLit -> DecLit -> Bool
<= :: DecLit -> DecLit -> Bool
$c<= :: DecLit -> DecLit -> Bool
< :: DecLit -> DecLit -> Bool
$c< :: DecLit -> DecLit -> Bool
compare :: DecLit -> DecLit -> Ordering
$ccompare :: DecLit -> DecLit -> Ordering
$cp1Ord :: Eq DecLit
Ord, Typeable, Typeable DecLit
Constr
DataType
Typeable DecLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DecLit -> c DecLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DecLit)
-> (DecLit -> Constr)
-> (DecLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DecLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DecLit))
-> ((forall b. Data b => b -> b) -> DecLit -> DecLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DecLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DecLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> DecLit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DecLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DecLit -> m DecLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DecLit -> m DecLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DecLit -> m DecLit)
-> Data DecLit
DecLit -> Constr
DecLit -> DataType
(forall b. Data b => b -> b) -> DecLit -> DecLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecLit -> c DecLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecLit
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DecLit -> u
forall u. (forall d. Data d => d -> u) -> DecLit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DecLit -> m DecLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecLit -> m DecLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecLit -> c DecLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DecLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DecLit)
$cDecLit :: Constr
$tDecLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DecLit -> m DecLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecLit -> m DecLit
gmapMp :: (forall d. Data d => d -> m d) -> DecLit -> m DecLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecLit -> m DecLit
gmapM :: (forall d. Data d => d -> m d) -> DecLit -> m DecLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DecLit -> m DecLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> DecLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DecLit -> u
gmapQ :: (forall d. Data d => d -> u) -> DecLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DecLit -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DecLit -> r
gmapT :: (forall b. Data b => b -> b) -> DecLit -> DecLit
$cgmapT :: (forall b. Data b => b -> b) -> DecLit -> DecLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DecLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DecLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DecLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DecLit)
dataTypeOf :: DecLit -> DataType
$cdataTypeOf :: DecLit -> DataType
toConstr :: DecLit -> Constr
$ctoConstr :: DecLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecLit -> c DecLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecLit -> c DecLit
$cp1Data :: Typeable DecLit
Data)

instance Show DecLit where
  show :: DecLit -> String
show (DecLit t :: IntLit
t f :: NNInt
f) = IntLit -> String
forall a. Show a => a -> String
show IntLit
t
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ if NNInt -> Bool
isZeroNNInt NNInt
f then "" else
      '.' Char -> String -> String
forall a. a -> [a] -> [a]
: NNInt -> String
forall a. Show a => a -> String
show NNInt
f

isDecInt :: DecLit -> Bool
isDecInt :: DecLit -> Bool
isDecInt = NNInt -> Bool
isZeroNNInt (NNInt -> Bool) -> (DecLit -> NNInt) -> DecLit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecLit -> NNInt
fracDec

negDec :: Bool -> DecLit -> DecLit
negDec :: Bool -> DecLit -> DecLit
negDec b :: Bool
b (DecLit t :: IntLit
t f :: NNInt
f) = IntLit -> NNInt -> DecLit
DecLit (if Bool
b then IntLit -> IntLit
negInt IntLit
t else IntLit
t) NNInt
f

data FloatLit = FloatLit
  { FloatLit -> DecLit
floatBase :: DecLit
  , FloatLit -> IntLit
floatExp :: IntLit }
  deriving (FloatLit -> FloatLit -> Bool
(FloatLit -> FloatLit -> Bool)
-> (FloatLit -> FloatLit -> Bool) -> Eq FloatLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatLit -> FloatLit -> Bool
$c/= :: FloatLit -> FloatLit -> Bool
== :: FloatLit -> FloatLit -> Bool
$c== :: FloatLit -> FloatLit -> Bool
Eq, Eq FloatLit
Eq FloatLit =>
(FloatLit -> FloatLit -> Ordering)
-> (FloatLit -> FloatLit -> Bool)
-> (FloatLit -> FloatLit -> Bool)
-> (FloatLit -> FloatLit -> Bool)
-> (FloatLit -> FloatLit -> Bool)
-> (FloatLit -> FloatLit -> FloatLit)
-> (FloatLit -> FloatLit -> FloatLit)
-> Ord FloatLit
FloatLit -> FloatLit -> Bool
FloatLit -> FloatLit -> Ordering
FloatLit -> FloatLit -> FloatLit
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 :: FloatLit -> FloatLit -> FloatLit
$cmin :: FloatLit -> FloatLit -> FloatLit
max :: FloatLit -> FloatLit -> FloatLit
$cmax :: FloatLit -> FloatLit -> FloatLit
>= :: FloatLit -> FloatLit -> Bool
$c>= :: FloatLit -> FloatLit -> Bool
> :: FloatLit -> FloatLit -> Bool
$c> :: FloatLit -> FloatLit -> Bool
<= :: FloatLit -> FloatLit -> Bool
$c<= :: FloatLit -> FloatLit -> Bool
< :: FloatLit -> FloatLit -> Bool
$c< :: FloatLit -> FloatLit -> Bool
compare :: FloatLit -> FloatLit -> Ordering
$ccompare :: FloatLit -> FloatLit -> Ordering
$cp1Ord :: Eq FloatLit
Ord, Typeable, Typeable FloatLit
Constr
DataType
Typeable FloatLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FloatLit -> c FloatLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FloatLit)
-> (FloatLit -> Constr)
-> (FloatLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FloatLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FloatLit))
-> ((forall b. Data b => b -> b) -> FloatLit -> FloatLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FloatLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FloatLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> FloatLit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FloatLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit)
-> Data FloatLit
FloatLit -> Constr
FloatLit -> DataType
(forall b. Data b => b -> b) -> FloatLit -> FloatLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FloatLit -> c FloatLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FloatLit
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FloatLit -> u
forall u. (forall d. Data d => d -> u) -> FloatLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FloatLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FloatLit -> c FloatLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FloatLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FloatLit)
$cFloatLit :: Constr
$tFloatLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
gmapMp :: (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
gmapM :: (forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FloatLit -> m FloatLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> FloatLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FloatLit -> u
gmapQ :: (forall d. Data d => d -> u) -> FloatLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FloatLit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FloatLit -> r
gmapT :: (forall b. Data b => b -> b) -> FloatLit -> FloatLit
$cgmapT :: (forall b. Data b => b -> b) -> FloatLit -> FloatLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FloatLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FloatLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FloatLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FloatLit)
dataTypeOf :: FloatLit -> DataType
$cdataTypeOf :: FloatLit -> DataType
toConstr :: FloatLit -> Constr
$ctoConstr :: FloatLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FloatLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FloatLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FloatLit -> c FloatLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FloatLit -> c FloatLit
$cp1Data :: Typeable FloatLit
Data)

instance Show FloatLit where
  show :: FloatLit -> String
show (FloatLit b :: DecLit
b e :: IntLit
e) = DecLit -> String
forall a. Show a => a -> String
show DecLit
b
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ if IntLit -> Bool
isZeroInt IntLit
e then "" else
      'E' Char -> String -> String
forall a. a -> [a] -> [a]
: IntLit -> String
forall a. Show a => a -> String
show IntLit
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ "F"

isFloatDec :: FloatLit -> Bool
isFloatDec :: FloatLit -> Bool
isFloatDec = IntLit -> Bool
isZeroInt (IntLit -> Bool) -> (FloatLit -> IntLit) -> FloatLit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatLit -> IntLit
floatExp

isFloatInt :: FloatLit -> Bool
isFloatInt :: FloatLit -> Bool
isFloatInt f :: FloatLit
f = FloatLit -> Bool
isFloatDec FloatLit
f Bool -> Bool -> Bool
&& DecLit -> Bool
isDecInt (FloatLit -> DecLit
floatBase FloatLit
f)

floatToInt :: FloatLit -> IntLit
floatToInt :: FloatLit -> IntLit
floatToInt = DecLit -> IntLit
truncDec (DecLit -> IntLit) -> (FloatLit -> DecLit) -> FloatLit -> IntLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatLit -> DecLit
floatBase

intToDec :: IntLit -> DecLit
intToDec :: IntLit -> DecLit
intToDec i :: IntLit
i = IntLit -> NNInt -> DecLit
DecLit IntLit
i NNInt
zeroNNInt

decToFloat :: DecLit -> FloatLit
decToFloat :: DecLit -> FloatLit
decToFloat d :: DecLit
d = DecLit -> IntLit -> FloatLit
FloatLit DecLit
d IntLit
zeroInt

intToFloat :: IntLit -> FloatLit
intToFloat :: IntLit -> FloatLit
intToFloat = DecLit -> FloatLit
decToFloat (DecLit -> FloatLit) -> (IntLit -> DecLit) -> IntLit -> FloatLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLit -> DecLit
intToDec

abInt :: IntLit -> IntLit
abInt :: IntLit -> IntLit
abInt int :: IntLit
int = IntLit
int {isNegInt :: Bool
isNegInt = Bool
False}

abDec :: DecLit -> DecLit
abDec :: DecLit -> DecLit
abDec dec :: DecLit
dec = DecLit
dec {truncDec :: IntLit
truncDec = IntLit -> IntLit
abInt (IntLit -> IntLit) -> IntLit -> IntLit
forall a b. (a -> b) -> a -> b
$ DecLit -> IntLit
truncDec DecLit
dec}

abFloat :: FloatLit -> FloatLit
abFloat :: FloatLit -> FloatLit
abFloat f :: FloatLit
f = FloatLit
f {floatBase :: DecLit
floatBase = DecLit -> DecLit
abDec (DecLit -> DecLit) -> DecLit -> DecLit
forall a b. (a -> b) -> a -> b
$ FloatLit -> DecLit
floatBase FloatLit
f}

isNegDec :: DecLit -> Bool
isNegDec :: DecLit -> Bool
isNegDec d :: DecLit
d = IntLit -> Bool
isNegInt (IntLit -> Bool) -> IntLit -> Bool
forall a b. (a -> b) -> a -> b
$ DecLit -> IntLit
truncDec DecLit
d

numberName :: FloatLit -> String
numberName :: FloatLit -> String
numberName f :: FloatLit
f
    | FloatLit -> Bool
isFloatInt FloatLit
f = String
integerS
    | FloatLit -> Bool
isFloatDec FloatLit
f = String
decimalS
    | Bool
otherwise = String
floatS

litType :: Literal -> Maybe IRI
litType :: Literal -> Maybe IRI
litType l :: Literal
l = case Literal
l of
  Literal _ (Typed t :: IRI
t) -> IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
t
  NumberLit f :: FloatLit
f -> IRI -> Maybe IRI
forall a. a -> Maybe a
Just (IRI -> Maybe IRI) -> (FloatLit -> IRI) -> FloatLit -> Maybe IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixMap -> IRI -> IRI
expandIRI' PrefixMap
predefPrefixes (IRI -> IRI) -> (FloatLit -> IRI) -> FloatLit -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IRI -> IRI
setPrefix "xsd" (IRI -> IRI) -> (FloatLit -> IRI) -> FloatLit -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IRI
mkIRI (String -> IRI) -> (FloatLit -> String) -> FloatLit -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatLit -> String
numberName (FloatLit -> Maybe IRI) -> FloatLit -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ FloatLit
f
  _ -> Maybe IRI
forall a. Maybe a
Nothing

cTypeS :: String
cTypeS :: String
cTypeS = "^^"

-- * PROPERTY EXPRESSIONS

type InverseObjectProperty = ObjectPropertyExpression

data ObjectPropertyExpression = ObjectProp ObjectProperty
  | ObjectInverseOf InverseObjectProperty
        deriving (Int -> ObjectPropertyExpression -> String -> String
[ObjectPropertyExpression] -> String -> String
ObjectPropertyExpression -> String
(Int -> ObjectPropertyExpression -> String -> String)
-> (ObjectPropertyExpression -> String)
-> ([ObjectPropertyExpression] -> String -> String)
-> Show ObjectPropertyExpression
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ObjectPropertyExpression] -> String -> String
$cshowList :: [ObjectPropertyExpression] -> String -> String
show :: ObjectPropertyExpression -> String
$cshow :: ObjectPropertyExpression -> String
showsPrec :: Int -> ObjectPropertyExpression -> String -> String
$cshowsPrec :: Int -> ObjectPropertyExpression -> String -> String
Show, ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
(ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> (ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> Eq ObjectPropertyExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c/= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
== :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c== :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
Eq, Eq ObjectPropertyExpression
Eq ObjectPropertyExpression =>
(ObjectPropertyExpression -> ObjectPropertyExpression -> Ordering)
-> (ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> (ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> (ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> (ObjectPropertyExpression -> ObjectPropertyExpression -> Bool)
-> (ObjectPropertyExpression
    -> ObjectPropertyExpression -> ObjectPropertyExpression)
-> (ObjectPropertyExpression
    -> ObjectPropertyExpression -> ObjectPropertyExpression)
-> Ord ObjectPropertyExpression
ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
ObjectPropertyExpression -> ObjectPropertyExpression -> Ordering
ObjectPropertyExpression
-> ObjectPropertyExpression -> ObjectPropertyExpression
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 :: ObjectPropertyExpression
-> ObjectPropertyExpression -> ObjectPropertyExpression
$cmin :: ObjectPropertyExpression
-> ObjectPropertyExpression -> ObjectPropertyExpression
max :: ObjectPropertyExpression
-> ObjectPropertyExpression -> ObjectPropertyExpression
$cmax :: ObjectPropertyExpression
-> ObjectPropertyExpression -> ObjectPropertyExpression
>= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c>= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
> :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c> :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
<= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c<= :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
< :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
$c< :: ObjectPropertyExpression -> ObjectPropertyExpression -> Bool
compare :: ObjectPropertyExpression -> ObjectPropertyExpression -> Ordering
$ccompare :: ObjectPropertyExpression -> ObjectPropertyExpression -> Ordering
$cp1Ord :: Eq ObjectPropertyExpression
Ord, Typeable, Typeable ObjectPropertyExpression
Constr
DataType
Typeable ObjectPropertyExpression =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ObjectPropertyExpression
 -> c ObjectPropertyExpression)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjectPropertyExpression)
-> (ObjectPropertyExpression -> Constr)
-> (ObjectPropertyExpression -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ObjectPropertyExpression))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ObjectPropertyExpression))
-> ((forall b. Data b => b -> b)
    -> ObjectPropertyExpression -> ObjectPropertyExpression)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ObjectPropertyExpression
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ObjectPropertyExpression
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ObjectPropertyExpression -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ObjectPropertyExpression -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyExpression -> m ObjectPropertyExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyExpression -> m ObjectPropertyExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyExpression -> m ObjectPropertyExpression)
-> Data ObjectPropertyExpression
ObjectPropertyExpression -> Constr
ObjectPropertyExpression -> DataType
(forall b. Data b => b -> b)
-> ObjectPropertyExpression -> ObjectPropertyExpression
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyExpression
-> c ObjectPropertyExpression
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyExpression
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ObjectPropertyExpression -> u
forall u.
(forall d. Data d => d -> u) -> ObjectPropertyExpression -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyExpression
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyExpression
-> c ObjectPropertyExpression
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyExpression)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyExpression)
$cObjectInverseOf :: Constr
$cObjectProp :: Constr
$tObjectPropertyExpression :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
gmapMp :: (forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
gmapM :: (forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyExpression -> m ObjectPropertyExpression
gmapQi :: Int
-> (forall d. Data d => d -> u) -> ObjectPropertyExpression -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ObjectPropertyExpression -> u
gmapQ :: (forall d. Data d => d -> u) -> ObjectPropertyExpression -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ObjectPropertyExpression -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ObjectPropertyExpression
-> r
gmapT :: (forall b. Data b => b -> b)
-> ObjectPropertyExpression -> ObjectPropertyExpression
$cgmapT :: (forall b. Data b => b -> b)
-> ObjectPropertyExpression -> ObjectPropertyExpression
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyExpression)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyExpression)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyExpression)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyExpression)
dataTypeOf :: ObjectPropertyExpression -> DataType
$cdataTypeOf :: ObjectPropertyExpression -> DataType
toConstr :: ObjectPropertyExpression -> Constr
$ctoConstr :: ObjectPropertyExpression -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyExpression
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyExpression
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyExpression
-> c ObjectPropertyExpression
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyExpression
-> c ObjectPropertyExpression
$cp1Data :: Typeable ObjectPropertyExpression
Data)

isObjectProperty :: ObjectPropertyExpression -> Bool
isObjectProperty :: ObjectPropertyExpression -> Bool
isObjectProperty (ObjectProp _) = Bool
True
isObjectProperty _ = Bool
False

objPropToIRI :: ObjectPropertyExpression -> IRI
objPropToIRI :: ObjectPropertyExpression -> IRI
objPropToIRI opExp :: ObjectPropertyExpression
opExp = case ObjectPropertyExpression
opExp of
    ObjectProp u :: IRI
u -> IRI
u
    ObjectInverseOf objProp :: ObjectPropertyExpression
objProp -> ObjectPropertyExpression -> IRI
objPropToIRI ObjectPropertyExpression
objProp

inverseOf :: ObjectPropertyExpression -> ObjectPropertyExpression
inverseOf :: ObjectPropertyExpression -> ObjectPropertyExpression
inverseOf ope :: ObjectPropertyExpression
ope = case ObjectPropertyExpression
ope of
  ObjectProp _ -> ObjectPropertyExpression -> ObjectPropertyExpression
ObjectInverseOf ObjectPropertyExpression
ope
  ObjectInverseOf ope' :: ObjectPropertyExpression
ope' -> ObjectPropertyExpression
ope'

type DataPropertyExpression = DataProperty

-- * DATA RANGES

data DataRange =
    DataType Datatype [(ConstrainingFacet, RestrictionValue)]
  | DataJunction JunctionType [DataRange]
  | DataComplementOf DataRange
  | DataOneOf [Literal]
    deriving (Int -> DataRange -> String -> String
[DataRange] -> String -> String
DataRange -> String
(Int -> DataRange -> String -> String)
-> (DataRange -> String)
-> ([DataRange] -> String -> String)
-> Show DataRange
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DataRange] -> String -> String
$cshowList :: [DataRange] -> String -> String
show :: DataRange -> String
$cshow :: DataRange -> String
showsPrec :: Int -> DataRange -> String -> String
$cshowsPrec :: Int -> DataRange -> String -> String
Show, DataRange -> DataRange -> Bool
(DataRange -> DataRange -> Bool)
-> (DataRange -> DataRange -> Bool) -> Eq DataRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataRange -> DataRange -> Bool
$c/= :: DataRange -> DataRange -> Bool
== :: DataRange -> DataRange -> Bool
$c== :: DataRange -> DataRange -> Bool
Eq, Eq DataRange
Eq DataRange =>
(DataRange -> DataRange -> Ordering)
-> (DataRange -> DataRange -> Bool)
-> (DataRange -> DataRange -> Bool)
-> (DataRange -> DataRange -> Bool)
-> (DataRange -> DataRange -> Bool)
-> (DataRange -> DataRange -> DataRange)
-> (DataRange -> DataRange -> DataRange)
-> Ord DataRange
DataRange -> DataRange -> Bool
DataRange -> DataRange -> Ordering
DataRange -> DataRange -> DataRange
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 :: DataRange -> DataRange -> DataRange
$cmin :: DataRange -> DataRange -> DataRange
max :: DataRange -> DataRange -> DataRange
$cmax :: DataRange -> DataRange -> DataRange
>= :: DataRange -> DataRange -> Bool
$c>= :: DataRange -> DataRange -> Bool
> :: DataRange -> DataRange -> Bool
$c> :: DataRange -> DataRange -> Bool
<= :: DataRange -> DataRange -> Bool
$c<= :: DataRange -> DataRange -> Bool
< :: DataRange -> DataRange -> Bool
$c< :: DataRange -> DataRange -> Bool
compare :: DataRange -> DataRange -> Ordering
$ccompare :: DataRange -> DataRange -> Ordering
$cp1Ord :: Eq DataRange
Ord, Typeable, Typeable DataRange
Constr
DataType
Typeable DataRange =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DataRange -> c DataRange)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DataRange)
-> (DataRange -> Constr)
-> (DataRange -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DataRange))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataRange))
-> ((forall b. Data b => b -> b) -> DataRange -> DataRange)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DataRange -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DataRange -> r)
-> (forall u. (forall d. Data d => d -> u) -> DataRange -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DataRange -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DataRange -> m DataRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataRange -> m DataRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataRange -> m DataRange)
-> Data DataRange
DataRange -> Constr
DataRange -> DataType
(forall b. Data b => b -> b) -> DataRange -> DataRange
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataRange -> c DataRange
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataRange
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DataRange -> u
forall u. (forall d. Data d => d -> u) -> DataRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataRange -> m DataRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataRange -> m DataRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataRange -> c DataRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataRange)
$cDataOneOf :: Constr
$cDataComplementOf :: Constr
$cDataJunction :: Constr
$cDataType :: Constr
$tDataRange :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DataRange -> m DataRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataRange -> m DataRange
gmapMp :: (forall d. Data d => d -> m d) -> DataRange -> m DataRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataRange -> m DataRange
gmapM :: (forall d. Data d => d -> m d) -> DataRange -> m DataRange
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataRange -> m DataRange
gmapQi :: Int -> (forall d. Data d => d -> u) -> DataRange -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataRange -> u
gmapQ :: (forall d. Data d => d -> u) -> DataRange -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataRange -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataRange -> r
gmapT :: (forall b. Data b => b -> b) -> DataRange -> DataRange
$cgmapT :: (forall b. Data b => b -> b) -> DataRange -> DataRange
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataRange)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DataRange)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataRange)
dataTypeOf :: DataRange -> DataType
$cdataTypeOf :: DataRange -> DataType
toConstr :: DataRange -> Constr
$ctoConstr :: DataRange -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataRange
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataRange -> c DataRange
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataRange -> c DataRange
$cp1Data :: Typeable DataRange
Data)

-- | Extracts all Datatypes used in a Datarange.
basedOn :: DataRange -> [Datatype]
basedOn :: DataRange -> [IRI]
basedOn dr :: DataRange
dr = case DataRange
dr of
  DataType dt :: IRI
dt fs :: [(IRI, Literal)]
fs -> IRI
dt IRI -> [IRI] -> [IRI]
forall a. a -> [a] -> [a]
: ((IRI, Literal) -> [IRI]) -> [(IRI, Literal)] -> [IRI]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(f :: IRI
f, l :: Literal
l) -> IRI
f IRI -> [IRI] -> [IRI]
forall a. a -> [a] -> [a]
: Maybe IRI -> [IRI]
forall a. Maybe a -> [a]
maybeToList (Literal -> Maybe IRI
litType Literal
l)) [(IRI, Literal)]
fs
  DataJunction _ drs :: [DataRange]
drs -> (DataRange -> [IRI]) -> [DataRange] -> [IRI]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataRange -> [IRI]
basedOn [DataRange]
drs
  DataComplementOf dr' :: DataRange
dr' -> DataRange -> [IRI]
basedOn DataRange
dr'
  DataOneOf ls :: [Literal]
ls -> (Literal -> [IRI]) -> [Literal] -> [IRI]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe IRI -> [IRI]
forall a. Maybe a -> [a]
maybeToList (Maybe IRI -> [IRI]) -> (Literal -> Maybe IRI) -> Literal -> [IRI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Maybe IRI
litType) [Literal]
ls


-- * CLASS EXPERSSIONS

data ClassExpression =
    Expression Class
  | ObjectJunction JunctionType [ClassExpression]
  | ObjectComplementOf ClassExpression
  | ObjectOneOf [Individual]
  | ObjectValuesFrom QuantifierType ObjectPropertyExpression ClassExpression
  | ObjectHasValue ObjectPropertyExpression Individual
  | ObjectHasSelf ObjectPropertyExpression
  | ObjectCardinality (Cardinality ObjectPropertyExpression ClassExpression)
  | DataValuesFrom QuantifierType [DataPropertyExpression] DataRange
  | DataHasValue DataPropertyExpression Literal
  | DataCardinality (Cardinality DataPropertyExpression DataRange)
    deriving (Int -> ClassExpression -> String -> String
[ClassExpression] -> String -> String
ClassExpression -> String
(Int -> ClassExpression -> String -> String)
-> (ClassExpression -> String)
-> ([ClassExpression] -> String -> String)
-> Show ClassExpression
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ClassExpression] -> String -> String
$cshowList :: [ClassExpression] -> String -> String
show :: ClassExpression -> String
$cshow :: ClassExpression -> String
showsPrec :: Int -> ClassExpression -> String -> String
$cshowsPrec :: Int -> ClassExpression -> String -> String
Show, ClassExpression -> ClassExpression -> Bool
(ClassExpression -> ClassExpression -> Bool)
-> (ClassExpression -> ClassExpression -> Bool)
-> Eq ClassExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassExpression -> ClassExpression -> Bool
$c/= :: ClassExpression -> ClassExpression -> Bool
== :: ClassExpression -> ClassExpression -> Bool
$c== :: ClassExpression -> ClassExpression -> Bool
Eq, Eq ClassExpression
Eq ClassExpression =>
(ClassExpression -> ClassExpression -> Ordering)
-> (ClassExpression -> ClassExpression -> Bool)
-> (ClassExpression -> ClassExpression -> Bool)
-> (ClassExpression -> ClassExpression -> Bool)
-> (ClassExpression -> ClassExpression -> Bool)
-> (ClassExpression -> ClassExpression -> ClassExpression)
-> (ClassExpression -> ClassExpression -> ClassExpression)
-> Ord ClassExpression
ClassExpression -> ClassExpression -> Bool
ClassExpression -> ClassExpression -> Ordering
ClassExpression -> ClassExpression -> ClassExpression
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 :: ClassExpression -> ClassExpression -> ClassExpression
$cmin :: ClassExpression -> ClassExpression -> ClassExpression
max :: ClassExpression -> ClassExpression -> ClassExpression
$cmax :: ClassExpression -> ClassExpression -> ClassExpression
>= :: ClassExpression -> ClassExpression -> Bool
$c>= :: ClassExpression -> ClassExpression -> Bool
> :: ClassExpression -> ClassExpression -> Bool
$c> :: ClassExpression -> ClassExpression -> Bool
<= :: ClassExpression -> ClassExpression -> Bool
$c<= :: ClassExpression -> ClassExpression -> Bool
< :: ClassExpression -> ClassExpression -> Bool
$c< :: ClassExpression -> ClassExpression -> Bool
compare :: ClassExpression -> ClassExpression -> Ordering
$ccompare :: ClassExpression -> ClassExpression -> Ordering
$cp1Ord :: Eq ClassExpression
Ord, Typeable, Typeable ClassExpression
Constr
DataType
Typeable ClassExpression =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ClassExpression -> c ClassExpression)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ClassExpression)
-> (ClassExpression -> Constr)
-> (ClassExpression -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ClassExpression))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ClassExpression))
-> ((forall b. Data b => b -> b)
    -> ClassExpression -> ClassExpression)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ClassExpression -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ClassExpression -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ClassExpression -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ClassExpression -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ClassExpression -> m ClassExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ClassExpression -> m ClassExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ClassExpression -> m ClassExpression)
-> Data ClassExpression
ClassExpression -> Constr
ClassExpression -> DataType
(forall b. Data b => b -> b) -> ClassExpression -> ClassExpression
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassExpression -> c ClassExpression
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassExpression
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ClassExpression -> u
forall u. (forall d. Data d => d -> u) -> ClassExpression -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassExpression
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassExpression -> c ClassExpression
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClassExpression)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ClassExpression)
$cDataCardinality :: Constr
$cDataHasValue :: Constr
$cDataValuesFrom :: Constr
$cObjectCardinality :: Constr
$cObjectHasSelf :: Constr
$cObjectHasValue :: Constr
$cObjectValuesFrom :: Constr
$cObjectOneOf :: Constr
$cObjectComplementOf :: Constr
$cObjectJunction :: Constr
$cExpression :: Constr
$tClassExpression :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
gmapMp :: (forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
gmapM :: (forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ClassExpression -> m ClassExpression
gmapQi :: Int -> (forall d. Data d => d -> u) -> ClassExpression -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ClassExpression -> u
gmapQ :: (forall d. Data d => d -> u) -> ClassExpression -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ClassExpression -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassExpression -> r
gmapT :: (forall b. Data b => b -> b) -> ClassExpression -> ClassExpression
$cgmapT :: (forall b. Data b => b -> b) -> ClassExpression -> ClassExpression
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ClassExpression)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ClassExpression)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ClassExpression)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClassExpression)
dataTypeOf :: ClassExpression -> DataType
$cdataTypeOf :: ClassExpression -> DataType
toConstr :: ClassExpression -> Constr
$ctoConstr :: ClassExpression -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassExpression
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassExpression
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassExpression -> c ClassExpression
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassExpression -> c ClassExpression
$cp1Data :: Typeable ClassExpression
Data)

-- * ANNOTATIONS

data Annotation = Annotation {
      Annotation -> AxiomAnnotations
annAnnotations :: [Annotation]
    , Annotation -> IRI
annProperty :: AnnotationProperty
    , Annotation -> AnnotationValue
annValue :: AnnotationValue
  }
    deriving (Int -> Annotation -> String -> String
AxiomAnnotations -> String -> String
Annotation -> String
(Int -> Annotation -> String -> String)
-> (Annotation -> String)
-> (AxiomAnnotations -> String -> String)
-> Show Annotation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: AxiomAnnotations -> String -> String
$cshowList :: AxiomAnnotations -> String -> String
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> String -> String
$cshowsPrec :: Int -> Annotation -> String -> String
Show, Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Eq Annotation
Eq Annotation =>
(Annotation -> Annotation -> Ordering)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Annotation)
-> (Annotation -> Annotation -> Annotation)
-> Ord Annotation
Annotation -> Annotation -> Bool
Annotation -> Annotation -> Ordering
Annotation -> Annotation -> Annotation
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 :: Annotation -> Annotation -> Annotation
$cmin :: Annotation -> Annotation -> Annotation
max :: Annotation -> Annotation -> Annotation
$cmax :: Annotation -> Annotation -> Annotation
>= :: Annotation -> Annotation -> Bool
$c>= :: Annotation -> Annotation -> Bool
> :: Annotation -> Annotation -> Bool
$c> :: Annotation -> Annotation -> Bool
<= :: Annotation -> Annotation -> Bool
$c<= :: Annotation -> Annotation -> Bool
< :: Annotation -> Annotation -> Bool
$c< :: Annotation -> Annotation -> Bool
compare :: Annotation -> Annotation -> Ordering
$ccompare :: Annotation -> Annotation -> Ordering
$cp1Ord :: Eq Annotation
Ord, Typeable, Typeable Annotation
Constr
DataType
Typeable Annotation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Annotation -> c Annotation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Annotation)
-> (Annotation -> Constr)
-> (Annotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Annotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Annotation))
-> ((forall b. Data b => b -> b) -> Annotation -> Annotation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Annotation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Annotation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> Data Annotation
Annotation -> Constr
Annotation -> DataType
(forall b. Data b => b -> b) -> Annotation -> Annotation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cAnnotation :: Constr
$tAnnotation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapMp :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapM :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Annotation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
gmapQ :: (forall d. Data d => d -> u) -> Annotation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
$cgmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Annotation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
dataTypeOf :: Annotation -> DataType
$cdataTypeOf :: Annotation -> DataType
toConstr :: Annotation -> Constr
$ctoConstr :: Annotation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
$cp1Data :: Typeable Annotation
Data)

type OntologyAnnotations = [Annotation]


data AnnotationValue =
    AnnAnInd AnonymousIndividual
  | AnnValue IRI
  | AnnValLit Literal
    deriving (Int -> AnnotationValue -> String -> String
[AnnotationValue] -> String -> String
AnnotationValue -> String
(Int -> AnnotationValue -> String -> String)
-> (AnnotationValue -> String)
-> ([AnnotationValue] -> String -> String)
-> Show AnnotationValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AnnotationValue] -> String -> String
$cshowList :: [AnnotationValue] -> String -> String
show :: AnnotationValue -> String
$cshow :: AnnotationValue -> String
showsPrec :: Int -> AnnotationValue -> String -> String
$cshowsPrec :: Int -> AnnotationValue -> String -> String
Show, AnnotationValue -> AnnotationValue -> Bool
(AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> Eq AnnotationValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationValue -> AnnotationValue -> Bool
$c/= :: AnnotationValue -> AnnotationValue -> Bool
== :: AnnotationValue -> AnnotationValue -> Bool
$c== :: AnnotationValue -> AnnotationValue -> Bool
Eq, Eq AnnotationValue
Eq AnnotationValue =>
(AnnotationValue -> AnnotationValue -> Ordering)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> Bool)
-> (AnnotationValue -> AnnotationValue -> AnnotationValue)
-> (AnnotationValue -> AnnotationValue -> AnnotationValue)
-> Ord AnnotationValue
AnnotationValue -> AnnotationValue -> Bool
AnnotationValue -> AnnotationValue -> Ordering
AnnotationValue -> AnnotationValue -> AnnotationValue
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 :: AnnotationValue -> AnnotationValue -> AnnotationValue
$cmin :: AnnotationValue -> AnnotationValue -> AnnotationValue
max :: AnnotationValue -> AnnotationValue -> AnnotationValue
$cmax :: AnnotationValue -> AnnotationValue -> AnnotationValue
>= :: AnnotationValue -> AnnotationValue -> Bool
$c>= :: AnnotationValue -> AnnotationValue -> Bool
> :: AnnotationValue -> AnnotationValue -> Bool
$c> :: AnnotationValue -> AnnotationValue -> Bool
<= :: AnnotationValue -> AnnotationValue -> Bool
$c<= :: AnnotationValue -> AnnotationValue -> Bool
< :: AnnotationValue -> AnnotationValue -> Bool
$c< :: AnnotationValue -> AnnotationValue -> Bool
compare :: AnnotationValue -> AnnotationValue -> Ordering
$ccompare :: AnnotationValue -> AnnotationValue -> Ordering
$cp1Ord :: Eq AnnotationValue
Ord, Typeable, Typeable AnnotationValue
Constr
DataType
Typeable AnnotationValue =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AnnotationValue -> c AnnotationValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnotationValue)
-> (AnnotationValue -> Constr)
-> (AnnotationValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnotationValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AnnotationValue))
-> ((forall b. Data b => b -> b)
    -> AnnotationValue -> AnnotationValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AnnotationValue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AnnotationValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AnnotationValue -> m AnnotationValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationValue -> m AnnotationValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationValue -> m AnnotationValue)
-> Data AnnotationValue
AnnotationValue -> Constr
AnnotationValue -> DataType
(forall b. Data b => b -> b) -> AnnotationValue -> AnnotationValue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationValue -> c AnnotationValue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationValue
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationValue -> u
forall u. (forall d. Data d => d -> u) -> AnnotationValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationValue -> c AnnotationValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationValue)
$cAnnValLit :: Constr
$cAnnValue :: Constr
$cAnnAnInd :: Constr
$tAnnotationValue :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
gmapMp :: (forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
gmapM :: (forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationValue -> m AnnotationValue
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnotationValue -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationValue -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnotationValue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnotationValue -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationValue -> r
gmapT :: (forall b. Data b => b -> b) -> AnnotationValue -> AnnotationValue
$cgmapT :: (forall b. Data b => b -> b) -> AnnotationValue -> AnnotationValue
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationValue)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnotationValue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationValue)
dataTypeOf :: AnnotationValue -> DataType
$cdataTypeOf :: AnnotationValue -> DataType
toConstr :: AnnotationValue -> Constr
$ctoConstr :: AnnotationValue -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationValue
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationValue -> c AnnotationValue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationValue -> c AnnotationValue
$cp1Data :: Typeable AnnotationValue
Data)

data AnnotationAxiom =
    AnnotationAssertion
      AxiomAnnotations
      AnnotationProperty
      AnnotationSubject
      AnnotationValue
  | SubAnnotationPropertyOf
    AxiomAnnotations
    SubAnnotationProperty
    SuperAnnotationProperty
  | AnnotationPropertyDomain AxiomAnnotations AnnotationProperty IRI
  | AnnotationPropertyRange AxiomAnnotations AnnotationProperty IRI
    deriving (Int -> AnnotationAxiom -> String -> String
[AnnotationAxiom] -> String -> String
AnnotationAxiom -> String
(Int -> AnnotationAxiom -> String -> String)
-> (AnnotationAxiom -> String)
-> ([AnnotationAxiom] -> String -> String)
-> Show AnnotationAxiom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AnnotationAxiom] -> String -> String
$cshowList :: [AnnotationAxiom] -> String -> String
show :: AnnotationAxiom -> String
$cshow :: AnnotationAxiom -> String
showsPrec :: Int -> AnnotationAxiom -> String -> String
$cshowsPrec :: Int -> AnnotationAxiom -> String -> String
Show, AnnotationAxiom -> AnnotationAxiom -> Bool
(AnnotationAxiom -> AnnotationAxiom -> Bool)
-> (AnnotationAxiom -> AnnotationAxiom -> Bool)
-> Eq AnnotationAxiom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c/= :: AnnotationAxiom -> AnnotationAxiom -> Bool
== :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c== :: AnnotationAxiom -> AnnotationAxiom -> Bool
Eq, Eq AnnotationAxiom
Eq AnnotationAxiom =>
(AnnotationAxiom -> AnnotationAxiom -> Ordering)
-> (AnnotationAxiom -> AnnotationAxiom -> Bool)
-> (AnnotationAxiom -> AnnotationAxiom -> Bool)
-> (AnnotationAxiom -> AnnotationAxiom -> Bool)
-> (AnnotationAxiom -> AnnotationAxiom -> Bool)
-> (AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom)
-> (AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom)
-> Ord AnnotationAxiom
AnnotationAxiom -> AnnotationAxiom -> Bool
AnnotationAxiom -> AnnotationAxiom -> Ordering
AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom
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 :: AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom
$cmin :: AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom
max :: AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom
$cmax :: AnnotationAxiom -> AnnotationAxiom -> AnnotationAxiom
>= :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c>= :: AnnotationAxiom -> AnnotationAxiom -> Bool
> :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c> :: AnnotationAxiom -> AnnotationAxiom -> Bool
<= :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c<= :: AnnotationAxiom -> AnnotationAxiom -> Bool
< :: AnnotationAxiom -> AnnotationAxiom -> Bool
$c< :: AnnotationAxiom -> AnnotationAxiom -> Bool
compare :: AnnotationAxiom -> AnnotationAxiom -> Ordering
$ccompare :: AnnotationAxiom -> AnnotationAxiom -> Ordering
$cp1Ord :: Eq AnnotationAxiom
Ord, Typeable AnnotationAxiom
Constr
DataType
Typeable AnnotationAxiom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AnnotationAxiom -> c AnnotationAxiom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnotationAxiom)
-> (AnnotationAxiom -> Constr)
-> (AnnotationAxiom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnotationAxiom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AnnotationAxiom))
-> ((forall b. Data b => b -> b)
    -> AnnotationAxiom -> AnnotationAxiom)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AnnotationAxiom -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AnnotationAxiom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AnnotationAxiom -> m AnnotationAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationAxiom -> m AnnotationAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationAxiom -> m AnnotationAxiom)
-> Data AnnotationAxiom
AnnotationAxiom -> Constr
AnnotationAxiom -> DataType
(forall b. Data b => b -> b) -> AnnotationAxiom -> AnnotationAxiom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationAxiom -> c AnnotationAxiom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationAxiom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationAxiom -> u
forall u. (forall d. Data d => d -> u) -> AnnotationAxiom -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationAxiom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationAxiom -> c AnnotationAxiom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationAxiom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationAxiom)
$cAnnotationPropertyRange :: Constr
$cAnnotationPropertyDomain :: Constr
$cSubAnnotationPropertyOf :: Constr
$cAnnotationAssertion :: Constr
$tAnnotationAxiom :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
gmapMp :: (forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
gmapM :: (forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationAxiom -> m AnnotationAxiom
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnotationAxiom -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationAxiom -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnotationAxiom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnotationAxiom -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationAxiom -> r
gmapT :: (forall b. Data b => b -> b) -> AnnotationAxiom -> AnnotationAxiom
$cgmapT :: (forall b. Data b => b -> b) -> AnnotationAxiom -> AnnotationAxiom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationAxiom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationAxiom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnotationAxiom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationAxiom)
dataTypeOf :: AnnotationAxiom -> DataType
$cdataTypeOf :: AnnotationAxiom -> DataType
toConstr :: AnnotationAxiom -> Constr
$ctoConstr :: AnnotationAxiom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationAxiom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationAxiom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationAxiom -> c AnnotationAxiom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationAxiom -> c AnnotationAxiom
$cp1Data :: Typeable AnnotationAxiom
Data)

-- Annotation Assertion
data AnnotationSubject = AnnSubIri IRI | AnnSubAnInd AnonymousIndividual
    deriving (Int -> AnnotationSubject -> String -> String
[AnnotationSubject] -> String -> String
AnnotationSubject -> String
(Int -> AnnotationSubject -> String -> String)
-> (AnnotationSubject -> String)
-> ([AnnotationSubject] -> String -> String)
-> Show AnnotationSubject
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AnnotationSubject] -> String -> String
$cshowList :: [AnnotationSubject] -> String -> String
show :: AnnotationSubject -> String
$cshow :: AnnotationSubject -> String
showsPrec :: Int -> AnnotationSubject -> String -> String
$cshowsPrec :: Int -> AnnotationSubject -> String -> String
Show, AnnotationSubject -> AnnotationSubject -> Bool
(AnnotationSubject -> AnnotationSubject -> Bool)
-> (AnnotationSubject -> AnnotationSubject -> Bool)
-> Eq AnnotationSubject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationSubject -> AnnotationSubject -> Bool
$c/= :: AnnotationSubject -> AnnotationSubject -> Bool
== :: AnnotationSubject -> AnnotationSubject -> Bool
$c== :: AnnotationSubject -> AnnotationSubject -> Bool
Eq, Eq AnnotationSubject
Eq AnnotationSubject =>
(AnnotationSubject -> AnnotationSubject -> Ordering)
-> (AnnotationSubject -> AnnotationSubject -> Bool)
-> (AnnotationSubject -> AnnotationSubject -> Bool)
-> (AnnotationSubject -> AnnotationSubject -> Bool)
-> (AnnotationSubject -> AnnotationSubject -> Bool)
-> (AnnotationSubject -> AnnotationSubject -> AnnotationSubject)
-> (AnnotationSubject -> AnnotationSubject -> AnnotationSubject)
-> Ord AnnotationSubject
AnnotationSubject -> AnnotationSubject -> Bool
AnnotationSubject -> AnnotationSubject -> Ordering
AnnotationSubject -> AnnotationSubject -> AnnotationSubject
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 :: AnnotationSubject -> AnnotationSubject -> AnnotationSubject
$cmin :: AnnotationSubject -> AnnotationSubject -> AnnotationSubject
max :: AnnotationSubject -> AnnotationSubject -> AnnotationSubject
$cmax :: AnnotationSubject -> AnnotationSubject -> AnnotationSubject
>= :: AnnotationSubject -> AnnotationSubject -> Bool
$c>= :: AnnotationSubject -> AnnotationSubject -> Bool
> :: AnnotationSubject -> AnnotationSubject -> Bool
$c> :: AnnotationSubject -> AnnotationSubject -> Bool
<= :: AnnotationSubject -> AnnotationSubject -> Bool
$c<= :: AnnotationSubject -> AnnotationSubject -> Bool
< :: AnnotationSubject -> AnnotationSubject -> Bool
$c< :: AnnotationSubject -> AnnotationSubject -> Bool
compare :: AnnotationSubject -> AnnotationSubject -> Ordering
$ccompare :: AnnotationSubject -> AnnotationSubject -> Ordering
$cp1Ord :: Eq AnnotationSubject
Ord, Typeable AnnotationSubject
Constr
DataType
Typeable AnnotationSubject =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AnnotationSubject
 -> c AnnotationSubject)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnotationSubject)
-> (AnnotationSubject -> Constr)
-> (AnnotationSubject -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnotationSubject))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AnnotationSubject))
-> ((forall b. Data b => b -> b)
    -> AnnotationSubject -> AnnotationSubject)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AnnotationSubject -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AnnotationSubject -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AnnotationSubject -> m AnnotationSubject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationSubject -> m AnnotationSubject)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AnnotationSubject -> m AnnotationSubject)
-> Data AnnotationSubject
AnnotationSubject -> Constr
AnnotationSubject -> DataType
(forall b. Data b => b -> b)
-> AnnotationSubject -> AnnotationSubject
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationSubject -> c AnnotationSubject
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationSubject
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationSubject -> u
forall u. (forall d. Data d => d -> u) -> AnnotationSubject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationSubject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationSubject -> c AnnotationSubject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationSubject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationSubject)
$cAnnSubAnInd :: Constr
$cAnnSubIri :: Constr
$tAnnotationSubject :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
gmapMp :: (forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
gmapM :: (forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AnnotationSubject -> m AnnotationSubject
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnotationSubject -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AnnotationSubject -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnotationSubject -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnotationSubject -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnotationSubject -> r
gmapT :: (forall b. Data b => b -> b)
-> AnnotationSubject -> AnnotationSubject
$cgmapT :: (forall b. Data b => b -> b)
-> AnnotationSubject -> AnnotationSubject
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationSubject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnotationSubject)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnotationSubject)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnotationSubject)
dataTypeOf :: AnnotationSubject -> DataType
$cdataTypeOf :: AnnotationSubject -> DataType
toConstr :: AnnotationSubject -> Constr
$ctoConstr :: AnnotationSubject -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationSubject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnotationSubject
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationSubject -> c AnnotationSubject
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnotationSubject -> c AnnotationSubject
$cp1Data :: Typeable AnnotationSubject
Data)

-- Annotation Subproperties
type SubAnnotationProperty = AnnotationProperty
type SuperAnnotationProperty = AnnotationProperty


-- * AXIOMS

data Axiom =
  Declaration AxiomAnnotations Entity
  | ClassAxiom ClassAxiom
  | ObjectPropertyAxiom ObjectPropertyAxiom
  | DataPropertyAxiom DataPropertyAxiom
  | DatatypeDefinition AxiomAnnotations Datatype DataRange
  | HasKey
     AxiomAnnotations
     ClassExpression
     [ObjectPropertyExpression]
     [DataPropertyExpression]
  | Assertion Assertion
  | AnnotationAxiom AnnotationAxiom
  | Rule Rule
  | DGAxiom AxiomAnnotations DGName DGNodes DGEdges MainClasses
  deriving (Int -> Axiom -> String -> String
[Axiom] -> String -> String
Axiom -> String
(Int -> Axiom -> String -> String)
-> (Axiom -> String) -> ([Axiom] -> String -> String) -> Show Axiom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Axiom] -> String -> String
$cshowList :: [Axiom] -> String -> String
show :: Axiom -> String
$cshow :: Axiom -> String
showsPrec :: Int -> Axiom -> String -> String
$cshowsPrec :: Int -> Axiom -> String -> String
Show, Axiom -> Axiom -> Bool
(Axiom -> Axiom -> Bool) -> (Axiom -> Axiom -> Bool) -> Eq Axiom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Axiom -> Axiom -> Bool
$c/= :: Axiom -> Axiom -> Bool
== :: Axiom -> Axiom -> Bool
$c== :: Axiom -> Axiom -> Bool
Eq, Eq Axiom
Eq Axiom =>
(Axiom -> Axiom -> Ordering)
-> (Axiom -> Axiom -> Bool)
-> (Axiom -> Axiom -> Bool)
-> (Axiom -> Axiom -> Bool)
-> (Axiom -> Axiom -> Bool)
-> (Axiom -> Axiom -> Axiom)
-> (Axiom -> Axiom -> Axiom)
-> Ord Axiom
Axiom -> Axiom -> Bool
Axiom -> Axiom -> Ordering
Axiom -> Axiom -> Axiom
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 :: Axiom -> Axiom -> Axiom
$cmin :: Axiom -> Axiom -> Axiom
max :: Axiom -> Axiom -> Axiom
$cmax :: Axiom -> Axiom -> Axiom
>= :: Axiom -> Axiom -> Bool
$c>= :: Axiom -> Axiom -> Bool
> :: Axiom -> Axiom -> Bool
$c> :: Axiom -> Axiom -> Bool
<= :: Axiom -> Axiom -> Bool
$c<= :: Axiom -> Axiom -> Bool
< :: Axiom -> Axiom -> Bool
$c< :: Axiom -> Axiom -> Bool
compare :: Axiom -> Axiom -> Ordering
$ccompare :: Axiom -> Axiom -> Ordering
$cp1Ord :: Eq Axiom
Ord, Typeable, Typeable Axiom
Constr
DataType
Typeable Axiom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Axiom -> c Axiom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Axiom)
-> (Axiom -> Constr)
-> (Axiom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Axiom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Axiom))
-> ((forall b. Data b => b -> b) -> Axiom -> Axiom)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r)
-> (forall u. (forall d. Data d => d -> u) -> Axiom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Axiom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Axiom -> m Axiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Axiom -> m Axiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Axiom -> m Axiom)
-> Data Axiom
Axiom -> Constr
Axiom -> DataType
(forall b. Data b => b -> b) -> Axiom -> Axiom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Axiom -> c Axiom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Axiom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Axiom -> u
forall u. (forall d. Data d => d -> u) -> Axiom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Axiom -> m Axiom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Axiom -> m Axiom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Axiom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Axiom -> c Axiom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Axiom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Axiom)
$cDGAxiom :: Constr
$cRule :: Constr
$cAnnotationAxiom :: Constr
$cAssertion :: Constr
$cHasKey :: Constr
$cDatatypeDefinition :: Constr
$cDataPropertyAxiom :: Constr
$cObjectPropertyAxiom :: Constr
$cClassAxiom :: Constr
$cDeclaration :: Constr
$tAxiom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Axiom -> m Axiom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Axiom -> m Axiom
gmapMp :: (forall d. Data d => d -> m d) -> Axiom -> m Axiom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Axiom -> m Axiom
gmapM :: (forall d. Data d => d -> m d) -> Axiom -> m Axiom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Axiom -> m Axiom
gmapQi :: Int -> (forall d. Data d => d -> u) -> Axiom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Axiom -> u
gmapQ :: (forall d. Data d => d -> u) -> Axiom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Axiom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Axiom -> r
gmapT :: (forall b. Data b => b -> b) -> Axiom -> Axiom
$cgmapT :: (forall b. Data b => b -> b) -> Axiom -> Axiom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Axiom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Axiom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Axiom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Axiom)
dataTypeOf :: Axiom -> DataType
$cdataTypeOf :: Axiom -> DataType
toConstr :: Axiom -> Constr
$ctoConstr :: Axiom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Axiom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Axiom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Axiom -> c Axiom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Axiom -> c Axiom
$cp1Data :: Typeable Axiom
Data)

instance GetRange Axiom where
  getRange :: Axiom -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (Axiom -> [Pos]) -> Axiom -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> (Axiom -> [[Pos]]) -> Axiom -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> [Pos]) -> [Entity] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map Entity -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ([Entity] -> [[Pos]]) -> (Axiom -> [Entity]) -> Axiom -> [[Pos]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> [Entity]
forall a. Set a -> [a]
Set.toList (Set Entity -> [Entity])
-> (Axiom -> Set Entity) -> Axiom -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axiom -> Set Entity
symsOfAxiom

-- ClassAxiom

type AxiomAnnotations = [Annotation]
type SubClassExpression = ClassExpression
type SuperClassExpression = ClassExpression

type DisjointClassExpression = [ClassExpression]
data ClassAxiom =
  SubClassOf AxiomAnnotations SubClassExpression SuperClassExpression
  | EquivalentClasses AxiomAnnotations [ClassExpression]
  | DisjointClasses AxiomAnnotations [ClassExpression]
  | DisjointUnion AxiomAnnotations Class DisjointClassExpression
  deriving (Int -> ClassAxiom -> String -> String
[ClassAxiom] -> String -> String
ClassAxiom -> String
(Int -> ClassAxiom -> String -> String)
-> (ClassAxiom -> String)
-> ([ClassAxiom] -> String -> String)
-> Show ClassAxiom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ClassAxiom] -> String -> String
$cshowList :: [ClassAxiom] -> String -> String
show :: ClassAxiom -> String
$cshow :: ClassAxiom -> String
showsPrec :: Int -> ClassAxiom -> String -> String
$cshowsPrec :: Int -> ClassAxiom -> String -> String
Show, ClassAxiom -> ClassAxiom -> Bool
(ClassAxiom -> ClassAxiom -> Bool)
-> (ClassAxiom -> ClassAxiom -> Bool) -> Eq ClassAxiom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassAxiom -> ClassAxiom -> Bool
$c/= :: ClassAxiom -> ClassAxiom -> Bool
== :: ClassAxiom -> ClassAxiom -> Bool
$c== :: ClassAxiom -> ClassAxiom -> Bool
Eq, Eq ClassAxiom
Eq ClassAxiom =>
(ClassAxiom -> ClassAxiom -> Ordering)
-> (ClassAxiom -> ClassAxiom -> Bool)
-> (ClassAxiom -> ClassAxiom -> Bool)
-> (ClassAxiom -> ClassAxiom -> Bool)
-> (ClassAxiom -> ClassAxiom -> Bool)
-> (ClassAxiom -> ClassAxiom -> ClassAxiom)
-> (ClassAxiom -> ClassAxiom -> ClassAxiom)
-> Ord ClassAxiom
ClassAxiom -> ClassAxiom -> Bool
ClassAxiom -> ClassAxiom -> Ordering
ClassAxiom -> ClassAxiom -> ClassAxiom
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 :: ClassAxiom -> ClassAxiom -> ClassAxiom
$cmin :: ClassAxiom -> ClassAxiom -> ClassAxiom
max :: ClassAxiom -> ClassAxiom -> ClassAxiom
$cmax :: ClassAxiom -> ClassAxiom -> ClassAxiom
>= :: ClassAxiom -> ClassAxiom -> Bool
$c>= :: ClassAxiom -> ClassAxiom -> Bool
> :: ClassAxiom -> ClassAxiom -> Bool
$c> :: ClassAxiom -> ClassAxiom -> Bool
<= :: ClassAxiom -> ClassAxiom -> Bool
$c<= :: ClassAxiom -> ClassAxiom -> Bool
< :: ClassAxiom -> ClassAxiom -> Bool
$c< :: ClassAxiom -> ClassAxiom -> Bool
compare :: ClassAxiom -> ClassAxiom -> Ordering
$ccompare :: ClassAxiom -> ClassAxiom -> Ordering
$cp1Ord :: Eq ClassAxiom
Ord, Typeable ClassAxiom
Constr
DataType
Typeable ClassAxiom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ClassAxiom -> c ClassAxiom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ClassAxiom)
-> (ClassAxiom -> Constr)
-> (ClassAxiom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ClassAxiom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ClassAxiom))
-> ((forall b. Data b => b -> b) -> ClassAxiom -> ClassAxiom)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r)
-> (forall u. (forall d. Data d => d -> u) -> ClassAxiom -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ClassAxiom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom)
-> Data ClassAxiom
ClassAxiom -> Constr
ClassAxiom -> DataType
(forall b. Data b => b -> b) -> ClassAxiom -> ClassAxiom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassAxiom -> c ClassAxiom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassAxiom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ClassAxiom -> u
forall u. (forall d. Data d => d -> u) -> ClassAxiom -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassAxiom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassAxiom -> c ClassAxiom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClassAxiom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClassAxiom)
$cDisjointUnion :: Constr
$cDisjointClasses :: Constr
$cEquivalentClasses :: Constr
$cSubClassOf :: Constr
$tClassAxiom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
gmapMp :: (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
gmapM :: (forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClassAxiom -> m ClassAxiom
gmapQi :: Int -> (forall d. Data d => d -> u) -> ClassAxiom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ClassAxiom -> u
gmapQ :: (forall d. Data d => d -> u) -> ClassAxiom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ClassAxiom -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClassAxiom -> r
gmapT :: (forall b. Data b => b -> b) -> ClassAxiom -> ClassAxiom
$cgmapT :: (forall b. Data b => b -> b) -> ClassAxiom -> ClassAxiom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClassAxiom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClassAxiom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ClassAxiom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClassAxiom)
dataTypeOf :: ClassAxiom -> DataType
$cdataTypeOf :: ClassAxiom -> DataType
toConstr :: ClassAxiom -> Constr
$ctoConstr :: ClassAxiom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassAxiom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClassAxiom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassAxiom -> c ClassAxiom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClassAxiom -> c ClassAxiom
$cp1Data :: Typeable ClassAxiom
Data)

-- ObjectAxiom

data ObjectPropertyAxiom =
  SubObjectPropertyOf
    AxiomAnnotations
    SubObjectPropertyExpression
    SuperObjectPropertyExpression
  | EquivalentObjectProperties AxiomAnnotations [ObjectPropertyExpression]
  | DisjointObjectProperties AxiomAnnotations [ObjectPropertyExpression]
  | InverseObjectProperties
      AxiomAnnotations
      ObjectPropertyExpression
      ObjectPropertyExpression
  | ObjectPropertyDomain
      AxiomAnnotations
      ObjectPropertyExpression
      ClassExpression
  | ObjectPropertyRange
      AxiomAnnotations
      ObjectPropertyExpression
      ClassExpression
  | FunctionalObjectProperty AxiomAnnotations ObjectPropertyExpression
  | InverseFunctionalObjectProperty AxiomAnnotations ObjectPropertyExpression
  | ReflexiveObjectProperty AxiomAnnotations ObjectPropertyExpression
  | IrreflexiveObjectProperty AxiomAnnotations ObjectPropertyExpression
  | SymmetricObjectProperty AxiomAnnotations ObjectPropertyExpression
  | AsymmetricObjectProperty AxiomAnnotations ObjectPropertyExpression
  | TransitiveObjectProperty AxiomAnnotations ObjectPropertyExpression
  deriving (Int -> ObjectPropertyAxiom -> String -> String
[ObjectPropertyAxiom] -> String -> String
ObjectPropertyAxiom -> String
(Int -> ObjectPropertyAxiom -> String -> String)
-> (ObjectPropertyAxiom -> String)
-> ([ObjectPropertyAxiom] -> String -> String)
-> Show ObjectPropertyAxiom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ObjectPropertyAxiom] -> String -> String
$cshowList :: [ObjectPropertyAxiom] -> String -> String
show :: ObjectPropertyAxiom -> String
$cshow :: ObjectPropertyAxiom -> String
showsPrec :: Int -> ObjectPropertyAxiom -> String -> String
$cshowsPrec :: Int -> ObjectPropertyAxiom -> String -> String
Show, ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
(ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> (ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> Eq ObjectPropertyAxiom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c/= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
== :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c== :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
Eq, Eq ObjectPropertyAxiom
Eq ObjectPropertyAxiom =>
(ObjectPropertyAxiom -> ObjectPropertyAxiom -> Ordering)
-> (ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> (ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> (ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> (ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool)
-> (ObjectPropertyAxiom
    -> ObjectPropertyAxiom -> ObjectPropertyAxiom)
-> (ObjectPropertyAxiom
    -> ObjectPropertyAxiom -> ObjectPropertyAxiom)
-> Ord ObjectPropertyAxiom
ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
ObjectPropertyAxiom -> ObjectPropertyAxiom -> Ordering
ObjectPropertyAxiom -> ObjectPropertyAxiom -> ObjectPropertyAxiom
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 :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> ObjectPropertyAxiom
$cmin :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> ObjectPropertyAxiom
max :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> ObjectPropertyAxiom
$cmax :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> ObjectPropertyAxiom
>= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c>= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
> :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c> :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
<= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c<= :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
< :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
$c< :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Bool
compare :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Ordering
$ccompare :: ObjectPropertyAxiom -> ObjectPropertyAxiom -> Ordering
$cp1Ord :: Eq ObjectPropertyAxiom
Ord, Typeable ObjectPropertyAxiom
Constr
DataType
Typeable ObjectPropertyAxiom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ObjectPropertyAxiom
 -> c ObjectPropertyAxiom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjectPropertyAxiom)
-> (ObjectPropertyAxiom -> Constr)
-> (ObjectPropertyAxiom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyAxiom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ObjectPropertyAxiom))
-> ((forall b. Data b => b -> b)
    -> ObjectPropertyAxiom -> ObjectPropertyAxiom)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyAxiom -> m ObjectPropertyAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyAxiom -> m ObjectPropertyAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjectPropertyAxiom -> m ObjectPropertyAxiom)
-> Data ObjectPropertyAxiom
ObjectPropertyAxiom -> Constr
ObjectPropertyAxiom -> DataType
(forall b. Data b => b -> b)
-> ObjectPropertyAxiom -> ObjectPropertyAxiom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyAxiom
-> c ObjectPropertyAxiom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyAxiom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> u
forall u.
(forall d. Data d => d -> u) -> ObjectPropertyAxiom -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyAxiom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyAxiom
-> c ObjectPropertyAxiom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyAxiom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyAxiom)
$cTransitiveObjectProperty :: Constr
$cAsymmetricObjectProperty :: Constr
$cSymmetricObjectProperty :: Constr
$cIrreflexiveObjectProperty :: Constr
$cReflexiveObjectProperty :: Constr
$cInverseFunctionalObjectProperty :: Constr
$cFunctionalObjectProperty :: Constr
$cObjectPropertyRange :: Constr
$cObjectPropertyDomain :: Constr
$cInverseObjectProperties :: Constr
$cDisjointObjectProperties :: Constr
$cEquivalentObjectProperties :: Constr
$cSubObjectPropertyOf :: Constr
$tObjectPropertyAxiom :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
gmapMp :: (forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
gmapM :: (forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjectPropertyAxiom -> m ObjectPropertyAxiom
gmapQi :: Int -> (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> u
gmapQ :: (forall d. Data d => d -> u) -> ObjectPropertyAxiom -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ObjectPropertyAxiom -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjectPropertyAxiom -> r
gmapT :: (forall b. Data b => b -> b)
-> ObjectPropertyAxiom -> ObjectPropertyAxiom
$cgmapT :: (forall b. Data b => b -> b)
-> ObjectPropertyAxiom -> ObjectPropertyAxiom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyAxiom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjectPropertyAxiom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyAxiom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjectPropertyAxiom)
dataTypeOf :: ObjectPropertyAxiom -> DataType
$cdataTypeOf :: ObjectPropertyAxiom -> DataType
toConstr :: ObjectPropertyAxiom -> Constr
$ctoConstr :: ObjectPropertyAxiom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyAxiom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjectPropertyAxiom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyAxiom
-> c ObjectPropertyAxiom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ObjectPropertyAxiom
-> c ObjectPropertyAxiom
$cp1Data :: Typeable ObjectPropertyAxiom
Data)

-- SubObjectPropertyOf

type PropertyExpressionChain = [ObjectPropertyExpression]
type SuperObjectPropertyExpression = ObjectPropertyExpression

data SubObjectPropertyExpression =
    SubObjPropExpr_obj ObjectPropertyExpression
  | SubObjPropExpr_exprchain PropertyExpressionChain
  deriving (Int -> SubObjectPropertyExpression -> String -> String
[SubObjectPropertyExpression] -> String -> String
SubObjectPropertyExpression -> String
(Int -> SubObjectPropertyExpression -> String -> String)
-> (SubObjectPropertyExpression -> String)
-> ([SubObjectPropertyExpression] -> String -> String)
-> Show SubObjectPropertyExpression
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SubObjectPropertyExpression] -> String -> String
$cshowList :: [SubObjectPropertyExpression] -> String -> String
show :: SubObjectPropertyExpression -> String
$cshow :: SubObjectPropertyExpression -> String
showsPrec :: Int -> SubObjectPropertyExpression -> String -> String
$cshowsPrec :: Int -> SubObjectPropertyExpression -> String -> String
Show, SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
(SubObjectPropertyExpression
 -> SubObjectPropertyExpression -> Bool)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> Bool)
-> Eq SubObjectPropertyExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c/= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
== :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c== :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
Eq, Eq SubObjectPropertyExpression
Eq SubObjectPropertyExpression =>
(SubObjectPropertyExpression
 -> SubObjectPropertyExpression -> Ordering)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> Bool)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> Bool)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> Bool)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> Bool)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> SubObjectPropertyExpression)
-> (SubObjectPropertyExpression
    -> SubObjectPropertyExpression -> SubObjectPropertyExpression)
-> Ord SubObjectPropertyExpression
SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
SubObjectPropertyExpression
-> SubObjectPropertyExpression -> Ordering
SubObjectPropertyExpression
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
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 :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
$cmin :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
max :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
$cmax :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
>= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c>= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
> :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c> :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
<= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c<= :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
< :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
$c< :: SubObjectPropertyExpression -> SubObjectPropertyExpression -> Bool
compare :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> Ordering
$ccompare :: SubObjectPropertyExpression
-> SubObjectPropertyExpression -> Ordering
$cp1Ord :: Eq SubObjectPropertyExpression
Ord, Typeable SubObjectPropertyExpression
Constr
DataType
Typeable SubObjectPropertyExpression =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SubObjectPropertyExpression
 -> c SubObjectPropertyExpression)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SubObjectPropertyExpression)
-> (SubObjectPropertyExpression -> Constr)
-> (SubObjectPropertyExpression -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SubObjectPropertyExpression))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubObjectPropertyExpression))
-> ((forall b. Data b => b -> b)
    -> SubObjectPropertyExpression -> SubObjectPropertyExpression)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubObjectPropertyExpression
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubObjectPropertyExpression
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SubObjectPropertyExpression -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SubObjectPropertyExpression
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SubObjectPropertyExpression -> m SubObjectPropertyExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubObjectPropertyExpression -> m SubObjectPropertyExpression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubObjectPropertyExpression -> m SubObjectPropertyExpression)
-> Data SubObjectPropertyExpression
SubObjectPropertyExpression -> Constr
SubObjectPropertyExpression -> DataType
(forall b. Data b => b -> b)
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubObjectPropertyExpression
-> c SubObjectPropertyExpression
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubObjectPropertyExpression
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> SubObjectPropertyExpression -> u
forall u.
(forall d. Data d => d -> u) -> SubObjectPropertyExpression -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubObjectPropertyExpression
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubObjectPropertyExpression
-> c SubObjectPropertyExpression
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubObjectPropertyExpression)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubObjectPropertyExpression)
$cSubObjPropExpr_exprchain :: Constr
$cSubObjPropExpr_obj :: Constr
$tSubObjectPropertyExpression :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
gmapMp :: (forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
gmapM :: (forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubObjectPropertyExpression -> m SubObjectPropertyExpression
gmapQi :: Int
-> (forall d. Data d => d -> u) -> SubObjectPropertyExpression -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SubObjectPropertyExpression -> u
gmapQ :: (forall d. Data d => d -> u) -> SubObjectPropertyExpression -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SubObjectPropertyExpression -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubObjectPropertyExpression
-> r
gmapT :: (forall b. Data b => b -> b)
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
$cgmapT :: (forall b. Data b => b -> b)
-> SubObjectPropertyExpression -> SubObjectPropertyExpression
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubObjectPropertyExpression)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubObjectPropertyExpression)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SubObjectPropertyExpression)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubObjectPropertyExpression)
dataTypeOf :: SubObjectPropertyExpression -> DataType
$cdataTypeOf :: SubObjectPropertyExpression -> DataType
toConstr :: SubObjectPropertyExpression -> Constr
$ctoConstr :: SubObjectPropertyExpression -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubObjectPropertyExpression
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubObjectPropertyExpression
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubObjectPropertyExpression
-> c SubObjectPropertyExpression
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubObjectPropertyExpression
-> c SubObjectPropertyExpression
$cp1Data :: Typeable SubObjectPropertyExpression
Data)

-- DataPropertyAxiom
data DataPropertyAxiom =
  SubDataPropertyOf AxiomAnnotations SubDataPropertyExpression
    SuperDataPropertyExpression
  | EquivalentDataProperties AxiomAnnotations [DataPropertyExpression]
      -- at least 2
  | DisjointDataProperties AxiomAnnotations [DataPropertyExpression]
    -- at least 2
  | DataPropertyDomain AxiomAnnotations DataPropertyExpression ClassExpression
  | DataPropertyRange AxiomAnnotations DataPropertyExpression DataRange
  | FunctionalDataProperty AxiomAnnotations DataPropertyExpression
  deriving (Int -> DataPropertyAxiom -> String -> String
[DataPropertyAxiom] -> String -> String
DataPropertyAxiom -> String
(Int -> DataPropertyAxiom -> String -> String)
-> (DataPropertyAxiom -> String)
-> ([DataPropertyAxiom] -> String -> String)
-> Show DataPropertyAxiom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DataPropertyAxiom] -> String -> String
$cshowList :: [DataPropertyAxiom] -> String -> String
show :: DataPropertyAxiom -> String
$cshow :: DataPropertyAxiom -> String
showsPrec :: Int -> DataPropertyAxiom -> String -> String
$cshowsPrec :: Int -> DataPropertyAxiom -> String -> String
Show, DataPropertyAxiom -> DataPropertyAxiom -> Bool
(DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> (DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> Eq DataPropertyAxiom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c/= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
== :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c== :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
Eq, Eq DataPropertyAxiom
Eq DataPropertyAxiom =>
(DataPropertyAxiom -> DataPropertyAxiom -> Ordering)
-> (DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> (DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> (DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> (DataPropertyAxiom -> DataPropertyAxiom -> Bool)
-> (DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom)
-> (DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom)
-> Ord DataPropertyAxiom
DataPropertyAxiom -> DataPropertyAxiom -> Bool
DataPropertyAxiom -> DataPropertyAxiom -> Ordering
DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom
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 :: DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom
$cmin :: DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom
max :: DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom
$cmax :: DataPropertyAxiom -> DataPropertyAxiom -> DataPropertyAxiom
>= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c>= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
> :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c> :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
<= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c<= :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
< :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
$c< :: DataPropertyAxiom -> DataPropertyAxiom -> Bool
compare :: DataPropertyAxiom -> DataPropertyAxiom -> Ordering
$ccompare :: DataPropertyAxiom -> DataPropertyAxiom -> Ordering
$cp1Ord :: Eq DataPropertyAxiom
Ord, Typeable DataPropertyAxiom
Constr
DataType
Typeable DataPropertyAxiom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DataPropertyAxiom
 -> c DataPropertyAxiom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DataPropertyAxiom)
-> (DataPropertyAxiom -> Constr)
-> (DataPropertyAxiom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DataPropertyAxiom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DataPropertyAxiom))
-> ((forall b. Data b => b -> b)
    -> DataPropertyAxiom -> DataPropertyAxiom)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DataPropertyAxiom -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DataPropertyAxiom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DataPropertyAxiom -> m DataPropertyAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DataPropertyAxiom -> m DataPropertyAxiom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DataPropertyAxiom -> m DataPropertyAxiom)
-> Data DataPropertyAxiom
DataPropertyAxiom -> Constr
DataPropertyAxiom -> DataType
(forall b. Data b => b -> b)
-> DataPropertyAxiom -> DataPropertyAxiom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataPropertyAxiom -> c DataPropertyAxiom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataPropertyAxiom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DataPropertyAxiom -> u
forall u. (forall d. Data d => d -> u) -> DataPropertyAxiom -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataPropertyAxiom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataPropertyAxiom -> c DataPropertyAxiom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataPropertyAxiom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DataPropertyAxiom)
$cFunctionalDataProperty :: Constr
$cDataPropertyRange :: Constr
$cDataPropertyDomain :: Constr
$cDisjointDataProperties :: Constr
$cEquivalentDataProperties :: Constr
$cSubDataPropertyOf :: Constr
$tDataPropertyAxiom :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
gmapMp :: (forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
gmapM :: (forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DataPropertyAxiom -> m DataPropertyAxiom
gmapQi :: Int -> (forall d. Data d => d -> u) -> DataPropertyAxiom -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DataPropertyAxiom -> u
gmapQ :: (forall d. Data d => d -> u) -> DataPropertyAxiom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataPropertyAxiom -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataPropertyAxiom -> r
gmapT :: (forall b. Data b => b -> b)
-> DataPropertyAxiom -> DataPropertyAxiom
$cgmapT :: (forall b. Data b => b -> b)
-> DataPropertyAxiom -> DataPropertyAxiom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DataPropertyAxiom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DataPropertyAxiom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DataPropertyAxiom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataPropertyAxiom)
dataTypeOf :: DataPropertyAxiom -> DataType
$cdataTypeOf :: DataPropertyAxiom -> DataType
toConstr :: DataPropertyAxiom -> Constr
$ctoConstr :: DataPropertyAxiom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataPropertyAxiom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataPropertyAxiom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataPropertyAxiom -> c DataPropertyAxiom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataPropertyAxiom -> c DataPropertyAxiom
$cp1Data :: Typeable DataPropertyAxiom
Data)

type SubDataPropertyExpression = DataPropertyExpression
type SuperDataPropertyExpression = DataPropertyExpression


-- Assertions
data Assertion =
  SameIndividual AxiomAnnotations [Individual]
  | DifferentIndividuals AxiomAnnotations [Individual]
  | ClassAssertion AxiomAnnotations ClassExpression Individual
  | ObjectPropertyAssertion AxiomAnnotations ObjectPropertyExpression
    SourceIndividual TargetIndividual
  | NegativeObjectPropertyAssertion AxiomAnnotations ObjectPropertyExpression
    SourceIndividual TargetIndividual
  | DataPropertyAssertion AxiomAnnotations DataPropertyExpression
    SourceIndividual TargetValue
  | NegativeDataPropertyAssertion AxiomAnnotations DataPropertyExpression
    SourceIndividual TargetValue
  deriving (Int -> Assertion -> String -> String
[Assertion] -> String -> String
Assertion -> String
(Int -> Assertion -> String -> String)
-> (Assertion -> String)
-> ([Assertion] -> String -> String)
-> Show Assertion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Assertion] -> String -> String
$cshowList :: [Assertion] -> String -> String
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> String -> String
$cshowsPrec :: Int -> Assertion -> String -> String
Show, Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Eq Assertion
Eq Assertion =>
(Assertion -> Assertion -> Ordering)
-> (Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Assertion)
-> (Assertion -> Assertion -> Assertion)
-> Ord Assertion
Assertion -> Assertion -> Bool
Assertion -> Assertion -> Ordering
Assertion -> Assertion -> Assertion
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 :: Assertion -> Assertion -> Assertion
$cmin :: Assertion -> Assertion -> Assertion
max :: Assertion -> Assertion -> Assertion
$cmax :: Assertion -> Assertion -> Assertion
>= :: Assertion -> Assertion -> Bool
$c>= :: Assertion -> Assertion -> Bool
> :: Assertion -> Assertion -> Bool
$c> :: Assertion -> Assertion -> Bool
<= :: Assertion -> Assertion -> Bool
$c<= :: Assertion -> Assertion -> Bool
< :: Assertion -> Assertion -> Bool
$c< :: Assertion -> Assertion -> Bool
compare :: Assertion -> Assertion -> Ordering
$ccompare :: Assertion -> Assertion -> Ordering
$cp1Ord :: Eq Assertion
Ord, Typeable Assertion
Constr
DataType
Typeable Assertion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Assertion -> c Assertion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Assertion)
-> (Assertion -> Constr)
-> (Assertion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Assertion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assertion))
-> ((forall b. Data b => b -> b) -> Assertion -> Assertion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Assertion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Assertion -> r)
-> (forall u. (forall d. Data d => d -> u) -> Assertion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Assertion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Assertion -> m Assertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assertion -> m Assertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assertion -> m Assertion)
-> Data Assertion
Assertion -> Constr
Assertion -> DataType
(forall b. Data b => b -> b) -> Assertion -> Assertion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assertion -> c Assertion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assertion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Assertion -> u
forall u. (forall d. Data d => d -> u) -> Assertion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assertion -> m Assertion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assertion -> m Assertion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assertion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assertion -> c Assertion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assertion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assertion)
$cNegativeDataPropertyAssertion :: Constr
$cDataPropertyAssertion :: Constr
$cNegativeObjectPropertyAssertion :: Constr
$cObjectPropertyAssertion :: Constr
$cClassAssertion :: Constr
$cDifferentIndividuals :: Constr
$cSameIndividual :: Constr
$tAssertion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Assertion -> m Assertion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assertion -> m Assertion
gmapMp :: (forall d. Data d => d -> m d) -> Assertion -> m Assertion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assertion -> m Assertion
gmapM :: (forall d. Data d => d -> m d) -> Assertion -> m Assertion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assertion -> m Assertion
gmapQi :: Int -> (forall d. Data d => d -> u) -> Assertion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Assertion -> u
gmapQ :: (forall d. Data d => d -> u) -> Assertion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Assertion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assertion -> r
gmapT :: (forall b. Data b => b -> b) -> Assertion -> Assertion
$cgmapT :: (forall b. Data b => b -> b) -> Assertion -> Assertion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assertion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assertion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Assertion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assertion)
dataTypeOf :: Assertion -> DataType
$cdataTypeOf :: Assertion -> DataType
toConstr :: Assertion -> Constr
$ctoConstr :: Assertion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assertion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assertion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assertion -> c Assertion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assertion -> c Assertion
$cp1Data :: Typeable Assertion
Data)

type SourceIndividual = Individual
type TargetIndividual = Individual
type TargetValue = Literal

-- SWRL Rules

data Rule = DLSafeRule AxiomAnnotations Body Head
  | DGRule AxiomAnnotations DGBody DGHead
  deriving (Int -> Rule -> String -> String
[Rule] -> String -> String
Rule -> String
(Int -> Rule -> String -> String)
-> (Rule -> String) -> ([Rule] -> String -> String) -> Show Rule
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Rule] -> String -> String
$cshowList :: [Rule] -> String -> String
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> String -> String
$cshowsPrec :: Int -> Rule -> String -> String
Show, Rule -> Rule -> Bool
(Rule -> Rule -> Bool) -> (Rule -> Rule -> Bool) -> Eq Rule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c== :: Rule -> Rule -> Bool
Eq, Eq Rule
Eq Rule =>
(Rule -> Rule -> Ordering)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Rule)
-> (Rule -> Rule -> Rule)
-> Ord Rule
Rule -> Rule -> Bool
Rule -> Rule -> Ordering
Rule -> Rule -> Rule
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 :: Rule -> Rule -> Rule
$cmin :: Rule -> Rule -> Rule
max :: Rule -> Rule -> Rule
$cmax :: Rule -> Rule -> Rule
>= :: Rule -> Rule -> Bool
$c>= :: Rule -> Rule -> Bool
> :: Rule -> Rule -> Bool
$c> :: Rule -> Rule -> Bool
<= :: Rule -> Rule -> Bool
$c<= :: Rule -> Rule -> Bool
< :: Rule -> Rule -> Bool
$c< :: Rule -> Rule -> Bool
compare :: Rule -> Rule -> Ordering
$ccompare :: Rule -> Rule -> Ordering
$cp1Ord :: Eq Rule
Ord, Typeable Rule
Constr
DataType
Typeable Rule =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Rule -> c Rule)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Rule)
-> (Rule -> Constr)
-> (Rule -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Rule))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule))
-> ((forall b. Data b => b -> b) -> Rule -> Rule)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rule -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> Data Rule
Rule -> Constr
Rule -> DataType
(forall b. Data b => b -> b) -> Rule -> Rule
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u
forall u. (forall d. Data d => d -> u) -> Rule -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rule)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
$cDGRule :: Constr
$cDLSafeRule :: Constr
$tRule :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapMp :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapM :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapQi :: Int -> (forall d. Data d => d -> u) -> Rule -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u
gmapQ :: (forall d. Data d => d -> u) -> Rule -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rule -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
gmapT :: (forall b. Data b => b -> b) -> Rule -> Rule
$cgmapT :: (forall b. Data b => b -> b) -> Rule -> Rule
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Rule)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rule)
dataTypeOf :: Rule -> DataType
$cdataTypeOf :: Rule -> DataType
toConstr :: Rule -> Constr
$ctoConstr :: Rule -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
$cp1Data :: Typeable Rule
Data)
type Body = [Atom]
type Head = [Atom]
type DGBody = [DGAtom]
type DGHead = [DGAtom]

data IndividualArg = IArg Individual | IVar IndividualVar
  deriving (Int -> IndividualArg -> String -> String
[IndividualArg] -> String -> String
IndividualArg -> String
(Int -> IndividualArg -> String -> String)
-> (IndividualArg -> String)
-> ([IndividualArg] -> String -> String)
-> Show IndividualArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [IndividualArg] -> String -> String
$cshowList :: [IndividualArg] -> String -> String
show :: IndividualArg -> String
$cshow :: IndividualArg -> String
showsPrec :: Int -> IndividualArg -> String -> String
$cshowsPrec :: Int -> IndividualArg -> String -> String
Show, IndividualArg -> IndividualArg -> Bool
(IndividualArg -> IndividualArg -> Bool)
-> (IndividualArg -> IndividualArg -> Bool) -> Eq IndividualArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndividualArg -> IndividualArg -> Bool
$c/= :: IndividualArg -> IndividualArg -> Bool
== :: IndividualArg -> IndividualArg -> Bool
$c== :: IndividualArg -> IndividualArg -> Bool
Eq, Eq IndividualArg
Eq IndividualArg =>
(IndividualArg -> IndividualArg -> Ordering)
-> (IndividualArg -> IndividualArg -> Bool)
-> (IndividualArg -> IndividualArg -> Bool)
-> (IndividualArg -> IndividualArg -> Bool)
-> (IndividualArg -> IndividualArg -> Bool)
-> (IndividualArg -> IndividualArg -> IndividualArg)
-> (IndividualArg -> IndividualArg -> IndividualArg)
-> Ord IndividualArg
IndividualArg -> IndividualArg -> Bool
IndividualArg -> IndividualArg -> Ordering
IndividualArg -> IndividualArg -> IndividualArg
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 :: IndividualArg -> IndividualArg -> IndividualArg
$cmin :: IndividualArg -> IndividualArg -> IndividualArg
max :: IndividualArg -> IndividualArg -> IndividualArg
$cmax :: IndividualArg -> IndividualArg -> IndividualArg
>= :: IndividualArg -> IndividualArg -> Bool
$c>= :: IndividualArg -> IndividualArg -> Bool
> :: IndividualArg -> IndividualArg -> Bool
$c> :: IndividualArg -> IndividualArg -> Bool
<= :: IndividualArg -> IndividualArg -> Bool
$c<= :: IndividualArg -> IndividualArg -> Bool
< :: IndividualArg -> IndividualArg -> Bool
$c< :: IndividualArg -> IndividualArg -> Bool
compare :: IndividualArg -> IndividualArg -> Ordering
$ccompare :: IndividualArg -> IndividualArg -> Ordering
$cp1Ord :: Eq IndividualArg
Ord, Typeable IndividualArg
Constr
DataType
Typeable IndividualArg =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IndividualArg -> c IndividualArg)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IndividualArg)
-> (IndividualArg -> Constr)
-> (IndividualArg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IndividualArg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IndividualArg))
-> ((forall b. Data b => b -> b) -> IndividualArg -> IndividualArg)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IndividualArg -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IndividualArg -> r)
-> (forall u. (forall d. Data d => d -> u) -> IndividualArg -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IndividualArg -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg)
-> Data IndividualArg
IndividualArg -> Constr
IndividualArg -> DataType
(forall b. Data b => b -> b) -> IndividualArg -> IndividualArg
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndividualArg -> c IndividualArg
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndividualArg
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IndividualArg -> u
forall u. (forall d. Data d => d -> u) -> IndividualArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndividualArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndividualArg -> c IndividualArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndividualArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndividualArg)
$cIVar :: Constr
$cIArg :: Constr
$tIndividualArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
gmapMp :: (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
gmapM :: (forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IndividualArg -> m IndividualArg
gmapQi :: Int -> (forall d. Data d => d -> u) -> IndividualArg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IndividualArg -> u
gmapQ :: (forall d. Data d => d -> u) -> IndividualArg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IndividualArg -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndividualArg -> r
gmapT :: (forall b. Data b => b -> b) -> IndividualArg -> IndividualArg
$cgmapT :: (forall b. Data b => b -> b) -> IndividualArg -> IndividualArg
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndividualArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndividualArg)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IndividualArg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndividualArg)
dataTypeOf :: IndividualArg -> DataType
$cdataTypeOf :: IndividualArg -> DataType
toConstr :: IndividualArg -> Constr
$ctoConstr :: IndividualArg -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndividualArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndividualArg
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndividualArg -> c IndividualArg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndividualArg -> c IndividualArg
$cp1Data :: Typeable IndividualArg
Data)
data DataArg = DArg Literal | DVar DataVar
  deriving (Int -> DataArg -> String -> String
[DataArg] -> String -> String
DataArg -> String
(Int -> DataArg -> String -> String)
-> (DataArg -> String)
-> ([DataArg] -> String -> String)
-> Show DataArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DataArg] -> String -> String
$cshowList :: [DataArg] -> String -> String
show :: DataArg -> String
$cshow :: DataArg -> String
showsPrec :: Int -> DataArg -> String -> String
$cshowsPrec :: Int -> DataArg -> String -> String
Show, DataArg -> DataArg -> Bool
(DataArg -> DataArg -> Bool)
-> (DataArg -> DataArg -> Bool) -> Eq DataArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataArg -> DataArg -> Bool
$c/= :: DataArg -> DataArg -> Bool
== :: DataArg -> DataArg -> Bool
$c== :: DataArg -> DataArg -> Bool
Eq, Eq DataArg
Eq DataArg =>
(DataArg -> DataArg -> Ordering)
-> (DataArg -> DataArg -> Bool)
-> (DataArg -> DataArg -> Bool)
-> (DataArg -> DataArg -> Bool)
-> (DataArg -> DataArg -> Bool)
-> (DataArg -> DataArg -> DataArg)
-> (DataArg -> DataArg -> DataArg)
-> Ord DataArg
DataArg -> DataArg -> Bool
DataArg -> DataArg -> Ordering
DataArg -> DataArg -> DataArg
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 :: DataArg -> DataArg -> DataArg
$cmin :: DataArg -> DataArg -> DataArg
max :: DataArg -> DataArg -> DataArg
$cmax :: DataArg -> DataArg -> DataArg
>= :: DataArg -> DataArg -> Bool
$c>= :: DataArg -> DataArg -> Bool
> :: DataArg -> DataArg -> Bool
$c> :: DataArg -> DataArg -> Bool
<= :: DataArg -> DataArg -> Bool
$c<= :: DataArg -> DataArg -> Bool
< :: DataArg -> DataArg -> Bool
$c< :: DataArg -> DataArg -> Bool
compare :: DataArg -> DataArg -> Ordering
$ccompare :: DataArg -> DataArg -> Ordering
$cp1Ord :: Eq DataArg
Ord, Typeable DataArg
Constr
DataType
Typeable DataArg =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DataArg -> c DataArg)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DataArg)
-> (DataArg -> Constr)
-> (DataArg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DataArg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataArg))
-> ((forall b. Data b => b -> b) -> DataArg -> DataArg)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DataArg -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DataArg -> r)
-> (forall u. (forall d. Data d => d -> u) -> DataArg -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DataArg -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DataArg -> m DataArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataArg -> m DataArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataArg -> m DataArg)
-> Data DataArg
DataArg -> Constr
DataArg -> DataType
(forall b. Data b => b -> b) -> DataArg -> DataArg
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataArg -> c DataArg
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataArg
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DataArg -> u
forall u. (forall d. Data d => d -> u) -> DataArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataArg -> m DataArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataArg -> m DataArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataArg -> c DataArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataArg)
$cDVar :: Constr
$cDArg :: Constr
$tDataArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DataArg -> m DataArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataArg -> m DataArg
gmapMp :: (forall d. Data d => d -> m d) -> DataArg -> m DataArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataArg -> m DataArg
gmapM :: (forall d. Data d => d -> m d) -> DataArg -> m DataArg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataArg -> m DataArg
gmapQi :: Int -> (forall d. Data d => d -> u) -> DataArg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataArg -> u
gmapQ :: (forall d. Data d => d -> u) -> DataArg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataArg -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataArg -> r
gmapT :: (forall b. Data b => b -> b) -> DataArg -> DataArg
$cgmapT :: (forall b. Data b => b -> b) -> DataArg -> DataArg
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataArg)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DataArg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataArg)
dataTypeOf :: DataArg -> DataType
$cdataTypeOf :: DataArg -> DataType
toConstr :: DataArg -> Constr
$ctoConstr :: DataArg -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataArg
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataArg -> c DataArg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataArg -> c DataArg
$cp1Data :: Typeable DataArg
Data)

type IndividualVar = Variable
type DataVar = Variable
type Variable = IRI

-- | See `UnknownUnaryAtom`
data UnknownArg = IndividualArg IndividualArg | DataArg DataArg | Variable Variable
  deriving (Int -> UnknownArg -> String -> String
[UnknownArg] -> String -> String
UnknownArg -> String
(Int -> UnknownArg -> String -> String)
-> (UnknownArg -> String)
-> ([UnknownArg] -> String -> String)
-> Show UnknownArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UnknownArg] -> String -> String
$cshowList :: [UnknownArg] -> String -> String
show :: UnknownArg -> String
$cshow :: UnknownArg -> String
showsPrec :: Int -> UnknownArg -> String -> String
$cshowsPrec :: Int -> UnknownArg -> String -> String
Show, UnknownArg -> UnknownArg -> Bool
(UnknownArg -> UnknownArg -> Bool)
-> (UnknownArg -> UnknownArg -> Bool) -> Eq UnknownArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownArg -> UnknownArg -> Bool
$c/= :: UnknownArg -> UnknownArg -> Bool
== :: UnknownArg -> UnknownArg -> Bool
$c== :: UnknownArg -> UnknownArg -> Bool
Eq, Eq UnknownArg
Eq UnknownArg =>
(UnknownArg -> UnknownArg -> Ordering)
-> (UnknownArg -> UnknownArg -> Bool)
-> (UnknownArg -> UnknownArg -> Bool)
-> (UnknownArg -> UnknownArg -> Bool)
-> (UnknownArg -> UnknownArg -> Bool)
-> (UnknownArg -> UnknownArg -> UnknownArg)
-> (UnknownArg -> UnknownArg -> UnknownArg)
-> Ord UnknownArg
UnknownArg -> UnknownArg -> Bool
UnknownArg -> UnknownArg -> Ordering
UnknownArg -> UnknownArg -> UnknownArg
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 :: UnknownArg -> UnknownArg -> UnknownArg
$cmin :: UnknownArg -> UnknownArg -> UnknownArg
max :: UnknownArg -> UnknownArg -> UnknownArg
$cmax :: UnknownArg -> UnknownArg -> UnknownArg
>= :: UnknownArg -> UnknownArg -> Bool
$c>= :: UnknownArg -> UnknownArg -> Bool
> :: UnknownArg -> UnknownArg -> Bool
$c> :: UnknownArg -> UnknownArg -> Bool
<= :: UnknownArg -> UnknownArg -> Bool
$c<= :: UnknownArg -> UnknownArg -> Bool
< :: UnknownArg -> UnknownArg -> Bool
$c< :: UnknownArg -> UnknownArg -> Bool
compare :: UnknownArg -> UnknownArg -> Ordering
$ccompare :: UnknownArg -> UnknownArg -> Ordering
$cp1Ord :: Eq UnknownArg
Ord, Typeable UnknownArg
Constr
DataType
Typeable UnknownArg =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> UnknownArg -> c UnknownArg)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnknownArg)
-> (UnknownArg -> Constr)
-> (UnknownArg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnknownArg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UnknownArg))
-> ((forall b. Data b => b -> b) -> UnknownArg -> UnknownArg)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnknownArg -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnknownArg -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnknownArg -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UnknownArg -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg)
-> Data UnknownArg
UnknownArg -> Constr
UnknownArg -> DataType
(forall b. Data b => b -> b) -> UnknownArg -> UnknownArg
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownArg -> c UnknownArg
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownArg
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnknownArg -> u
forall u. (forall d. Data d => d -> u) -> UnknownArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownArg -> c UnknownArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnknownArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnknownArg)
$cVariable :: Constr
$cDataArg :: Constr
$cIndividualArg :: Constr
$tUnknownArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
gmapMp :: (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
gmapM :: (forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnknownArg -> m UnknownArg
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnknownArg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnknownArg -> u
gmapQ :: (forall d. Data d => d -> u) -> UnknownArg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnknownArg -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownArg -> r
gmapT :: (forall b. Data b => b -> b) -> UnknownArg -> UnknownArg
$cgmapT :: (forall b. Data b => b -> b) -> UnknownArg -> UnknownArg
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnknownArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnknownArg)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnknownArg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnknownArg)
dataTypeOf :: UnknownArg -> DataType
$cdataTypeOf :: UnknownArg -> DataType
toConstr :: UnknownArg -> Constr
$ctoConstr :: UnknownArg -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownArg
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownArg -> c UnknownArg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownArg -> c UnknownArg
$cp1Data :: Typeable UnknownArg
Data)

data Atom = ClassAtom ClassExpression IndividualArg
  | DataRangeAtom DataRange DataArg
  | ObjectPropertyAtom ObjectPropertyExpression IndividualArg IndividualArg
  | DataPropertyAtom DataProperty IndividualArg DataArg
  -- At least one DataArg
  | BuiltInAtom IRI [DataArg]
  | SameIndividualAtom IndividualArg IndividualArg
  | DifferentIndividualsAtom IndividualArg IndividualArg

  {-|
    Ambiguous predicates used in SWRL Rules which type cannot be inferred 
    during parsing. This predicates get resolved and replaced with a 
    specific one in static analysis.
  -}
  | UnknownUnaryAtom IRI UnknownArg
  | UnknownBinaryAtom IRI UnknownArg UnknownArg
  deriving (Int -> Atom -> String -> String
Body -> String -> String
Atom -> String
(Int -> Atom -> String -> String)
-> (Atom -> String) -> (Body -> String -> String) -> Show Atom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: Body -> String -> String
$cshowList :: Body -> String -> String
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> String -> String
$cshowsPrec :: Int -> Atom -> String -> String
Show, Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, Eq Atom
Eq Atom =>
(Atom -> Atom -> Ordering)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Atom)
-> (Atom -> Atom -> Atom)
-> Ord Atom
Atom -> Atom -> Bool
Atom -> Atom -> Ordering
Atom -> Atom -> Atom
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 :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmax :: Atom -> Atom -> Atom
>= :: Atom -> Atom -> Bool
$c>= :: Atom -> Atom -> Bool
> :: Atom -> Atom -> Bool
$c> :: Atom -> Atom -> Bool
<= :: Atom -> Atom -> Bool
$c<= :: Atom -> Atom -> Bool
< :: Atom -> Atom -> Bool
$c< :: Atom -> Atom -> Bool
compare :: Atom -> Atom -> Ordering
$ccompare :: Atom -> Atom -> Ordering
$cp1Ord :: Eq Atom
Ord, Typeable Atom
Constr
DataType
Typeable Atom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Atom -> c Atom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Atom)
-> (Atom -> Constr)
-> (Atom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Atom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom))
-> ((forall b. Data b => b -> b) -> Atom -> Atom)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall u. (forall d. Data d => d -> u) -> Atom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> Data Atom
Atom -> Constr
Atom -> DataType
(forall b. Data b => b -> b) -> Atom -> Atom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u
forall u. (forall d. Data d => d -> u) -> Atom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cUnknownBinaryAtom :: Constr
$cUnknownUnaryAtom :: Constr
$cDifferentIndividualsAtom :: Constr
$cSameIndividualAtom :: Constr
$cBuiltInAtom :: Constr
$cDataPropertyAtom :: Constr
$cObjectPropertyAtom :: Constr
$cDataRangeAtom :: Constr
$cClassAtom :: Constr
$tAtom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapMp :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapM :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapQi :: Int -> (forall d. Data d => d -> u) -> Atom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u
gmapQ :: (forall d. Data d => d -> u) -> Atom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Atom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
$cgmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Atom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
dataTypeOf :: Atom -> DataType
$cdataTypeOf :: Atom -> DataType
toConstr :: Atom -> Constr
$ctoConstr :: Atom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cp1Data :: Typeable Atom
Data)


getVariablesFromIArg :: IndividualArg -> Set.Set Variable
getVariablesFromIArg :: IndividualArg -> Set IRI
getVariablesFromIArg iarg :: IndividualArg
iarg = case IndividualArg
iarg of
    (IVar v :: IRI
v) -> IRI -> Set IRI
forall a. a -> Set a
Set.singleton IRI
v
    _ -> Set IRI
forall a. Monoid a => a
mempty

getVariablesFromDArg :: DataArg -> Set.Set Variable
getVariablesFromDArg :: DataArg -> Set IRI
getVariablesFromDArg darg :: DataArg
darg = case DataArg
darg of
    (DVar v :: IRI
v) -> IRI -> Set IRI
forall a. a -> Set a
Set.singleton IRI
v
    _ -> Set IRI
forall a. Monoid a => a
mempty

getVariablesFromAtom :: Atom -> Set.Set Variable
getVariablesFromAtom :: Atom -> Set IRI
getVariablesFromAtom atom :: Atom
atom = case Atom
atom of
    ClassAtom _ (IVar var :: IRI
var) -> IRI -> Set IRI
forall a. a -> Set a
Set.singleton IRI
var
    DataRangeAtom _ (DVar var :: IRI
var) -> IRI -> Set IRI
forall a. a -> Set a
Set.singleton IRI
var
    ObjectPropertyAtom _ iarg1 :: IndividualArg
iarg1 iarg2 :: IndividualArg
iarg2 -> [Set IRI] -> Set IRI
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set IRI] -> Set IRI) -> [Set IRI] -> Set IRI
forall a b. (a -> b) -> a -> b
$ IndividualArg -> Set IRI
getVariablesFromIArg (IndividualArg -> Set IRI) -> [IndividualArg] -> [Set IRI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IndividualArg
iarg1, IndividualArg
iarg2]
    DataPropertyAtom _ iarg :: IndividualArg
iarg darg :: DataArg
darg -> DataArg -> Set IRI
getVariablesFromDArg DataArg
darg Set IRI -> Set IRI -> Set IRI
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` IndividualArg -> Set IRI
getVariablesFromIArg IndividualArg
iarg
    BuiltInAtom _ args :: [DataArg]
args -> [Set IRI] -> Set IRI
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set IRI] -> Set IRI) -> [Set IRI] -> Set IRI
forall a b. (a -> b) -> a -> b
$ DataArg -> Set IRI
getVariablesFromDArg (DataArg -> Set IRI) -> [DataArg] -> [Set IRI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DataArg]
args
    SameIndividualAtom iarg1 :: IndividualArg
iarg1 iarg2 :: IndividualArg
iarg2 -> [Set IRI] -> Set IRI
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set IRI] -> Set IRI) -> [Set IRI] -> Set IRI
forall a b. (a -> b) -> a -> b
$ IndividualArg -> Set IRI
getVariablesFromIArg (IndividualArg -> Set IRI) -> [IndividualArg] -> [Set IRI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IndividualArg
iarg1, IndividualArg
iarg2]
    DifferentIndividualsAtom iarg1 :: IndividualArg
iarg1 iarg2 :: IndividualArg
iarg2 ->  [Set IRI] -> Set IRI
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set IRI] -> Set IRI) -> [Set IRI] -> Set IRI
forall a b. (a -> b) -> a -> b
$ IndividualArg -> Set IRI
getVariablesFromIArg (IndividualArg -> Set IRI) -> [IndividualArg] -> [Set IRI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IndividualArg
iarg1, IndividualArg
iarg2]
    _ -> Set IRI
forall a. Monoid a => a
mempty

data DGAtom = DGClassAtom ClassExpression IndividualArg
  | DGObjectPropertyAtom ObjectPropertyExpression IndividualArg IndividualArg
  deriving (Int -> DGAtom -> String -> String
DGBody -> String -> String
DGAtom -> String
(Int -> DGAtom -> String -> String)
-> (DGAtom -> String)
-> (DGBody -> String -> String)
-> Show DGAtom
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: DGBody -> String -> String
$cshowList :: DGBody -> String -> String
show :: DGAtom -> String
$cshow :: DGAtom -> String
showsPrec :: Int -> DGAtom -> String -> String
$cshowsPrec :: Int -> DGAtom -> String -> String
Show, DGAtom -> DGAtom -> Bool
(DGAtom -> DGAtom -> Bool)
-> (DGAtom -> DGAtom -> Bool) -> Eq DGAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DGAtom -> DGAtom -> Bool
$c/= :: DGAtom -> DGAtom -> Bool
== :: DGAtom -> DGAtom -> Bool
$c== :: DGAtom -> DGAtom -> Bool
Eq, Eq DGAtom
Eq DGAtom =>
(DGAtom -> DGAtom -> Ordering)
-> (DGAtom -> DGAtom -> Bool)
-> (DGAtom -> DGAtom -> Bool)
-> (DGAtom -> DGAtom -> Bool)
-> (DGAtom -> DGAtom -> Bool)
-> (DGAtom -> DGAtom -> DGAtom)
-> (DGAtom -> DGAtom -> DGAtom)
-> Ord DGAtom
DGAtom -> DGAtom -> Bool
DGAtom -> DGAtom -> Ordering
DGAtom -> DGAtom -> DGAtom
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 :: DGAtom -> DGAtom -> DGAtom
$cmin :: DGAtom -> DGAtom -> DGAtom
max :: DGAtom -> DGAtom -> DGAtom
$cmax :: DGAtom -> DGAtom -> DGAtom
>= :: DGAtom -> DGAtom -> Bool
$c>= :: DGAtom -> DGAtom -> Bool
> :: DGAtom -> DGAtom -> Bool
$c> :: DGAtom -> DGAtom -> Bool
<= :: DGAtom -> DGAtom -> Bool
$c<= :: DGAtom -> DGAtom -> Bool
< :: DGAtom -> DGAtom -> Bool
$c< :: DGAtom -> DGAtom -> Bool
compare :: DGAtom -> DGAtom -> Ordering
$ccompare :: DGAtom -> DGAtom -> Ordering
$cp1Ord :: Eq DGAtom
Ord, Typeable DGAtom
Constr
DataType
Typeable DGAtom =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DGAtom -> c DGAtom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DGAtom)
-> (DGAtom -> Constr)
-> (DGAtom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DGAtom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DGAtom))
-> ((forall b. Data b => b -> b) -> DGAtom -> DGAtom)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DGAtom -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DGAtom -> r)
-> (forall u. (forall d. Data d => d -> u) -> DGAtom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DGAtom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom)
-> Data DGAtom
DGAtom -> Constr
DGAtom -> DataType
(forall b. Data b => b -> b) -> DGAtom -> DGAtom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGAtom -> c DGAtom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGAtom
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DGAtom -> u
forall u. (forall d. Data d => d -> u) -> DGAtom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGAtom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGAtom -> c DGAtom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGAtom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DGAtom)
$cDGObjectPropertyAtom :: Constr
$cDGClassAtom :: Constr
$tDGAtom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
gmapMp :: (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
gmapM :: (forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DGAtom -> m DGAtom
gmapQi :: Int -> (forall d. Data d => d -> u) -> DGAtom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DGAtom -> u
gmapQ :: (forall d. Data d => d -> u) -> DGAtom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DGAtom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DGAtom -> r
gmapT :: (forall b. Data b => b -> b) -> DGAtom -> DGAtom
$cgmapT :: (forall b. Data b => b -> b) -> DGAtom -> DGAtom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DGAtom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DGAtom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DGAtom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGAtom)
dataTypeOf :: DGAtom -> DataType
$cdataTypeOf :: DGAtom -> DataType
toConstr :: DGAtom -> Constr
$ctoConstr :: DGAtom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGAtom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGAtom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGAtom -> c DGAtom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGAtom -> c DGAtom
$cp1Data :: Typeable DGAtom
Data)

type DGName = IRI
-- At least one
type DGNodes = [DGNodeAssertion]
-- At least one
type DGEdges = [DGEdgeAssertion]
-- At least one
type MainClasses = [Class]

data DGNodeAssertion = DGNodeAssertion Class DGNode
  deriving (Int -> DGNodeAssertion -> String -> String
[DGNodeAssertion] -> String -> String
DGNodeAssertion -> String
(Int -> DGNodeAssertion -> String -> String)
-> (DGNodeAssertion -> String)
-> ([DGNodeAssertion] -> String -> String)
-> Show DGNodeAssertion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DGNodeAssertion] -> String -> String
$cshowList :: [DGNodeAssertion] -> String -> String
show :: DGNodeAssertion -> String
$cshow :: DGNodeAssertion -> String
showsPrec :: Int -> DGNodeAssertion -> String -> String
$cshowsPrec :: Int -> DGNodeAssertion -> String -> String
Show, DGNodeAssertion -> DGNodeAssertion -> Bool
(DGNodeAssertion -> DGNodeAssertion -> Bool)
-> (DGNodeAssertion -> DGNodeAssertion -> Bool)
-> Eq DGNodeAssertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c/= :: DGNodeAssertion -> DGNodeAssertion -> Bool
== :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c== :: DGNodeAssertion -> DGNodeAssertion -> Bool
Eq, Eq DGNodeAssertion
Eq DGNodeAssertion =>
(DGNodeAssertion -> DGNodeAssertion -> Ordering)
-> (DGNodeAssertion -> DGNodeAssertion -> Bool)
-> (DGNodeAssertion -> DGNodeAssertion -> Bool)
-> (DGNodeAssertion -> DGNodeAssertion -> Bool)
-> (DGNodeAssertion -> DGNodeAssertion -> Bool)
-> (DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion)
-> (DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion)
-> Ord DGNodeAssertion
DGNodeAssertion -> DGNodeAssertion -> Bool
DGNodeAssertion -> DGNodeAssertion -> Ordering
DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion
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 :: DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion
$cmin :: DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion
max :: DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion
$cmax :: DGNodeAssertion -> DGNodeAssertion -> DGNodeAssertion
>= :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c>= :: DGNodeAssertion -> DGNodeAssertion -> Bool
> :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c> :: DGNodeAssertion -> DGNodeAssertion -> Bool
<= :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c<= :: DGNodeAssertion -> DGNodeAssertion -> Bool
< :: DGNodeAssertion -> DGNodeAssertion -> Bool
$c< :: DGNodeAssertion -> DGNodeAssertion -> Bool
compare :: DGNodeAssertion -> DGNodeAssertion -> Ordering
$ccompare :: DGNodeAssertion -> DGNodeAssertion -> Ordering
$cp1Ord :: Eq DGNodeAssertion
Ord, Typeable DGNodeAssertion
Constr
DataType
Typeable DGNodeAssertion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DGNodeAssertion -> c DGNodeAssertion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DGNodeAssertion)
-> (DGNodeAssertion -> Constr)
-> (DGNodeAssertion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DGNodeAssertion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DGNodeAssertion))
-> ((forall b. Data b => b -> b)
    -> DGNodeAssertion -> DGNodeAssertion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DGNodeAssertion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DGNodeAssertion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DGNodeAssertion -> m DGNodeAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DGNodeAssertion -> m DGNodeAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DGNodeAssertion -> m DGNodeAssertion)
-> Data DGNodeAssertion
DGNodeAssertion -> Constr
DGNodeAssertion -> DataType
(forall b. Data b => b -> b) -> DGNodeAssertion -> DGNodeAssertion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGNodeAssertion -> c DGNodeAssertion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGNodeAssertion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DGNodeAssertion -> u
forall u. (forall d. Data d => d -> u) -> DGNodeAssertion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGNodeAssertion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGNodeAssertion -> c DGNodeAssertion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGNodeAssertion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGNodeAssertion)
$cDGNodeAssertion :: Constr
$tDGNodeAssertion :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
gmapMp :: (forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
gmapM :: (forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DGNodeAssertion -> m DGNodeAssertion
gmapQi :: Int -> (forall d. Data d => d -> u) -> DGNodeAssertion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DGNodeAssertion -> u
gmapQ :: (forall d. Data d => d -> u) -> DGNodeAssertion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DGNodeAssertion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGNodeAssertion -> r
gmapT :: (forall b. Data b => b -> b) -> DGNodeAssertion -> DGNodeAssertion
$cgmapT :: (forall b. Data b => b -> b) -> DGNodeAssertion -> DGNodeAssertion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGNodeAssertion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGNodeAssertion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DGNodeAssertion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGNodeAssertion)
dataTypeOf :: DGNodeAssertion -> DataType
$cdataTypeOf :: DGNodeAssertion -> DataType
toConstr :: DGNodeAssertion -> Constr
$ctoConstr :: DGNodeAssertion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGNodeAssertion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGNodeAssertion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGNodeAssertion -> c DGNodeAssertion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGNodeAssertion -> c DGNodeAssertion
$cp1Data :: Typeable DGNodeAssertion
Data)
type DGNode = IRI

data DGEdgeAssertion = DGEdgeAssertion ObjectProperty DGNode DGNode
  deriving (Int -> DGEdgeAssertion -> String -> String
DGEdges -> String -> String
DGEdgeAssertion -> String
(Int -> DGEdgeAssertion -> String -> String)
-> (DGEdgeAssertion -> String)
-> (DGEdges -> String -> String)
-> Show DGEdgeAssertion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: DGEdges -> String -> String
$cshowList :: DGEdges -> String -> String
show :: DGEdgeAssertion -> String
$cshow :: DGEdgeAssertion -> String
showsPrec :: Int -> DGEdgeAssertion -> String -> String
$cshowsPrec :: Int -> DGEdgeAssertion -> String -> String
Show, DGEdgeAssertion -> DGEdgeAssertion -> Bool
(DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> (DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> Eq DGEdgeAssertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c/= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
== :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c== :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
Eq, Eq DGEdgeAssertion
Eq DGEdgeAssertion =>
(DGEdgeAssertion -> DGEdgeAssertion -> Ordering)
-> (DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> (DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> (DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> (DGEdgeAssertion -> DGEdgeAssertion -> Bool)
-> (DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion)
-> (DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion)
-> Ord DGEdgeAssertion
DGEdgeAssertion -> DGEdgeAssertion -> Bool
DGEdgeAssertion -> DGEdgeAssertion -> Ordering
DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion
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 :: DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion
$cmin :: DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion
max :: DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion
$cmax :: DGEdgeAssertion -> DGEdgeAssertion -> DGEdgeAssertion
>= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c>= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
> :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c> :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
<= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c<= :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
< :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
$c< :: DGEdgeAssertion -> DGEdgeAssertion -> Bool
compare :: DGEdgeAssertion -> DGEdgeAssertion -> Ordering
$ccompare :: DGEdgeAssertion -> DGEdgeAssertion -> Ordering
$cp1Ord :: Eq DGEdgeAssertion
Ord, Typeable DGEdgeAssertion
Constr
DataType
Typeable DGEdgeAssertion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DGEdgeAssertion -> c DGEdgeAssertion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DGEdgeAssertion)
-> (DGEdgeAssertion -> Constr)
-> (DGEdgeAssertion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DGEdgeAssertion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DGEdgeAssertion))
-> ((forall b. Data b => b -> b)
    -> DGEdgeAssertion -> DGEdgeAssertion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DGEdgeAssertion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DGEdgeAssertion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DGEdgeAssertion -> m DGEdgeAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DGEdgeAssertion -> m DGEdgeAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DGEdgeAssertion -> m DGEdgeAssertion)
-> Data DGEdgeAssertion
DGEdgeAssertion -> Constr
DGEdgeAssertion -> DataType
(forall b. Data b => b -> b) -> DGEdgeAssertion -> DGEdgeAssertion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGEdgeAssertion -> c DGEdgeAssertion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGEdgeAssertion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DGEdgeAssertion -> u
forall u. (forall d. Data d => d -> u) -> DGEdgeAssertion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGEdgeAssertion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGEdgeAssertion -> c DGEdgeAssertion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGEdgeAssertion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGEdgeAssertion)
$cDGEdgeAssertion :: Constr
$tDGEdgeAssertion :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
gmapMp :: (forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
gmapM :: (forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DGEdgeAssertion -> m DGEdgeAssertion
gmapQi :: Int -> (forall d. Data d => d -> u) -> DGEdgeAssertion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DGEdgeAssertion -> u
gmapQ :: (forall d. Data d => d -> u) -> DGEdgeAssertion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DGEdgeAssertion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DGEdgeAssertion -> r
gmapT :: (forall b. Data b => b -> b) -> DGEdgeAssertion -> DGEdgeAssertion
$cgmapT :: (forall b. Data b => b -> b) -> DGEdgeAssertion -> DGEdgeAssertion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGEdgeAssertion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DGEdgeAssertion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DGEdgeAssertion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DGEdgeAssertion)
dataTypeOf :: DGEdgeAssertion -> DataType
$cdataTypeOf :: DGEdgeAssertion -> DataType
toConstr :: DGEdgeAssertion -> Constr
$ctoConstr :: DGEdgeAssertion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGEdgeAssertion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DGEdgeAssertion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGEdgeAssertion -> c DGEdgeAssertion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DGEdgeAssertion -> c DGEdgeAssertion
$cp1Data :: Typeable DGEdgeAssertion
Data)

-- Root

emptyOntology :: Ontology
emptyOntology :: Ontology
emptyOntology = Maybe IRI
-> Maybe IRI -> [IRI] -> AxiomAnnotations -> [Axiom] -> Ontology
Ontology Maybe IRI
forall a. Maybe a
Nothing Maybe IRI
forall a. Maybe a
Nothing [] [] []

emptyOntologyDoc :: OntologyDocument
emptyOntologyDoc :: OntologyDocument
emptyOntologyDoc = OntologyMetadata -> PrefixMap -> Ontology -> OntologyDocument
OntologyDocument (OntologySyntaxType -> OntologyMetadata
OntologyMetadata OntologySyntaxType
AS) PrefixMap
forall a. Monoid a => a
mempty Ontology
emptyOntology

data OntologySyntaxType = MS | AS | XML
  deriving  (Int -> OntologySyntaxType -> String -> String
[OntologySyntaxType] -> String -> String
OntologySyntaxType -> String
(Int -> OntologySyntaxType -> String -> String)
-> (OntologySyntaxType -> String)
-> ([OntologySyntaxType] -> String -> String)
-> Show OntologySyntaxType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OntologySyntaxType] -> String -> String
$cshowList :: [OntologySyntaxType] -> String -> String
show :: OntologySyntaxType -> String
$cshow :: OntologySyntaxType -> String
showsPrec :: Int -> OntologySyntaxType -> String -> String
$cshowsPrec :: Int -> OntologySyntaxType -> String -> String
Show, OntologySyntaxType -> OntologySyntaxType -> Bool
(OntologySyntaxType -> OntologySyntaxType -> Bool)
-> (OntologySyntaxType -> OntologySyntaxType -> Bool)
-> Eq OntologySyntaxType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c/= :: OntologySyntaxType -> OntologySyntaxType -> Bool
== :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c== :: OntologySyntaxType -> OntologySyntaxType -> Bool
Eq, Eq OntologySyntaxType
Eq OntologySyntaxType =>
(OntologySyntaxType -> OntologySyntaxType -> Ordering)
-> (OntologySyntaxType -> OntologySyntaxType -> Bool)
-> (OntologySyntaxType -> OntologySyntaxType -> Bool)
-> (OntologySyntaxType -> OntologySyntaxType -> Bool)
-> (OntologySyntaxType -> OntologySyntaxType -> Bool)
-> (OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType)
-> (OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType)
-> Ord OntologySyntaxType
OntologySyntaxType -> OntologySyntaxType -> Bool
OntologySyntaxType -> OntologySyntaxType -> Ordering
OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType
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 :: OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType
$cmin :: OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType
max :: OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType
$cmax :: OntologySyntaxType -> OntologySyntaxType -> OntologySyntaxType
>= :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c>= :: OntologySyntaxType -> OntologySyntaxType -> Bool
> :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c> :: OntologySyntaxType -> OntologySyntaxType -> Bool
<= :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c<= :: OntologySyntaxType -> OntologySyntaxType -> Bool
< :: OntologySyntaxType -> OntologySyntaxType -> Bool
$c< :: OntologySyntaxType -> OntologySyntaxType -> Bool
compare :: OntologySyntaxType -> OntologySyntaxType -> Ordering
$ccompare :: OntologySyntaxType -> OntologySyntaxType -> Ordering
$cp1Ord :: Eq OntologySyntaxType
Ord, Typeable OntologySyntaxType
Constr
DataType
Typeable OntologySyntaxType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> OntologySyntaxType
 -> c OntologySyntaxType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OntologySyntaxType)
-> (OntologySyntaxType -> Constr)
-> (OntologySyntaxType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OntologySyntaxType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OntologySyntaxType))
-> ((forall b. Data b => b -> b)
    -> OntologySyntaxType -> OntologySyntaxType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OntologySyntaxType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OntologySyntaxType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OntologySyntaxType -> m OntologySyntaxType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologySyntaxType -> m OntologySyntaxType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologySyntaxType -> m OntologySyntaxType)
-> Data OntologySyntaxType
OntologySyntaxType -> Constr
OntologySyntaxType -> DataType
(forall b. Data b => b -> b)
-> OntologySyntaxType -> OntologySyntaxType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OntologySyntaxType
-> c OntologySyntaxType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologySyntaxType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OntologySyntaxType -> u
forall u. (forall d. Data d => d -> u) -> OntologySyntaxType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologySyntaxType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OntologySyntaxType
-> c OntologySyntaxType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologySyntaxType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologySyntaxType)
$cXML :: Constr
$cAS :: Constr
$cMS :: Constr
$tOntologySyntaxType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
gmapMp :: (forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
gmapM :: (forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologySyntaxType -> m OntologySyntaxType
gmapQi :: Int -> (forall d. Data d => d -> u) -> OntologySyntaxType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OntologySyntaxType -> u
gmapQ :: (forall d. Data d => d -> u) -> OntologySyntaxType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OntologySyntaxType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologySyntaxType -> r
gmapT :: (forall b. Data b => b -> b)
-> OntologySyntaxType -> OntologySyntaxType
$cgmapT :: (forall b. Data b => b -> b)
-> OntologySyntaxType -> OntologySyntaxType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologySyntaxType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologySyntaxType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OntologySyntaxType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologySyntaxType)
dataTypeOf :: OntologySyntaxType -> DataType
$cdataTypeOf :: OntologySyntaxType -> DataType
toConstr :: OntologySyntaxType -> Constr
$ctoConstr :: OntologySyntaxType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologySyntaxType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologySyntaxType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OntologySyntaxType
-> c OntologySyntaxType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> OntologySyntaxType
-> c OntologySyntaxType
$cp1Data :: Typeable OntologySyntaxType
Data, Typeable)

data OntologyMetadata = OntologyMetadata {
  OntologyMetadata -> OntologySyntaxType
syntaxType :: OntologySyntaxType
  -- might be extended 
  } deriving  (Int -> OntologyMetadata -> String -> String
[OntologyMetadata] -> String -> String
OntologyMetadata -> String
(Int -> OntologyMetadata -> String -> String)
-> (OntologyMetadata -> String)
-> ([OntologyMetadata] -> String -> String)
-> Show OntologyMetadata
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OntologyMetadata] -> String -> String
$cshowList :: [OntologyMetadata] -> String -> String
show :: OntologyMetadata -> String
$cshow :: OntologyMetadata -> String
showsPrec :: Int -> OntologyMetadata -> String -> String
$cshowsPrec :: Int -> OntologyMetadata -> String -> String
Show, OntologyMetadata -> OntologyMetadata -> Bool
(OntologyMetadata -> OntologyMetadata -> Bool)
-> (OntologyMetadata -> OntologyMetadata -> Bool)
-> Eq OntologyMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OntologyMetadata -> OntologyMetadata -> Bool
$c/= :: OntologyMetadata -> OntologyMetadata -> Bool
== :: OntologyMetadata -> OntologyMetadata -> Bool
$c== :: OntologyMetadata -> OntologyMetadata -> Bool
Eq, Eq OntologyMetadata
Eq OntologyMetadata =>
(OntologyMetadata -> OntologyMetadata -> Ordering)
-> (OntologyMetadata -> OntologyMetadata -> Bool)
-> (OntologyMetadata -> OntologyMetadata -> Bool)
-> (OntologyMetadata -> OntologyMetadata -> Bool)
-> (OntologyMetadata -> OntologyMetadata -> Bool)
-> (OntologyMetadata -> OntologyMetadata -> OntologyMetadata)
-> (OntologyMetadata -> OntologyMetadata -> OntologyMetadata)
-> Ord OntologyMetadata
OntologyMetadata -> OntologyMetadata -> Bool
OntologyMetadata -> OntologyMetadata -> Ordering
OntologyMetadata -> OntologyMetadata -> OntologyMetadata
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 :: OntologyMetadata -> OntologyMetadata -> OntologyMetadata
$cmin :: OntologyMetadata -> OntologyMetadata -> OntologyMetadata
max :: OntologyMetadata -> OntologyMetadata -> OntologyMetadata
$cmax :: OntologyMetadata -> OntologyMetadata -> OntologyMetadata
>= :: OntologyMetadata -> OntologyMetadata -> Bool
$c>= :: OntologyMetadata -> OntologyMetadata -> Bool
> :: OntologyMetadata -> OntologyMetadata -> Bool
$c> :: OntologyMetadata -> OntologyMetadata -> Bool
<= :: OntologyMetadata -> OntologyMetadata -> Bool
$c<= :: OntologyMetadata -> OntologyMetadata -> Bool
< :: OntologyMetadata -> OntologyMetadata -> Bool
$c< :: OntologyMetadata -> OntologyMetadata -> Bool
compare :: OntologyMetadata -> OntologyMetadata -> Ordering
$ccompare :: OntologyMetadata -> OntologyMetadata -> Ordering
$cp1Ord :: Eq OntologyMetadata
Ord, Typeable OntologyMetadata
Constr
DataType
Typeable OntologyMetadata =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OntologyMetadata -> c OntologyMetadata)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OntologyMetadata)
-> (OntologyMetadata -> Constr)
-> (OntologyMetadata -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OntologyMetadata))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OntologyMetadata))
-> ((forall b. Data b => b -> b)
    -> OntologyMetadata -> OntologyMetadata)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OntologyMetadata -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OntologyMetadata -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OntologyMetadata -> m OntologyMetadata)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologyMetadata -> m OntologyMetadata)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologyMetadata -> m OntologyMetadata)
-> Data OntologyMetadata
OntologyMetadata -> Constr
OntologyMetadata -> DataType
(forall b. Data b => b -> b)
-> OntologyMetadata -> OntologyMetadata
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyMetadata -> c OntologyMetadata
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyMetadata
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OntologyMetadata -> u
forall u. (forall d. Data d => d -> u) -> OntologyMetadata -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyMetadata
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyMetadata -> c OntologyMetadata
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologyMetadata)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyMetadata)
$cOntologyMetadata :: Constr
$tOntologyMetadata :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
gmapMp :: (forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
gmapM :: (forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologyMetadata -> m OntologyMetadata
gmapQi :: Int -> (forall d. Data d => d -> u) -> OntologyMetadata -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OntologyMetadata -> u
gmapQ :: (forall d. Data d => d -> u) -> OntologyMetadata -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OntologyMetadata -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyMetadata -> r
gmapT :: (forall b. Data b => b -> b)
-> OntologyMetadata -> OntologyMetadata
$cgmapT :: (forall b. Data b => b -> b)
-> OntologyMetadata -> OntologyMetadata
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyMetadata)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyMetadata)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OntologyMetadata)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologyMetadata)
dataTypeOf :: OntologyMetadata -> DataType
$cdataTypeOf :: OntologyMetadata -> DataType
toConstr :: OntologyMetadata -> Constr
$ctoConstr :: OntologyMetadata -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyMetadata
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyMetadata
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyMetadata -> c OntologyMetadata
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyMetadata -> c OntologyMetadata
$cp1Data :: Typeable OntologyMetadata
Data, Typeable)

changeSyntax :: OntologySyntaxType -> OntologyDocument -> OntologyDocument
changeSyntax :: OntologySyntaxType -> OntologyDocument -> OntologyDocument
changeSyntax t :: OntologySyntaxType
t o :: OntologyDocument
o@(OntologyDocument m :: OntologyMetadata
m _ _) = OntologyDocument
o {
  ontologyMetadata :: OntologyMetadata
ontologyMetadata = OntologyMetadata
m {syntaxType :: OntologySyntaxType
syntaxType = OntologySyntaxType
t}
}

data OntologyDocument = OntologyDocument {
    OntologyDocument -> OntologyMetadata
ontologyMetadata :: OntologyMetadata 
  , OntologyDocument -> PrefixMap
prefixDeclaration :: GA.PrefixMap
  , OntologyDocument -> Ontology
ontology :: Ontology
  }
  deriving  (Int -> OntologyDocument -> String -> String
[OntologyDocument] -> String -> String
OntologyDocument -> String
(Int -> OntologyDocument -> String -> String)
-> (OntologyDocument -> String)
-> ([OntologyDocument] -> String -> String)
-> Show OntologyDocument
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OntologyDocument] -> String -> String
$cshowList :: [OntologyDocument] -> String -> String
show :: OntologyDocument -> String
$cshow :: OntologyDocument -> String
showsPrec :: Int -> OntologyDocument -> String -> String
$cshowsPrec :: Int -> OntologyDocument -> String -> String
Show, OntologyDocument -> OntologyDocument -> Bool
(OntologyDocument -> OntologyDocument -> Bool)
-> (OntologyDocument -> OntologyDocument -> Bool)
-> Eq OntologyDocument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OntologyDocument -> OntologyDocument -> Bool
$c/= :: OntologyDocument -> OntologyDocument -> Bool
== :: OntologyDocument -> OntologyDocument -> Bool
$c== :: OntologyDocument -> OntologyDocument -> Bool
Eq, Eq OntologyDocument
Eq OntologyDocument =>
(OntologyDocument -> OntologyDocument -> Ordering)
-> (OntologyDocument -> OntologyDocument -> Bool)
-> (OntologyDocument -> OntologyDocument -> Bool)
-> (OntologyDocument -> OntologyDocument -> Bool)
-> (OntologyDocument -> OntologyDocument -> Bool)
-> (OntologyDocument -> OntologyDocument -> OntologyDocument)
-> (OntologyDocument -> OntologyDocument -> OntologyDocument)
-> Ord OntologyDocument
OntologyDocument -> OntologyDocument -> Bool
OntologyDocument -> OntologyDocument -> Ordering
OntologyDocument -> OntologyDocument -> OntologyDocument
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 :: OntologyDocument -> OntologyDocument -> OntologyDocument
$cmin :: OntologyDocument -> OntologyDocument -> OntologyDocument
max :: OntologyDocument -> OntologyDocument -> OntologyDocument
$cmax :: OntologyDocument -> OntologyDocument -> OntologyDocument
>= :: OntologyDocument -> OntologyDocument -> Bool
$c>= :: OntologyDocument -> OntologyDocument -> Bool
> :: OntologyDocument -> OntologyDocument -> Bool
$c> :: OntologyDocument -> OntologyDocument -> Bool
<= :: OntologyDocument -> OntologyDocument -> Bool
$c<= :: OntologyDocument -> OntologyDocument -> Bool
< :: OntologyDocument -> OntologyDocument -> Bool
$c< :: OntologyDocument -> OntologyDocument -> Bool
compare :: OntologyDocument -> OntologyDocument -> Ordering
$ccompare :: OntologyDocument -> OntologyDocument -> Ordering
$cp1Ord :: Eq OntologyDocument
Ord, Typeable OntologyDocument
Constr
DataType
Typeable OntologyDocument =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OntologyDocument -> c OntologyDocument)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OntologyDocument)
-> (OntologyDocument -> Constr)
-> (OntologyDocument -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OntologyDocument))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OntologyDocument))
-> ((forall b. Data b => b -> b)
    -> OntologyDocument -> OntologyDocument)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OntologyDocument -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OntologyDocument -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OntologyDocument -> m OntologyDocument)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologyDocument -> m OntologyDocument)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OntologyDocument -> m OntologyDocument)
-> Data OntologyDocument
OntologyDocument -> Constr
OntologyDocument -> DataType
(forall b. Data b => b -> b)
-> OntologyDocument -> OntologyDocument
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyDocument -> c OntologyDocument
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyDocument
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OntologyDocument -> u
forall u. (forall d. Data d => d -> u) -> OntologyDocument -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyDocument
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyDocument -> c OntologyDocument
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologyDocument)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyDocument)
$cOntologyDocument :: Constr
$tOntologyDocument :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
gmapMp :: (forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
gmapM :: (forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OntologyDocument -> m OntologyDocument
gmapQi :: Int -> (forall d. Data d => d -> u) -> OntologyDocument -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OntologyDocument -> u
gmapQ :: (forall d. Data d => d -> u) -> OntologyDocument -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OntologyDocument -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OntologyDocument -> r
gmapT :: (forall b. Data b => b -> b)
-> OntologyDocument -> OntologyDocument
$cgmapT :: (forall b. Data b => b -> b)
-> OntologyDocument -> OntologyDocument
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyDocument)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OntologyDocument)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OntologyDocument)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OntologyDocument)
dataTypeOf :: OntologyDocument -> DataType
$cdataTypeOf :: OntologyDocument -> DataType
toConstr :: OntologyDocument -> Constr
$ctoConstr :: OntologyDocument -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyDocument
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OntologyDocument
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyDocument -> c OntologyDocument
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OntologyDocument -> c OntologyDocument
$cp1Data :: Typeable OntologyDocument
Data, Typeable)

data PrefixDeclaration = PrefixDeclaration PrefixName IRI
  deriving  (Int -> PrefixDeclaration -> String -> String
[PrefixDeclaration] -> String -> String
PrefixDeclaration -> String
(Int -> PrefixDeclaration -> String -> String)
-> (PrefixDeclaration -> String)
-> ([PrefixDeclaration] -> String -> String)
-> Show PrefixDeclaration
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PrefixDeclaration] -> String -> String
$cshowList :: [PrefixDeclaration] -> String -> String
show :: PrefixDeclaration -> String
$cshow :: PrefixDeclaration -> String
showsPrec :: Int -> PrefixDeclaration -> String -> String
$cshowsPrec :: Int -> PrefixDeclaration -> String -> String
Show, PrefixDeclaration -> PrefixDeclaration -> Bool
(PrefixDeclaration -> PrefixDeclaration -> Bool)
-> (PrefixDeclaration -> PrefixDeclaration -> Bool)
-> Eq PrefixDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c/= :: PrefixDeclaration -> PrefixDeclaration -> Bool
== :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c== :: PrefixDeclaration -> PrefixDeclaration -> Bool
Eq, Eq PrefixDeclaration
Eq PrefixDeclaration =>
(PrefixDeclaration -> PrefixDeclaration -> Ordering)
-> (PrefixDeclaration -> PrefixDeclaration -> Bool)
-> (PrefixDeclaration -> PrefixDeclaration -> Bool)
-> (PrefixDeclaration -> PrefixDeclaration -> Bool)
-> (PrefixDeclaration -> PrefixDeclaration -> Bool)
-> (PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration)
-> (PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration)
-> Ord PrefixDeclaration
PrefixDeclaration -> PrefixDeclaration -> Bool
PrefixDeclaration -> PrefixDeclaration -> Ordering
PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration
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 :: PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration
$cmin :: PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration
max :: PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration
$cmax :: PrefixDeclaration -> PrefixDeclaration -> PrefixDeclaration
>= :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c>= :: PrefixDeclaration -> PrefixDeclaration -> Bool
> :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c> :: PrefixDeclaration -> PrefixDeclaration -> Bool
<= :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c<= :: PrefixDeclaration -> PrefixDeclaration -> Bool
< :: PrefixDeclaration -> PrefixDeclaration -> Bool
$c< :: PrefixDeclaration -> PrefixDeclaration -> Bool
compare :: PrefixDeclaration -> PrefixDeclaration -> Ordering
$ccompare :: PrefixDeclaration -> PrefixDeclaration -> Ordering
$cp1Ord :: Eq PrefixDeclaration
Ord, Typeable PrefixDeclaration
Constr
DataType
Typeable PrefixDeclaration =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> PrefixDeclaration
 -> c PrefixDeclaration)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PrefixDeclaration)
-> (PrefixDeclaration -> Constr)
-> (PrefixDeclaration -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PrefixDeclaration))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PrefixDeclaration))
-> ((forall b. Data b => b -> b)
    -> PrefixDeclaration -> PrefixDeclaration)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PrefixDeclaration -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PrefixDeclaration -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PrefixDeclaration -> m PrefixDeclaration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PrefixDeclaration -> m PrefixDeclaration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PrefixDeclaration -> m PrefixDeclaration)
-> Data PrefixDeclaration
PrefixDeclaration -> Constr
PrefixDeclaration -> DataType
(forall b. Data b => b -> b)
-> PrefixDeclaration -> PrefixDeclaration
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrefixDeclaration -> c PrefixDeclaration
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrefixDeclaration
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PrefixDeclaration -> u
forall u. (forall d. Data d => d -> u) -> PrefixDeclaration -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrefixDeclaration
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrefixDeclaration -> c PrefixDeclaration
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrefixDeclaration)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrefixDeclaration)
$cPrefixDeclaration :: Constr
$tPrefixDeclaration :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
gmapMp :: (forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
gmapM :: (forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PrefixDeclaration -> m PrefixDeclaration
gmapQi :: Int -> (forall d. Data d => d -> u) -> PrefixDeclaration -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PrefixDeclaration -> u
gmapQ :: (forall d. Data d => d -> u) -> PrefixDeclaration -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrefixDeclaration -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrefixDeclaration -> r
gmapT :: (forall b. Data b => b -> b)
-> PrefixDeclaration -> PrefixDeclaration
$cgmapT :: (forall b. Data b => b -> b)
-> PrefixDeclaration -> PrefixDeclaration
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrefixDeclaration)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrefixDeclaration)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PrefixDeclaration)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrefixDeclaration)
dataTypeOf :: PrefixDeclaration -> DataType
$cdataTypeOf :: PrefixDeclaration -> DataType
toConstr :: PrefixDeclaration -> Constr
$ctoConstr :: PrefixDeclaration -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrefixDeclaration
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrefixDeclaration
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrefixDeclaration -> c PrefixDeclaration
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrefixDeclaration -> c PrefixDeclaration
$cp1Data :: Typeable PrefixDeclaration
Data, Typeable)

instance GetRange OntologyDocument
  
type PrefixName = String

data Ontology = Ontology {
    Ontology -> Maybe IRI
mOntologyIRI :: (Maybe OntologyIRI)
  , Ontology -> Maybe IRI
mOntologyVersion :: (Maybe VersionIRI)
  , Ontology -> [IRI]
importsDocuments :: DirectlyImportsDocuments
  , Ontology -> AxiomAnnotations
ontologyAnnotation:: OntologyAnnotations
  , Ontology -> [Axiom]
axioms :: [Axiom]
  }
  deriving  (Int -> Ontology -> String -> String
[Ontology] -> String -> String
Ontology -> String
(Int -> Ontology -> String -> String)
-> (Ontology -> String)
-> ([Ontology] -> String -> String)
-> Show Ontology
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Ontology] -> String -> String
$cshowList :: [Ontology] -> String -> String
show :: Ontology -> String
$cshow :: Ontology -> String
showsPrec :: Int -> Ontology -> String -> String
$cshowsPrec :: Int -> Ontology -> String -> String
Show, Ontology -> Ontology -> Bool
(Ontology -> Ontology -> Bool)
-> (Ontology -> Ontology -> Bool) -> Eq Ontology
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ontology -> Ontology -> Bool
$c/= :: Ontology -> Ontology -> Bool
== :: Ontology -> Ontology -> Bool
$c== :: Ontology -> Ontology -> Bool
Eq, Eq Ontology
Eq Ontology =>
(Ontology -> Ontology -> Ordering)
-> (Ontology -> Ontology -> Bool)
-> (Ontology -> Ontology -> Bool)
-> (Ontology -> Ontology -> Bool)
-> (Ontology -> Ontology -> Bool)
-> (Ontology -> Ontology -> Ontology)
-> (Ontology -> Ontology -> Ontology)
-> Ord Ontology
Ontology -> Ontology -> Bool
Ontology -> Ontology -> Ordering
Ontology -> Ontology -> Ontology
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 :: Ontology -> Ontology -> Ontology
$cmin :: Ontology -> Ontology -> Ontology
max :: Ontology -> Ontology -> Ontology
$cmax :: Ontology -> Ontology -> Ontology
>= :: Ontology -> Ontology -> Bool
$c>= :: Ontology -> Ontology -> Bool
> :: Ontology -> Ontology -> Bool
$c> :: Ontology -> Ontology -> Bool
<= :: Ontology -> Ontology -> Bool
$c<= :: Ontology -> Ontology -> Bool
< :: Ontology -> Ontology -> Bool
$c< :: Ontology -> Ontology -> Bool
compare :: Ontology -> Ontology -> Ordering
$ccompare :: Ontology -> Ontology -> Ordering
$cp1Ord :: Eq Ontology
Ord, Typeable Ontology
Constr
DataType
Typeable Ontology =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Ontology -> c Ontology)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Ontology)
-> (Ontology -> Constr)
-> (Ontology -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Ontology))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ontology))
-> ((forall b. Data b => b -> b) -> Ontology -> Ontology)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ontology -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ontology -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ontology -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ontology -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ontology -> m Ontology)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ontology -> m Ontology)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ontology -> m Ontology)
-> Data Ontology
Ontology -> Constr
Ontology -> DataType
(forall b. Data b => b -> b) -> Ontology -> Ontology
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ontology -> c Ontology
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ontology
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ontology -> u
forall u. (forall d. Data d => d -> u) -> Ontology -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ontology -> m Ontology
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ontology -> m Ontology
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ontology
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ontology -> c Ontology
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ontology)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ontology)
$cOntology :: Constr
$tOntology :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Ontology -> m Ontology
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ontology -> m Ontology
gmapMp :: (forall d. Data d => d -> m d) -> Ontology -> m Ontology
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ontology -> m Ontology
gmapM :: (forall d. Data d => d -> m d) -> Ontology -> m Ontology
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ontology -> m Ontology
gmapQi :: Int -> (forall d. Data d => d -> u) -> Ontology -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ontology -> u
gmapQ :: (forall d. Data d => d -> u) -> Ontology -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ontology -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ontology -> r
gmapT :: (forall b. Data b => b -> b) -> Ontology -> Ontology
$cgmapT :: (forall b. Data b => b -> b) -> Ontology -> Ontology
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ontology)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ontology)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Ontology)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ontology)
dataTypeOf :: Ontology -> DataType
$cdataTypeOf :: Ontology -> DataType
toConstr :: Ontology -> Constr
$ctoConstr :: Ontology -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ontology
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ontology
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ontology -> c Ontology
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ontology -> c Ontology
$cp1Data :: Typeable Ontology
Data)