{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./RelationalScheme/AS.der.hs
Description :  abstract syntax for Relational Schemes
Copyright   :  Dominik Luecke, Uni Bremen 2008
License     :  GPLv2 or higher, see LICENSE.txt or LIZENZ.txt

Maintainer  :  luecke@informatik.uni-bremen.de
Stability   :  provisional
Portability :  portable

Abstract syntax for Relational Schemes
-}

module RelationalScheme.AS
        ( RSRelType (..)
        , RSQualId (..)
        , RSRel (..)
        , RSRelationships (..)
        , RSScheme (..)
        , Sentence
        , map_rel
        , getRels
        , getSignature
        ) where

import Data.Data
import qualified Data.Map as Map

import Common.Id
import Common.AS_Annotation
import Common.Doc
import Common.DocUtils
import Common.Result
import qualified Control.Monad.Fail as Fail

import RelationalScheme.Keywords
import RelationalScheme.Sign


-- DrIFT command
{-! global: GetRange !-}

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

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

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

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

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

type Sentence = RSRel

-- Pretty printing stuff

instance Pretty RSScheme where
  pretty :: RSScheme -> Doc
pretty (RSScheme t :: RSTables
t r :: RSRelationships
r _) = RSTables -> Doc
forall a. Pretty a => a -> Doc
pretty RSTables
t Doc -> Doc -> Doc
$++$ RSRelationships -> Doc
forall a. Pretty a => a -> Doc
pretty RSRelationships
r

instance Pretty RSRelationships where
  pretty :: RSRelationships -> Doc
pretty (RSRelationships rs :: [Annoted RSRel]
rs _) = if [Annoted RSRel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Annoted RSRel]
rs then Doc
empty else
    String -> Doc
keyword String
rsRelationships Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((Annoted RSRel -> Doc) -> [Annoted RSRel] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Annoted RSRel -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted RSRel]
rs)

instance Pretty RSRel where
  pretty :: RSRel -> Doc
pretty (RSRel i1 :: [RSQualId]
i1 i2 :: [RSQualId]
i2 tp :: RSRelType
tp _) =
    let tbl :: [RSQualId] -> Doc
tbl is :: [RSQualId]
is = case [RSQualId]
is of
               [] -> Doc
empty
               t :: RSQualId
t : _ -> Id -> Doc
forall a. Pretty a => a -> Doc
pretty (RSQualId -> Id
table RSQualId
t)
             Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets ([RSQualId] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [RSQualId]
is)
    in [Doc] -> Doc
fsep [[RSQualId] -> Doc
tbl [RSQualId]
i1, Doc
funArrow, [RSQualId] -> Doc
tbl [RSQualId]
i2, String -> Doc
keyword (RSRelType -> String
forall a. Show a => a -> String
show RSRelType
tp)]

instance Pretty RSQualId where
  pretty :: RSQualId -> Doc
pretty = Id -> Doc
forall a. Pretty a => a -> Doc
pretty (Id -> Doc) -> (RSQualId -> Id) -> RSQualId -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSQualId -> Id
column

instance Show RSRelType where
    show :: RSRelType -> String
show r :: RSRelType
r = case RSRelType
r of
        RSone_to_one -> String
rs1to1
        RSone_to_many -> String
rs1tom
        RSmany_to_one -> String
rsmto1
        RSmany_to_many -> String
rsmtom


map_qualId :: RSMorphism -> RSQualId -> Result RSQualId
map_qualId :: RSMorphism -> RSQualId -> Result RSQualId
map_qualId mor :: RSMorphism
mor qid :: RSQualId
qid =
    let
        (tid :: Id
tid, rid :: Id
rid, rn :: Range
rn) = case RSQualId
qid of
            RSQualId i1 :: Id
i1 i2 :: Id
i2 rn1 :: Range
rn1 -> (Id
i1, Id
i2, Range
rn1)
    in Result RSQualId
-> (RSQualId -> Result RSQualId)
-> Maybe RSQualId
-> Result RSQualId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result RSQualId
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "map_qualId") RSQualId -> Result RSQualId
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RSQualId -> Result RSQualId)
-> Maybe RSQualId -> Result RSQualId
forall a b. (a -> b) -> a -> b
$ do
            Id
mtid <- Id -> Map Id Id -> Maybe Id
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
tid (Map Id Id -> Maybe Id) -> Map Id Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ RSMorphism -> Map Id Id
table_map RSMorphism
mor
            RSTMap
rmor <- Id -> Map Id RSTMap -> Maybe RSTMap
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
tid (Map Id RSTMap -> Maybe RSTMap) -> Map Id RSTMap -> Maybe RSTMap
forall a b. (a -> b) -> a -> b
$ RSMorphism -> Map Id RSTMap
column_map RSMorphism
mor
            Id
mrid <- Id -> Map Id Id -> Maybe Id
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
rid (Map Id Id -> Maybe Id) -> Map Id Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ RSTMap -> Map Id Id
col_map RSTMap
rmor
            RSQualId -> Maybe RSQualId
forall (m :: * -> *) a. Monad m => a -> m a
return (RSQualId -> Maybe RSQualId) -> RSQualId -> Maybe RSQualId
forall a b. (a -> b) -> a -> b
$ Id -> Id -> Range -> RSQualId
RSQualId Id
mtid Id
mrid Range
rn


map_rel :: RSMorphism -> RSRel -> Result RSRel
map_rel :: RSMorphism -> RSRel -> Result RSRel
map_rel mor :: RSMorphism
mor rel :: RSRel
rel =
    let
        (q1 :: [RSQualId]
q1, q2 :: [RSQualId]
q2, rt :: RSRelType
rt, rn :: Range
rn) = case RSRel
rel of
            RSRel qe1 :: [RSQualId]
qe1 qe2 :: [RSQualId]
qe2 rte :: RSRelType
rte rne :: Range
rne -> ([RSQualId]
qe1, [RSQualId]
qe2, RSRelType
rte, Range
rne)
    in
      do
        [RSQualId]
mq1 <- (RSQualId -> Result RSQualId) -> [RSQualId] -> Result [RSQualId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RSMorphism -> RSQualId -> Result RSQualId
map_qualId RSMorphism
mor) [RSQualId]
q1
        [RSQualId]
mq2 <- (RSQualId -> Result RSQualId) -> [RSQualId] -> Result [RSQualId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RSMorphism -> RSQualId -> Result RSQualId
map_qualId RSMorphism
mor) [RSQualId]
q2
        RSRel -> Result RSRel
forall (m :: * -> *) a. Monad m => a -> m a
return (RSRel -> Result RSRel) -> RSRel -> Result RSRel
forall a b. (a -> b) -> a -> b
$ [RSQualId] -> [RSQualId] -> RSRelType -> Range -> RSRel
RSRel [RSQualId]
mq1 [RSQualId]
mq2 RSRelType
rt Range
rn

{-
map_arel :: RSMorphism -> (Annoted RSRel) -> Result (Annoted RSRel)
map_arel mor arel =
    let
        rel = item arel
        (q1, q2, rt, rn) = case rel of
            RSRel qe1 qe2 rte rne -> (qe1, qe2, rte, rne)
    in
      do
        mq1 <- mapM (map_qualId mor) q1
        mq2 <- mapM (map_qualId mor) q2
        return $ arel
                    {
                        item = RSRel mq1 mq2 rt rn
                    }


map_relships :: RSMorphism -> RSRelationships -> Result RSRelationships
map_relships mor rsh =
    let
        (arel, rn) = case rsh of
            RSRelationships arel1 rn1 -> (arel1, rn1)
    in
        do
            orel <- mapM (map_arel mor) arel
            return $ RSRelationships orel rn
-}

-- ^ oo-style getter function for Relations
getRels :: RSScheme -> [Annoted RSRel]
getRels :: RSScheme -> [Annoted RSRel]
getRels spec :: RSScheme
spec = case RSScheme
spec of
            RSScheme _ (RSRelationships rels :: [Annoted RSRel]
rels _) _ -> [Annoted RSRel]
rels

-- ^ oo-style getter function for signatures
getSignature :: RSScheme -> RSTables
getSignature :: RSScheme -> RSTables
getSignature spec :: RSScheme
spec = case RSScheme
spec of
            RSScheme tb :: RSTables
tb _ _ -> RSTables
tb

-- Generated by DrIFT, look but don't touch!

instance GetRange RSRelType where
  getRange :: RSRelType -> Range
getRange = Range -> RSRelType -> Range
forall a b. a -> b -> a
const Range
nullRange
  rangeSpan :: RSRelType -> [Pos]
rangeSpan x :: RSRelType
x = case RSRelType
x of
    RSone_to_one -> []
    RSone_to_many -> []
    RSmany_to_one -> []
    RSmany_to_many -> []

instance GetRange RSQualId where
  getRange :: RSQualId -> Range
getRange x :: RSQualId
x = case RSQualId
x of
    RSQualId _ _ p :: Range
p -> Range
p
  rangeSpan :: RSQualId -> [Pos]
rangeSpan x :: RSQualId
x = case RSQualId
x of
    RSQualId a :: Id
a b :: Id
b c :: Range
c -> [[Pos]] -> [Pos]
joinRanges [Id -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Id
a, Id -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Id
b,
                                  Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
c]

instance GetRange RSRel where
  getRange :: RSRel -> Range
getRange x :: RSRel
x = case RSRel
x of
    RSRel _ _ _ p :: Range
p -> Range
p
  rangeSpan :: RSRel -> [Pos]
rangeSpan x :: RSRel
x = case RSRel
x of
    RSRel a :: [RSQualId]
a b :: [RSQualId]
b c :: RSRelType
c d :: Range
d -> [[Pos]] -> [Pos]
joinRanges [[RSQualId] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [RSQualId]
a, [RSQualId] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [RSQualId]
b, RSRelType -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan RSRelType
c,
                                 Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
d]

instance GetRange RSRelationships where
  getRange :: RSRelationships -> Range
getRange x :: RSRelationships
x = case RSRelationships
x of
    RSRelationships _ p :: Range
p -> Range
p
  rangeSpan :: RSRelationships -> [Pos]
rangeSpan x :: RSRelationships
x = case RSRelationships
x of
    RSRelationships a :: [Annoted RSRel]
a b :: Range
b -> [[Pos]] -> [Pos]
joinRanges [[Annoted RSRel] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [Annoted RSRel]
a, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
b]

instance GetRange RSScheme where
  getRange :: RSScheme -> Range
getRange x :: RSScheme
x = case RSScheme
x of
    RSScheme _ _ p :: Range
p -> Range
p
  rangeSpan :: RSScheme -> [Pos]
rangeSpan x :: RSScheme
x = case RSScheme
x of
    RSScheme a :: RSTables
a b :: RSRelationships
b c :: Range
c -> [[Pos]] -> [Pos]
joinRanges [RSTables -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan RSTables
a, RSRelationships -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan RSRelationships
b,
                                  Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
c]