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

Maintainer  :  f.mance@jacobs-university.de
Stability   :  provisional
Portability :  portable

Datatypes specific to the Manchester Syntax of OWL 2

References  :  <http://www.w3.org/TR/owl2-manchester-syntax/>
-}

module OWL2.MS where

import Common.Id
import Common.IRI
import qualified OWL2.AS as AS

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

{- | annotions are annotedAnnotationList that must be preceded by the keyword
  @Annotations:@ if non-empty -}
type Annotations = [AS.Annotation]

type AnnotatedList a = [(Annotations, a)]

-- | this datatype extends the Manchester Syntax to also allow GCIs
data Extended =
    Misc Annotations
  | ClassEntity AS.ClassExpression
  | ObjectEntity AS.ObjectPropertyExpression
  | SimpleEntity AS.Entity
    deriving (Int -> Extended -> ShowS
[Extended] -> ShowS
Extended -> String
(Int -> Extended -> ShowS)
-> (Extended -> String) -> ([Extended] -> ShowS) -> Show Extended
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extended] -> ShowS
$cshowList :: [Extended] -> ShowS
show :: Extended -> String
$cshow :: Extended -> String
showsPrec :: Int -> Extended -> ShowS
$cshowsPrec :: Int -> Extended -> ShowS
Show, Extended -> Extended -> Bool
(Extended -> Extended -> Bool)
-> (Extended -> Extended -> Bool) -> Eq Extended
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extended -> Extended -> Bool
$c/= :: Extended -> Extended -> Bool
== :: Extended -> Extended -> Bool
$c== :: Extended -> Extended -> Bool
Eq, Eq Extended
Eq Extended =>
(Extended -> Extended -> Ordering)
-> (Extended -> Extended -> Bool)
-> (Extended -> Extended -> Bool)
-> (Extended -> Extended -> Bool)
-> (Extended -> Extended -> Bool)
-> (Extended -> Extended -> Extended)
-> (Extended -> Extended -> Extended)
-> Ord Extended
Extended -> Extended -> Bool
Extended -> Extended -> Ordering
Extended -> Extended -> Extended
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 :: Extended -> Extended -> Extended
$cmin :: Extended -> Extended -> Extended
max :: Extended -> Extended -> Extended
$cmax :: Extended -> Extended -> Extended
>= :: Extended -> Extended -> Bool
$c>= :: Extended -> Extended -> Bool
> :: Extended -> Extended -> Bool
$c> :: Extended -> Extended -> Bool
<= :: Extended -> Extended -> Bool
$c<= :: Extended -> Extended -> Bool
< :: Extended -> Extended -> Bool
$c< :: Extended -> Extended -> Bool
compare :: Extended -> Extended -> Ordering
$ccompare :: Extended -> Extended -> Ordering
$cp1Ord :: Eq Extended
Ord, Typeable, Typeable Extended
Constr
DataType
Typeable Extended =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Extended -> c Extended)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Extended)
-> (Extended -> Constr)
-> (Extended -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Extended))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extended))
-> ((forall b. Data b => b -> b) -> Extended -> Extended)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Extended -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Extended -> r)
-> (forall u. (forall d. Data d => d -> u) -> Extended -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Extended -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Extended -> m Extended)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extended -> m Extended)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extended -> m Extended)
-> Data Extended
Extended -> Constr
Extended -> DataType
(forall b. Data b => b -> b) -> Extended -> Extended
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extended -> c Extended
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extended
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) -> Extended -> u
forall u. (forall d. Data d => d -> u) -> Extended -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extended -> m Extended
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extended -> m Extended
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extended
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extended -> c Extended
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extended)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extended)
$cSimpleEntity :: Constr
$cObjectEntity :: Constr
$cClassEntity :: Constr
$cMisc :: Constr
$tExtended :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Extended -> m Extended
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extended -> m Extended
gmapMp :: (forall d. Data d => d -> m d) -> Extended -> m Extended
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extended -> m Extended
gmapM :: (forall d. Data d => d -> m d) -> Extended -> m Extended
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extended -> m Extended
gmapQi :: Int -> (forall d. Data d => d -> u) -> Extended -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extended -> u
gmapQ :: (forall d. Data d => d -> u) -> Extended -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Extended -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extended -> r
gmapT :: (forall b. Data b => b -> b) -> Extended -> Extended
$cgmapT :: (forall b. Data b => b -> b) -> Extended -> Extended
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extended)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extended)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Extended)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extended)
dataTypeOf :: Extended -> DataType
$cdataTypeOf :: Extended -> DataType
toConstr :: Extended -> Constr
$ctoConstr :: Extended -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extended
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extended
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extended -> c Extended
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extended -> c Extended
$cp1Data :: Typeable Extended
Data)

-- | frames with annotated lists
data ListFrameBit =
    AnnotationBit (AnnotatedList AS.AnnotationProperty) -- relation
  | ExpressionBit (AnnotatedList AS.ClassExpression) -- relation
  | ObjectBit (AnnotatedList AS.ObjectPropertyExpression) -- relation
  | DataBit (AnnotatedList AS.DataPropertyExpression) -- relation
  | IndividualSameOrDifferent (AnnotatedList AS.NamedIndividual) -- relation
  | ObjectCharacteristics (AnnotatedList AS.Character)
  | DataPropRange (AnnotatedList AS.DataRange)
  | IndividualFacts (AnnotatedList Fact)
    deriving (Int -> ListFrameBit -> ShowS
[ListFrameBit] -> ShowS
ListFrameBit -> String
(Int -> ListFrameBit -> ShowS)
-> (ListFrameBit -> String)
-> ([ListFrameBit] -> ShowS)
-> Show ListFrameBit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFrameBit] -> ShowS
$cshowList :: [ListFrameBit] -> ShowS
show :: ListFrameBit -> String
$cshow :: ListFrameBit -> String
showsPrec :: Int -> ListFrameBit -> ShowS
$cshowsPrec :: Int -> ListFrameBit -> ShowS
Show, ListFrameBit -> ListFrameBit -> Bool
(ListFrameBit -> ListFrameBit -> Bool)
-> (ListFrameBit -> ListFrameBit -> Bool) -> Eq ListFrameBit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFrameBit -> ListFrameBit -> Bool
$c/= :: ListFrameBit -> ListFrameBit -> Bool
== :: ListFrameBit -> ListFrameBit -> Bool
$c== :: ListFrameBit -> ListFrameBit -> Bool
Eq, Eq ListFrameBit
Eq ListFrameBit =>
(ListFrameBit -> ListFrameBit -> Ordering)
-> (ListFrameBit -> ListFrameBit -> Bool)
-> (ListFrameBit -> ListFrameBit -> Bool)
-> (ListFrameBit -> ListFrameBit -> Bool)
-> (ListFrameBit -> ListFrameBit -> Bool)
-> (ListFrameBit -> ListFrameBit -> ListFrameBit)
-> (ListFrameBit -> ListFrameBit -> ListFrameBit)
-> Ord ListFrameBit
ListFrameBit -> ListFrameBit -> Bool
ListFrameBit -> ListFrameBit -> Ordering
ListFrameBit -> ListFrameBit -> ListFrameBit
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 :: ListFrameBit -> ListFrameBit -> ListFrameBit
$cmin :: ListFrameBit -> ListFrameBit -> ListFrameBit
max :: ListFrameBit -> ListFrameBit -> ListFrameBit
$cmax :: ListFrameBit -> ListFrameBit -> ListFrameBit
>= :: ListFrameBit -> ListFrameBit -> Bool
$c>= :: ListFrameBit -> ListFrameBit -> Bool
> :: ListFrameBit -> ListFrameBit -> Bool
$c> :: ListFrameBit -> ListFrameBit -> Bool
<= :: ListFrameBit -> ListFrameBit -> Bool
$c<= :: ListFrameBit -> ListFrameBit -> Bool
< :: ListFrameBit -> ListFrameBit -> Bool
$c< :: ListFrameBit -> ListFrameBit -> Bool
compare :: ListFrameBit -> ListFrameBit -> Ordering
$ccompare :: ListFrameBit -> ListFrameBit -> Ordering
$cp1Ord :: Eq ListFrameBit
Ord, Typeable, Typeable ListFrameBit
Constr
DataType
Typeable ListFrameBit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ListFrameBit -> c ListFrameBit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ListFrameBit)
-> (ListFrameBit -> Constr)
-> (ListFrameBit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ListFrameBit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ListFrameBit))
-> ((forall b. Data b => b -> b) -> ListFrameBit -> ListFrameBit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r)
-> (forall u. (forall d. Data d => d -> u) -> ListFrameBit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ListFrameBit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit)
-> Data ListFrameBit
ListFrameBit -> Constr
ListFrameBit -> DataType
(forall b. Data b => b -> b) -> ListFrameBit -> ListFrameBit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFrameBit -> c ListFrameBit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFrameBit
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) -> ListFrameBit -> u
forall u. (forall d. Data d => d -> u) -> ListFrameBit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFrameBit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFrameBit -> c ListFrameBit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListFrameBit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFrameBit)
$cIndividualFacts :: Constr
$cDataPropRange :: Constr
$cObjectCharacteristics :: Constr
$cIndividualSameOrDifferent :: Constr
$cDataBit :: Constr
$cObjectBit :: Constr
$cExpressionBit :: Constr
$cAnnotationBit :: Constr
$tListFrameBit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
gmapMp :: (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
gmapM :: (forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListFrameBit -> m ListFrameBit
gmapQi :: Int -> (forall d. Data d => d -> u) -> ListFrameBit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListFrameBit -> u
gmapQ :: (forall d. Data d => d -> u) -> ListFrameBit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListFrameBit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListFrameBit -> r
gmapT :: (forall b. Data b => b -> b) -> ListFrameBit -> ListFrameBit
$cgmapT :: (forall b. Data b => b -> b) -> ListFrameBit -> ListFrameBit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFrameBit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListFrameBit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ListFrameBit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListFrameBit)
dataTypeOf :: ListFrameBit -> DataType
$cdataTypeOf :: ListFrameBit -> DataType
toConstr :: ListFrameBit -> Constr
$ctoConstr :: ListFrameBit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFrameBit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListFrameBit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFrameBit -> c ListFrameBit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListFrameBit -> c ListFrameBit
$cp1Data :: Typeable ListFrameBit
Data)

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

-- | frames which start with annotations
data AnnFrameBit =
    AnnotationFrameBit AnnoType
  | DataFunctional
  | DatatypeBit AS.DataRange
  | ClassDisjointUnion [AS.ClassExpression]
  | ClassHasKey [AS.ObjectPropertyExpression] [AS.DataPropertyExpression]
  | ObjectSubPropertyChain [AS.ObjectPropertyExpression]
    deriving (Int -> AnnFrameBit -> ShowS
[AnnFrameBit] -> ShowS
AnnFrameBit -> String
(Int -> AnnFrameBit -> ShowS)
-> (AnnFrameBit -> String)
-> ([AnnFrameBit] -> ShowS)
-> Show AnnFrameBit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnFrameBit] -> ShowS
$cshowList :: [AnnFrameBit] -> ShowS
show :: AnnFrameBit -> String
$cshow :: AnnFrameBit -> String
showsPrec :: Int -> AnnFrameBit -> ShowS
$cshowsPrec :: Int -> AnnFrameBit -> ShowS
Show, AnnFrameBit -> AnnFrameBit -> Bool
(AnnFrameBit -> AnnFrameBit -> Bool)
-> (AnnFrameBit -> AnnFrameBit -> Bool) -> Eq AnnFrameBit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnFrameBit -> AnnFrameBit -> Bool
$c/= :: AnnFrameBit -> AnnFrameBit -> Bool
== :: AnnFrameBit -> AnnFrameBit -> Bool
$c== :: AnnFrameBit -> AnnFrameBit -> Bool
Eq, Eq AnnFrameBit
Eq AnnFrameBit =>
(AnnFrameBit -> AnnFrameBit -> Ordering)
-> (AnnFrameBit -> AnnFrameBit -> Bool)
-> (AnnFrameBit -> AnnFrameBit -> Bool)
-> (AnnFrameBit -> AnnFrameBit -> Bool)
-> (AnnFrameBit -> AnnFrameBit -> Bool)
-> (AnnFrameBit -> AnnFrameBit -> AnnFrameBit)
-> (AnnFrameBit -> AnnFrameBit -> AnnFrameBit)
-> Ord AnnFrameBit
AnnFrameBit -> AnnFrameBit -> Bool
AnnFrameBit -> AnnFrameBit -> Ordering
AnnFrameBit -> AnnFrameBit -> AnnFrameBit
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 :: AnnFrameBit -> AnnFrameBit -> AnnFrameBit
$cmin :: AnnFrameBit -> AnnFrameBit -> AnnFrameBit
max :: AnnFrameBit -> AnnFrameBit -> AnnFrameBit
$cmax :: AnnFrameBit -> AnnFrameBit -> AnnFrameBit
>= :: AnnFrameBit -> AnnFrameBit -> Bool
$c>= :: AnnFrameBit -> AnnFrameBit -> Bool
> :: AnnFrameBit -> AnnFrameBit -> Bool
$c> :: AnnFrameBit -> AnnFrameBit -> Bool
<= :: AnnFrameBit -> AnnFrameBit -> Bool
$c<= :: AnnFrameBit -> AnnFrameBit -> Bool
< :: AnnFrameBit -> AnnFrameBit -> Bool
$c< :: AnnFrameBit -> AnnFrameBit -> Bool
compare :: AnnFrameBit -> AnnFrameBit -> Ordering
$ccompare :: AnnFrameBit -> AnnFrameBit -> Ordering
$cp1Ord :: Eq AnnFrameBit
Ord, Typeable, Typeable AnnFrameBit
Constr
DataType
Typeable AnnFrameBit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AnnFrameBit -> c AnnFrameBit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnFrameBit)
-> (AnnFrameBit -> Constr)
-> (AnnFrameBit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnFrameBit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AnnFrameBit))
-> ((forall b. Data b => b -> b) -> AnnFrameBit -> AnnFrameBit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r)
-> (forall u. (forall d. Data d => d -> u) -> AnnFrameBit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AnnFrameBit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit)
-> Data AnnFrameBit
AnnFrameBit -> Constr
AnnFrameBit -> DataType
(forall b. Data b => b -> b) -> AnnFrameBit -> AnnFrameBit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnFrameBit -> c AnnFrameBit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnFrameBit
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) -> AnnFrameBit -> u
forall u. (forall d. Data d => d -> u) -> AnnFrameBit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnFrameBit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnFrameBit -> c AnnFrameBit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnFrameBit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnFrameBit)
$cObjectSubPropertyChain :: Constr
$cClassHasKey :: Constr
$cClassDisjointUnion :: Constr
$cDatatypeBit :: Constr
$cDataFunctional :: Constr
$cAnnotationFrameBit :: Constr
$tAnnFrameBit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
gmapMp :: (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
gmapM :: (forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnFrameBit -> m AnnFrameBit
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnFrameBit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnnFrameBit -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnFrameBit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnFrameBit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnFrameBit -> r
gmapT :: (forall b. Data b => b -> b) -> AnnFrameBit -> AnnFrameBit
$cgmapT :: (forall b. Data b => b -> b) -> AnnFrameBit -> AnnFrameBit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnFrameBit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AnnFrameBit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnFrameBit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnFrameBit)
dataTypeOf :: AnnFrameBit -> DataType
$cdataTypeOf :: AnnFrameBit -> DataType
toConstr :: AnnFrameBit -> Constr
$ctoConstr :: AnnFrameBit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnFrameBit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnFrameBit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnFrameBit -> c AnnFrameBit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnFrameBit -> c AnnFrameBit
$cp1Data :: Typeable AnnFrameBit
Data)

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

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

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

data Axiom = PlainAxiom
  { Axiom -> Extended
axiomTopic :: Extended -- the Class or Individual
  , Axiom -> FrameBit
axiomBit :: FrameBit -- the property expressed by the sentence
  } deriving (Int -> Axiom -> ShowS
[Axiom] -> ShowS
Axiom -> String
(Int -> Axiom -> ShowS)
-> (Axiom -> String) -> ([Axiom] -> ShowS) -> Show Axiom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Axiom] -> ShowS
$cshowList :: [Axiom] -> ShowS
show :: Axiom -> String
$cshow :: Axiom -> String
showsPrec :: Int -> Axiom -> ShowS
$cshowsPrec :: Int -> Axiom -> ShowS
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)
$cPlainAxiom :: 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)

{-

 Individual: alex           <------ axiomTopic
   Facts: hasParent john    <------ axiomBit

-}

mkExtendedEntity :: AS.Entity -> Extended
mkExtendedEntity :: Entity -> Extended
mkExtendedEntity e :: Entity
e@(AS.Entity _ ty :: EntityType
ty iri :: IRI
iri) = case EntityType
ty of
  AS.Class -> ClassExpression -> Extended
ClassEntity (ClassExpression -> Extended) -> ClassExpression -> Extended
forall a b. (a -> b) -> a -> b
$ IRI -> ClassExpression
AS.Expression IRI
iri
  AS.ObjectProperty -> ObjectPropertyExpression -> Extended
ObjectEntity (ObjectPropertyExpression -> Extended)
-> ObjectPropertyExpression -> Extended
forall a b. (a -> b) -> a -> b
$ IRI -> ObjectPropertyExpression
AS.ObjectProp IRI
iri
  _ -> Entity -> Extended
SimpleEntity Entity
e

getAxioms :: Frame -> [Axiom]
getAxioms :: Frame -> [Axiom]
getAxioms (Frame e :: Extended
e fbl :: [FrameBit]
fbl) = (FrameBit -> Axiom) -> [FrameBit] -> [Axiom]
forall a b. (a -> b) -> [a] -> [b]
map (Extended -> FrameBit -> Axiom
PlainAxiom Extended
e) [FrameBit]
fbl

axToFrame :: Axiom -> Frame
axToFrame :: Axiom -> Frame
axToFrame (PlainAxiom e :: Extended
e fb :: FrameBit
fb) = Extended -> [FrameBit] -> Frame
Frame Extended
e [FrameBit
fb]

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

data Ontology = Ontology
    { Ontology -> IRI
name :: AS.OntologyIRI
    , Ontology -> [IRI]
imports :: [AS.ImportIRI]
    , Ontology -> [Annotations]
ann :: [Annotations]
    , Ontology -> [Frame]
ontFrames :: [Frame]
    } deriving (Int -> Ontology -> ShowS
[Ontology] -> ShowS
Ontology -> String
(Int -> Ontology -> ShowS)
-> (Ontology -> String) -> ([Ontology] -> ShowS) -> Show Ontology
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ontology] -> ShowS
$cshowList :: [Ontology] -> ShowS
show :: Ontology -> String
$cshow :: Ontology -> String
showsPrec :: Int -> Ontology -> ShowS
$cshowsPrec :: Int -> Ontology -> ShowS
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, 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)

data OntologyDocument = OntologyDocument
    { OntologyDocument -> PrefixMap
prefixDeclaration :: AS.PrefixMap
    , OntologyDocument -> Ontology
ontology :: Ontology
    } deriving (Int -> OntologyDocument -> ShowS
[OntologyDocument] -> ShowS
OntologyDocument -> String
(Int -> OntologyDocument -> ShowS)
-> (OntologyDocument -> String)
-> ([OntologyDocument] -> ShowS)
-> Show OntologyDocument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OntologyDocument] -> ShowS
$cshowList :: [OntologyDocument] -> ShowS
show :: OntologyDocument -> String
$cshow :: OntologyDocument -> String
showsPrec :: Int -> OntologyDocument -> ShowS
$cshowsPrec :: Int -> OntologyDocument -> ShowS
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, 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)

instance GetRange OntologyDocument

emptyOntology :: [Frame] -> Ontology
emptyOntology :: [Frame] -> Ontology
emptyOntology = IRI -> [IRI] -> [Annotations] -> [Frame] -> Ontology
Ontology IRI
nullIRI [] []

emptyOntologyDoc :: OntologyDocument
emptyOntologyDoc :: OntologyDocument
emptyOntologyDoc = PrefixMap -> Ontology -> OntologyDocument
OntologyDocument PrefixMap
forall k a. Map k a
Map.empty (Ontology -> OntologyDocument) -> Ontology -> OntologyDocument
forall a b. (a -> b) -> a -> b
$ [Frame] -> Ontology
emptyOntology []

isEmptyOntology :: Ontology -> Bool
isEmptyOntology :: Ontology -> Bool
isEmptyOntology (Ontology oiri :: IRI
oiri annoList :: [IRI]
annoList impList :: [Annotations]
impList fs :: [Frame]
fs) = IRI -> Bool
isNullIRI IRI
oiri
    Bool -> Bool -> Bool
&& [IRI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IRI]
annoList Bool -> Bool -> Bool
&& [Annotations] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Annotations]
impList Bool -> Bool -> Bool
&& [Frame] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Frame]
fs

isEmptyOntologyDoc :: OntologyDocument -> Bool
isEmptyOntologyDoc :: OntologyDocument -> Bool
isEmptyOntologyDoc (OntologyDocument ns :: PrefixMap
ns onto :: Ontology
onto) =
    PrefixMap -> Bool
forall k a. Map k a -> Bool
Map.null PrefixMap
ns Bool -> Bool -> Bool
&& Ontology -> Bool
isEmptyOntology Ontology
onto

emptyAnnoList :: [a] -> AnnotatedList a
emptyAnnoList :: [a] -> AnnotatedList a
emptyAnnoList = (a -> (Annotations, a)) -> [a] -> AnnotatedList a
forall a b. (a -> b) -> [a] -> [b]
map ((a -> (Annotations, a)) -> [a] -> AnnotatedList a)
-> (a -> (Annotations, a)) -> [a] -> AnnotatedList a
forall a b. (a -> b) -> a -> b
$ \ x :: a
x -> ([], a
x)

symsOfAxiom :: Axiom -> Set.Set AS.Entity
symsOfAxiom :: Axiom -> Set Entity
symsOfAxiom (PlainAxiom e :: Extended
e f :: FrameBit
f) = Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Extended -> Set Entity
symsOfExtended Extended
e) (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ FrameBit -> Set Entity
symsOfFrameBit FrameBit
f

symsOfExtended :: Extended -> Set.Set AS.Entity
symsOfExtended :: Extended -> Set Entity
symsOfExtended e :: Extended
e = case Extended
e of
  Misc as :: Annotations
as -> Annotations -> Set Entity
symsOfAnnotations Annotations
as
  SimpleEntity s :: Entity
s -> Entity -> Set Entity
forall a. a -> Set a
Set.singleton Entity
s
  ObjectEntity o :: ObjectPropertyExpression
o -> ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
o
  ClassEntity c :: ClassExpression
c -> ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
c

symsOfObjectPropertyExpression :: AS.ObjectPropertyExpression -> Set.Set AS.Entity
symsOfObjectPropertyExpression :: ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression o :: ObjectPropertyExpression
o = case ObjectPropertyExpression
o of
  AS.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
AS.mkEntity EntityType
AS.ObjectProperty IRI
i
  AS.ObjectInverseOf i :: ObjectPropertyExpression
i -> ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
i

symsOfClassExpression :: AS.ClassExpression -> Set.Set AS.Entity
symsOfClassExpression :: ClassExpression -> Set Entity
symsOfClassExpression ce :: ClassExpression
ce = case ClassExpression
ce of
  AS.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
AS.mkEntity EntityType
AS.Class IRI
c
  AS.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
  AS.ObjectComplementOf c :: ClassExpression
c -> ClassExpression -> Set Entity
symsOfClassExpression ClassExpression
c
  AS.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
AS.mkEntity EntityType
AS.NamedIndividual) [IRI]
is
  AS.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
  AS.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
AS.mkEntity EntityType
AS.NamedIndividual IRI
i)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe
  AS.ObjectHasSelf oe :: ObjectPropertyExpression
oe -> ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe
  AS.ObjectCardinality (AS.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
  AS.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
AS.mkEntity EntityType
AS.DataProperty) [IRI]
de)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ DataRange -> Set Entity
symsOfDataRange DataRange
dr
  AS.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
AS.mkEntity EntityType
AS.DataProperty IRI
de
  AS.DataCardinality (AS.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
AS.mkEntity EntityType
AS.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 :: AS.DataRange -> Set.Set AS.Entity
symsOfDataRange :: DataRange -> Set Entity
symsOfDataRange dr :: DataRange
dr = case DataRange
dr of
  AS.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
AS.mkEntity EntityType
AS.Datatype IRI
t
  AS.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
  AS.DataComplementOf d :: DataRange
d -> DataRange -> Set Entity
symsOfDataRange DataRange
d
  AS.DataOneOf _ -> Set Entity
forall a. Set a
Set.empty

symsOfAnnotation :: AS.Annotation -> Set.Set AS.Entity
symsOfAnnotation :: Annotation -> Set Entity
symsOfAnnotation (AS.Annotation as :: Annotations
as p :: IRI
p _) = Entity -> Set Entity -> Set Entity
forall a. Ord a => a -> Set a -> Set a
Set.insert
   (EntityType -> IRI -> Entity
AS.mkEntity EntityType
AS.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) -> Annotations -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Set Entity
symsOfAnnotation Annotations
as)

symsOfAnnotations :: Annotations -> Set.Set AS.Entity
symsOfAnnotations :: Annotations -> 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)
-> (Annotations -> [Set Entity]) -> Annotations -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation -> Set Entity) -> Annotations -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> Set Entity
symsOfAnnotation

symsOfFrameBit :: FrameBit -> Set.Set AS.Entity
symsOfFrameBit :: FrameBit -> Set Entity
symsOfFrameBit fb :: FrameBit
fb = case FrameBit
fb of
  ListFrameBit _ lb :: ListFrameBit
lb -> ListFrameBit -> Set Entity
symsOfListFrameBit ListFrameBit
lb
  AnnFrameBit as :: Annotations
as af :: AnnFrameBit
af -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Annotations -> Set Entity
symsOfAnnotations Annotations
as) (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ AnnFrameBit -> Set Entity
symsOfAnnFrameBit AnnFrameBit
af

symsOfAnnFrameBit :: AnnFrameBit -> Set.Set AS.Entity
symsOfAnnFrameBit :: AnnFrameBit -> Set Entity
symsOfAnnFrameBit af :: AnnFrameBit
af = case AnnFrameBit
af of
  AnnotationFrameBit _ -> Set Entity
forall a. Set a
Set.empty
  DataFunctional -> Set Entity
forall a. Set a
Set.empty
  DatatypeBit dr :: DataRange
dr -> DataRange -> Set Entity
symsOfDataRange DataRange
dr
  ClassDisjointUnion 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
  ClassHasKey os :: [ObjectPropertyExpression]
os ds :: [IRI]
ds -> Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    ([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
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression [ObjectPropertyExpression]
os)
    (Set Entity -> Set Entity)
-> ([Entity] -> Set Entity) -> [Entity] -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
AS.mkEntity EntityType
AS.DataProperty) [IRI]
ds
  ObjectSubPropertyChain os :: [ObjectPropertyExpression]
os ->
    [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
$ (ObjectPropertyExpression -> Set Entity)
-> [ObjectPropertyExpression] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression [ObjectPropertyExpression]
os

symsOfListFrameBit :: ListFrameBit -> Set.Set AS.Entity
symsOfListFrameBit :: ListFrameBit -> Set Entity
symsOfListFrameBit lb :: ListFrameBit
lb = case ListFrameBit
lb of
  AnnotationBit l :: AnnotatedList IRI
l -> (IRI -> Set Entity) -> AnnotatedList IRI -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms
    (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
AS.mkEntity EntityType
AS.AnnotationProperty) AnnotatedList IRI
l
  ExpressionBit l :: AnnotatedList ClassExpression
l -> (ClassExpression -> Set Entity)
-> AnnotatedList ClassExpression -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms ClassExpression -> Set Entity
symsOfClassExpression AnnotatedList ClassExpression
l
  ObjectBit l :: AnnotatedList ObjectPropertyExpression
l -> (ObjectPropertyExpression -> Set Entity)
-> AnnotatedList ObjectPropertyExpression -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression AnnotatedList ObjectPropertyExpression
l
  DataBit l :: AnnotatedList IRI
l -> (IRI -> Set Entity) -> AnnotatedList IRI -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms (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
AS.mkEntity EntityType
AS.DataProperty) AnnotatedList IRI
l
  IndividualSameOrDifferent l :: AnnotatedList IRI
l -> (IRI -> Set Entity) -> AnnotatedList IRI -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms
    (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
AS.mkEntity EntityType
AS.NamedIndividual) AnnotatedList IRI
l
  ObjectCharacteristics l :: AnnotatedList Character
l -> (Character -> Set Entity) -> AnnotatedList Character -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms (Set Entity -> Character -> Set Entity
forall a b. a -> b -> a
const Set Entity
forall a. Set a
Set.empty) AnnotatedList Character
l
  DataPropRange l :: AnnotatedList DataRange
l -> (DataRange -> Set Entity) -> AnnotatedList DataRange -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms DataRange -> Set Entity
symsOfDataRange AnnotatedList DataRange
l
  IndividualFacts l :: AnnotatedList Fact
l -> (Fact -> Set Entity) -> AnnotatedList Fact -> Set Entity
forall a. (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms Fact -> Set Entity
symsOfFact AnnotatedList Fact
l

symsOfFact :: Fact -> Set.Set AS.Entity
symsOfFact :: Fact -> Set Entity
symsOfFact fact :: Fact
fact = case Fact
fact of
  ObjectPropertyFact _ 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
AS.mkEntity EntityType
AS.NamedIndividual IRI
i)
    (Set Entity -> Set Entity) -> Set Entity -> Set Entity
forall a b. (a -> b) -> a -> b
$ ObjectPropertyExpression -> Set Entity
symsOfObjectPropertyExpression ObjectPropertyExpression
oe
  DataPropertyFact _ d :: 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
AS.mkEntity EntityType
AS.DataProperty IRI
d

annotedSyms :: (a -> Set.Set AS.Entity) -> AnnotatedList a -> Set.Set AS.Entity
annotedSyms :: (a -> Set Entity) -> AnnotatedList a -> Set Entity
annotedSyms f :: a -> Set Entity
f l :: AnnotatedList a
l = Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([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
$ ((Annotations, a) -> Set Entity) -> AnnotatedList a -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Annotations -> Set Entity
symsOfAnnotations (Annotations -> Set Entity)
-> ((Annotations, a) -> Annotations)
-> (Annotations, a)
-> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotations, a) -> Annotations
forall a b. (a, b) -> a
fst) AnnotatedList a
l)
  (Set Entity -> Set Entity)
-> ([Set Entity] -> Set Entity) -> [Set Entity] -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
$ ((Annotations, a) -> Set Entity) -> AnnotatedList a -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Set Entity
f (a -> Set Entity)
-> ((Annotations, a) -> a) -> (Annotations, a) -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotations, a) -> a
forall a b. (a, b) -> b
snd) AnnotatedList a
l