{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./RelationalScheme/Sign.hs
Description :  signaturefor 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

Signature for Relational Schemes
-}

module RelationalScheme.Sign
        ( RSIsKey
        , RSDatatype (..)
        , RSRawSymbol
        , RSColumn (..)
        , RSTable (..)
        , RSTables (..)
        , Sign
        , RSMorphism (..)
        , RSTMap (..)
        , emptyRSSign
        , isRSSubsig
        , idMor
        , rsInclusion
        , uniteSig
        , comp_rst_mor
        , RSSymbol (..)
        , RSSymbolKind (..)
        , sym_kind
        )
        where

import RelationalScheme.Keywords

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

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

type RSIsKey = Bool

data RSDatatype
  = RSboolean | RSbinary | RSdate | RSdatetime | RSdecimal | RSfloat
  | RSinteger | RSstring | RStext | RStime | RStimestamp | RSdouble
  | RSnonPosInteger | RSnonNegInteger | RSlong | RSPointer
    deriving (RSDatatype -> RSDatatype -> Bool
(RSDatatype -> RSDatatype -> Bool)
-> (RSDatatype -> RSDatatype -> Bool) -> Eq RSDatatype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSDatatype -> RSDatatype -> Bool
$c/= :: RSDatatype -> RSDatatype -> Bool
== :: RSDatatype -> RSDatatype -> Bool
$c== :: RSDatatype -> RSDatatype -> Bool
Eq, Eq RSDatatype
Eq RSDatatype =>
(RSDatatype -> RSDatatype -> Ordering)
-> (RSDatatype -> RSDatatype -> Bool)
-> (RSDatatype -> RSDatatype -> Bool)
-> (RSDatatype -> RSDatatype -> Bool)
-> (RSDatatype -> RSDatatype -> Bool)
-> (RSDatatype -> RSDatatype -> RSDatatype)
-> (RSDatatype -> RSDatatype -> RSDatatype)
-> Ord RSDatatype
RSDatatype -> RSDatatype -> Bool
RSDatatype -> RSDatatype -> Ordering
RSDatatype -> RSDatatype -> RSDatatype
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 :: RSDatatype -> RSDatatype -> RSDatatype
$cmin :: RSDatatype -> RSDatatype -> RSDatatype
max :: RSDatatype -> RSDatatype -> RSDatatype
$cmax :: RSDatatype -> RSDatatype -> RSDatatype
>= :: RSDatatype -> RSDatatype -> Bool
$c>= :: RSDatatype -> RSDatatype -> Bool
> :: RSDatatype -> RSDatatype -> Bool
$c> :: RSDatatype -> RSDatatype -> Bool
<= :: RSDatatype -> RSDatatype -> Bool
$c<= :: RSDatatype -> RSDatatype -> Bool
< :: RSDatatype -> RSDatatype -> Bool
$c< :: RSDatatype -> RSDatatype -> Bool
compare :: RSDatatype -> RSDatatype -> Ordering
$ccompare :: RSDatatype -> RSDatatype -> Ordering
$cp1Ord :: Eq RSDatatype
Ord, Typeable, Typeable RSDatatype
Constr
DataType
Typeable RSDatatype =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RSDatatype -> c RSDatatype)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RSDatatype)
-> (RSDatatype -> Constr)
-> (RSDatatype -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RSDatatype))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RSDatatype))
-> ((forall b. Data b => b -> b) -> RSDatatype -> RSDatatype)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RSDatatype -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RSDatatype -> r)
-> (forall u. (forall d. Data d => d -> u) -> RSDatatype -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RSDatatype -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype)
-> Data RSDatatype
RSDatatype -> Constr
RSDatatype -> DataType
(forall b. Data b => b -> b) -> RSDatatype -> RSDatatype
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSDatatype -> c RSDatatype
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSDatatype
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) -> RSDatatype -> u
forall u. (forall d. Data d => d -> u) -> RSDatatype -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSDatatype
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSDatatype -> c RSDatatype
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSDatatype)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSDatatype)
$cRSPointer :: Constr
$cRSlong :: Constr
$cRSnonNegInteger :: Constr
$cRSnonPosInteger :: Constr
$cRSdouble :: Constr
$cRStimestamp :: Constr
$cRStime :: Constr
$cRStext :: Constr
$cRSstring :: Constr
$cRSinteger :: Constr
$cRSfloat :: Constr
$cRSdecimal :: Constr
$cRSdatetime :: Constr
$cRSdate :: Constr
$cRSbinary :: Constr
$cRSboolean :: Constr
$tRSDatatype :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
gmapMp :: (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
gmapM :: (forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSDatatype -> m RSDatatype
gmapQi :: Int -> (forall d. Data d => d -> u) -> RSDatatype -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RSDatatype -> u
gmapQ :: (forall d. Data d => d -> u) -> RSDatatype -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RSDatatype -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSDatatype -> r
gmapT :: (forall b. Data b => b -> b) -> RSDatatype -> RSDatatype
$cgmapT :: (forall b. Data b => b -> b) -> RSDatatype -> RSDatatype
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSDatatype)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSDatatype)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RSDatatype)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSDatatype)
dataTypeOf :: RSDatatype -> DataType
$cdataTypeOf :: RSDatatype -> DataType
toConstr :: RSDatatype -> Constr
$ctoConstr :: RSDatatype -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSDatatype
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSDatatype
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSDatatype -> c RSDatatype
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSDatatype -> c RSDatatype
$cp1Data :: Typeable RSDatatype
Data)

type RSRawSymbol = Id

data RSSymbol = STable Id |     -- id of a table
                SColumn
                    Id          -- id of the symbol
                    Id          -- id of the table
                    RSDatatype  -- datatype of the symbol
                    RSIsKey     -- is it a key?
                deriving (RSSymbol -> RSSymbol -> Bool
(RSSymbol -> RSSymbol -> Bool)
-> (RSSymbol -> RSSymbol -> Bool) -> Eq RSSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSSymbol -> RSSymbol -> Bool
$c/= :: RSSymbol -> RSSymbol -> Bool
== :: RSSymbol -> RSSymbol -> Bool
$c== :: RSSymbol -> RSSymbol -> Bool
Eq, Eq RSSymbol
Eq RSSymbol =>
(RSSymbol -> RSSymbol -> Ordering)
-> (RSSymbol -> RSSymbol -> Bool)
-> (RSSymbol -> RSSymbol -> Bool)
-> (RSSymbol -> RSSymbol -> Bool)
-> (RSSymbol -> RSSymbol -> Bool)
-> (RSSymbol -> RSSymbol -> RSSymbol)
-> (RSSymbol -> RSSymbol -> RSSymbol)
-> Ord RSSymbol
RSSymbol -> RSSymbol -> Bool
RSSymbol -> RSSymbol -> Ordering
RSSymbol -> RSSymbol -> RSSymbol
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 :: RSSymbol -> RSSymbol -> RSSymbol
$cmin :: RSSymbol -> RSSymbol -> RSSymbol
max :: RSSymbol -> RSSymbol -> RSSymbol
$cmax :: RSSymbol -> RSSymbol -> RSSymbol
>= :: RSSymbol -> RSSymbol -> Bool
$c>= :: RSSymbol -> RSSymbol -> Bool
> :: RSSymbol -> RSSymbol -> Bool
$c> :: RSSymbol -> RSSymbol -> Bool
<= :: RSSymbol -> RSSymbol -> Bool
$c<= :: RSSymbol -> RSSymbol -> Bool
< :: RSSymbol -> RSSymbol -> Bool
$c< :: RSSymbol -> RSSymbol -> Bool
compare :: RSSymbol -> RSSymbol -> Ordering
$ccompare :: RSSymbol -> RSSymbol -> Ordering
$cp1Ord :: Eq RSSymbol
Ord, Int -> RSSymbol -> ShowS
[RSSymbol] -> ShowS
RSSymbol -> String
(Int -> RSSymbol -> ShowS)
-> (RSSymbol -> String) -> ([RSSymbol] -> ShowS) -> Show RSSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSymbol] -> ShowS
$cshowList :: [RSSymbol] -> ShowS
show :: RSSymbol -> String
$cshow :: RSSymbol -> String
showsPrec :: Int -> RSSymbol -> ShowS
$cshowsPrec :: Int -> RSSymbol -> ShowS
Show, Typeable, Typeable RSSymbol
Constr
DataType
Typeable RSSymbol =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RSSymbol -> c RSSymbol)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RSSymbol)
-> (RSSymbol -> Constr)
-> (RSSymbol -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RSSymbol))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSSymbol))
-> ((forall b. Data b => b -> b) -> RSSymbol -> RSSymbol)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RSSymbol -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RSSymbol -> r)
-> (forall u. (forall d. Data d => d -> u) -> RSSymbol -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RSSymbol -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol)
-> Data RSSymbol
RSSymbol -> Constr
RSSymbol -> DataType
(forall b. Data b => b -> b) -> RSSymbol -> RSSymbol
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSSymbol -> c RSSymbol
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSSymbol
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) -> RSSymbol -> u
forall u. (forall d. Data d => d -> u) -> RSSymbol -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSSymbol
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSSymbol -> c RSSymbol
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSSymbol)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSSymbol)
$cSColumn :: Constr
$cSTable :: Constr
$tRSSymbol :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
gmapMp :: (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
gmapM :: (forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSSymbol -> m RSSymbol
gmapQi :: Int -> (forall d. Data d => d -> u) -> RSSymbol -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RSSymbol -> u
gmapQ :: (forall d. Data d => d -> u) -> RSSymbol -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RSSymbol -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSSymbol -> r
gmapT :: (forall b. Data b => b -> b) -> RSSymbol -> RSSymbol
$cgmapT :: (forall b. Data b => b -> b) -> RSSymbol -> RSSymbol
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSSymbol)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSSymbol)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RSSymbol)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSSymbol)
dataTypeOf :: RSSymbol -> DataType
$cdataTypeOf :: RSSymbol -> DataType
toConstr :: RSSymbol -> Constr
$ctoConstr :: RSSymbol -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSSymbol
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSSymbol
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSSymbol -> c RSSymbol
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSSymbol -> c RSSymbol
$cp1Data :: Typeable RSSymbol
Data)

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

sym_kind :: RSSymbol -> RSSymbolKind
sym_kind :: RSSymbol -> RSSymbolKind
sym_kind (STable _) = RSSymbolKind
STableK
sym_kind _ = RSSymbolKind
SColumnK

instance Pretty RSSymbolKind where
 pretty :: RSSymbolKind -> Doc
pretty STableK  = String -> Doc
text "table"
 pretty SColumnK = String -> Doc
text "colum"

instance GetRange RSSymbol

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

data RSTable = RSTable
                { RSTable -> Id
t_name :: Id
                , RSTable -> [RSColumn]
columns :: [RSColumn]
                , RSTable -> [Annotation]
rsannos :: [Annotation]
                , RSTable -> Set (Id, RSDatatype)
t_keys :: Set.Set (Id, RSDatatype)
                }
                deriving (Int -> RSTable -> ShowS
[RSTable] -> ShowS
RSTable -> String
(Int -> RSTable -> ShowS)
-> (RSTable -> String) -> ([RSTable] -> ShowS) -> Show RSTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSTable] -> ShowS
$cshowList :: [RSTable] -> ShowS
show :: RSTable -> String
$cshow :: RSTable -> String
showsPrec :: Int -> RSTable -> ShowS
$cshowsPrec :: Int -> RSTable -> ShowS
Show, Typeable, Typeable RSTable
Constr
DataType
Typeable RSTable =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RSTable -> c RSTable)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RSTable)
-> (RSTable -> Constr)
-> (RSTable -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RSTable))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSTable))
-> ((forall b. Data b => b -> b) -> RSTable -> RSTable)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RSTable -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RSTable -> r)
-> (forall u. (forall d. Data d => d -> u) -> RSTable -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RSTable -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RSTable -> m RSTable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSTable -> m RSTable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RSTable -> m RSTable)
-> Data RSTable
RSTable -> Constr
RSTable -> DataType
(forall b. Data b => b -> b) -> RSTable -> RSTable
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSTable -> c RSTable
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSTable
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) -> RSTable -> u
forall u. (forall d. Data d => d -> u) -> RSTable -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSTable -> m RSTable
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSTable -> m RSTable
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSTable
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSTable -> c RSTable
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSTable)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSTable)
$cRSTable :: Constr
$tRSTable :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RSTable -> m RSTable
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSTable -> m RSTable
gmapMp :: (forall d. Data d => d -> m d) -> RSTable -> m RSTable
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RSTable -> m RSTable
gmapM :: (forall d. Data d => d -> m d) -> RSTable -> m RSTable
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RSTable -> m RSTable
gmapQi :: Int -> (forall d. Data d => d -> u) -> RSTable -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RSTable -> u
gmapQ :: (forall d. Data d => d -> u) -> RSTable -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RSTable -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RSTable -> r
gmapT :: (forall b. Data b => b -> b) -> RSTable -> RSTable
$cgmapT :: (forall b. Data b => b -> b) -> RSTable -> RSTable
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSTable)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RSTable)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RSTable)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RSTable)
dataTypeOf :: RSTable -> DataType
$cdataTypeOf :: RSTable -> DataType
toConstr :: RSTable -> Constr
$ctoConstr :: RSTable -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSTable
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RSTable
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSTable -> c RSTable
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RSTable -> c RSTable
$cp1Data :: Typeable RSTable
Data)

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

instance GetRange RSTables

isRSSubsig :: RSTables -> RSTables -> Bool
isRSSubsig :: RSTables -> RSTables -> Bool
isRSSubsig t1 :: RSTables
t1 t2 :: RSTables
t2 = RSTables
t1 RSTables -> RSTables -> Bool
forall a. Ord a => a -> a -> Bool
<= RSTables
t2

uniteSig :: (Fail.MonadFail m) => RSTables -> RSTables -> m RSTables
uniteSig :: RSTables -> RSTables -> m RSTables
uniteSig s1 :: RSTables
s1 s2 :: RSTables
s2 =
    if RSTables
s1 RSTables -> RSTables -> Bool
`isRSSubsig` RSTables
s2 Bool -> Bool -> Bool
|| RSTables
s2 RSTables -> RSTables -> Bool
`isRSSubsig` RSTables
s1 Bool -> Bool -> Bool
|| RSTables
s1 RSTables -> RSTables -> Bool
`isDisjoint` RSTables
s2
    then RSTables -> m RSTables
forall (m :: * -> *) a. Monad m => a -> m a
return (RSTables -> m RSTables) -> RSTables -> m RSTables
forall a b. (a -> b) -> a -> b
$ Set RSTable -> RSTables
RSTables (Set RSTable -> RSTables) -> Set RSTable -> RSTables
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
s1 Set RSTable -> Set RSTable -> Set RSTable
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` RSTables -> Set RSTable
tables RSTables
s2
    else String -> m RSTables
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m RSTables) -> String -> m RSTables
forall a b. (a -> b) -> a -> b
$ "Tables " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RSTables -> ShowS
forall a. Pretty a => a -> ShowS
showDoc RSTables
s1 "\nand "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ RSTables -> ShowS
forall a. Pretty a => a -> ShowS
showDoc RSTables
s2 "\ncannot be united."

type Sign = RSTables

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

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

-- I hope that this works right, I do not want to debug this
apply_comp_c_map :: RSTable -> Map.Map Id Id -> RSMorphism -> RSMorphism
                 -> (Id, RSTMap)
apply_comp_c_map :: RSTable -> Map Id Id -> RSMorphism -> RSMorphism -> (Id, RSTMap)
apply_comp_c_map rst :: RSTable
rst t_map :: Map Id Id
t_map imap :: RSMorphism
imap imor :: RSMorphism
imor =
    let i :: Id
i = RSTable -> Id
t_name RSTable
rst
        c2 :: Map Id RSTMap
c2 = RSMorphism -> Map Id RSTMap
column_map RSMorphism
imor
    in case Id -> Map Id RSTMap -> Maybe RSTMap
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
i (Map Id RSTMap -> Maybe RSTMap) -> Map Id RSTMap -> Maybe RSTMap
forall a b. (a -> b) -> a -> b
$ RSMorphism -> Map Id RSTMap
column_map RSMorphism
imap of
      Just iM :: RSTMap
iM -> case Id -> Map Id RSTMap -> Maybe RSTMap
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Id -> Id -> Map Id Id -> Id
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Id
i Id
i Map Id Id
t_map) Map Id RSTMap
c2 of
        Just iM2 :: RSTMap
iM2 ->
          let c_set :: Map Id ()
c_set = [(Id, ())] -> Map Id ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Id, ())] -> Map Id ())
-> ([RSColumn] -> [(Id, ())]) -> [RSColumn] -> Map Id ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RSColumn -> (Id, ())) -> [RSColumn] -> [(Id, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ c :: RSColumn
c -> (RSColumn -> Id
c_name RSColumn
c, ())) ([RSColumn] -> Map Id ()) -> [RSColumn] -> Map Id ()
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
rst
              oM :: Map Id Id
oM = Map Id () -> Map Id Id -> Map Id Id -> Map Id Id
forall a b. Ord a => Map a b -> Map a a -> Map a a -> Map a a
composeMap Map Id ()
c_set (RSTMap -> Map Id Id
col_map RSTMap
iM) (RSTMap -> Map Id Id
col_map RSTMap
iM2)
          in (Id
i, Map Id Id -> RSTMap
RSTMap Map Id Id
oM)
        Nothing -> (Id
i, RSTMap
iM)
      Nothing -> (Id
i, RSTMap -> Id -> Map Id RSTMap -> RSTMap
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Map Id Id -> RSTMap
RSTMap Map Id Id
forall k a. Map k a
Map.empty)
                       (Id -> Id -> Map Id Id -> Id
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Id
i Id
i Map Id Id
t_map) Map Id RSTMap
c2)

-- composition of Rel morphisms
comp_rst_mor :: RSMorphism -> RSMorphism -> Result RSMorphism
comp_rst_mor :: RSMorphism -> RSMorphism -> Result RSMorphism
comp_rst_mor mor1 :: RSMorphism
mor1 mor2 :: RSMorphism
mor2 =
        let d1 :: RSTables
d1 = RSMorphism -> RSTables
domain RSMorphism
mor1
            t1 :: [RSTable]
t1 = Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
d1
            t_set :: Map Id ()
t_set = [(Id, ())] -> Map Id ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Id, ())] -> Map Id ()) -> [(Id, ())] -> Map Id ()
forall a b. (a -> b) -> a -> b
$ (RSTable -> (Id, ())) -> [RSTable] -> [(Id, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ t :: RSTable
t -> (RSTable -> Id
t_name RSTable
t, ())) [RSTable]
t1
            t_map :: Map Id Id
t_map = Map Id () -> Map Id Id -> Map Id Id -> Map Id Id
forall a b. Ord a => Map a b -> Map a a -> Map a a -> Map a a
composeMap Map Id ()
t_set (RSMorphism -> Map Id Id
table_map RSMorphism
mor1) (RSMorphism -> Map Id Id
table_map RSMorphism
mor2)
            cm_map :: Map Id RSTMap
cm_map = [(Id, RSTMap)] -> Map Id RSTMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              ([(Id, RSTMap)] -> Map Id RSTMap)
-> [(Id, RSTMap)] -> Map Id RSTMap
forall a b. (a -> b) -> a -> b
$ (RSTable -> (Id, RSTMap)) -> [RSTable] -> [(Id, RSTMap)]
forall a b. (a -> b) -> [a] -> [b]
map (\ x :: RSTable
x -> RSTable -> Map Id Id -> RSMorphism -> RSMorphism -> (Id, RSTMap)
apply_comp_c_map RSTable
x Map Id Id
t_map RSMorphism
mor1 RSMorphism
mor2) [RSTable]
t1
        in RSMorphism -> Result RSMorphism
forall (m :: * -> *) a. Monad m => a -> m a
return RSMorphism :: RSTables -> RSTables -> Map Id Id -> Map Id RSTMap -> RSMorphism
RSMorphism
                { domain :: RSTables
domain = RSTables
d1
                , codomain :: RSTables
codomain = RSMorphism -> RSTables
codomain RSMorphism
mor2
                , table_map :: Map Id Id
table_map = Map Id Id
t_map
                , column_map :: Map Id RSTMap
column_map = Map Id RSTMap
cm_map
                }

emptyRSSign :: RSTables
emptyRSSign :: RSTables
emptyRSSign = RSTables :: Set RSTable -> RSTables
RSTables
                {
                    tables :: Set RSTable
tables = Set RSTable
forall a. Set a
Set.empty
                }

-- ^ id-morphism for RS
idMor :: RSTables -> RSMorphism
idMor :: RSTables -> RSMorphism
idMor t :: RSTables
t = RSMorphism :: RSTables -> RSTables -> Map Id Id -> Map Id RSTMap -> RSMorphism
RSMorphism
            { domain :: RSTables
domain = RSTables
t
            , codomain :: RSTables
codomain = RSTables
t
            , table_map :: Map Id Id
table_map = (Map Id Id -> RSTable -> Map Id Id)
-> Map Id Id -> [RSTable] -> Map Id Id
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id Id
y x :: RSTable
x -> Id -> Id -> Map Id Id -> Map Id Id
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSTable -> Id
t_name RSTable
x) (RSTable -> Id
t_name RSTable
x) Map Id Id
y)
                          Map Id Id
forall k a. Map k a
Map.empty ([RSTable] -> Map Id Id) -> [RSTable] -> Map Id Id
forall a b. (a -> b) -> a -> b
$ Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
t
            , column_map :: Map Id RSTMap
column_map =
                    let
                        makeRSTMap :: RSTable -> Map Id Id
makeRSTMap i :: RSTable
i =
                           (Map Id Id -> RSColumn -> Map Id Id)
-> Map Id Id -> [RSColumn] -> Map Id Id
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id Id
y x :: RSColumn
x -> Id -> Id -> Map Id Id -> Map Id Id
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSColumn -> Id
c_name RSColumn
x) (RSColumn -> Id
c_name RSColumn
x) Map Id Id
y)
                                 Map Id Id
forall k a. Map k a
Map.empty ([RSColumn] -> Map Id Id) -> [RSColumn] -> Map Id Id
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
i
                    in
                        (Map Id RSTMap -> RSTable -> Map Id RSTMap)
-> Map Id RSTMap -> [RSTable] -> Map Id RSTMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id RSTMap
y x :: RSTable
x -> Id -> RSTMap -> Map Id RSTMap -> Map Id RSTMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSTable -> Id
t_name RSTable
x)
                                        (Map Id Id -> RSTMap
RSTMap (Map Id Id -> RSTMap) -> Map Id Id -> RSTMap
forall a b. (a -> b) -> a -> b
$ RSTable -> Map Id Id
makeRSTMap RSTable
x) Map Id RSTMap
y)
                                Map Id RSTMap
forall k a. Map k a
Map.empty ([RSTable] -> Map Id RSTMap) -> [RSTable] -> Map Id RSTMap
forall a b. (a -> b) -> a -> b
$ Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
t
            }

rsInclusion :: RSTables -> RSTables -> Result RSMorphism
rsInclusion :: RSTables -> RSTables -> Result RSMorphism
rsInclusion t1 :: RSTables
t1 t2 :: RSTables
t2 = RSMorphism -> Result RSMorphism
forall (m :: * -> *) a. Monad m => a -> m a
return RSMorphism :: RSTables -> RSTables -> Map Id Id -> Map Id RSTMap -> RSMorphism
RSMorphism
            { domain :: RSTables
domain = RSTables
t1
            , codomain :: RSTables
codomain = RSTables
t2
            , table_map :: Map Id Id
table_map = (Map Id Id -> RSTable -> Map Id Id)
-> Map Id Id -> [RSTable] -> Map Id Id
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id Id
y x :: RSTable
x -> Id -> Id -> Map Id Id -> Map Id Id
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSTable -> Id
t_name RSTable
x) (RSTable -> Id
t_name RSTable
x) Map Id Id
y)
                          Map Id Id
forall k a. Map k a
Map.empty ([RSTable] -> Map Id Id) -> [RSTable] -> Map Id Id
forall a b. (a -> b) -> a -> b
$ Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
t1
            , column_map :: Map Id RSTMap
column_map =
                    let
                        makeRSTMap :: RSTable -> Map Id Id
makeRSTMap i :: RSTable
i =
                           (Map Id Id -> RSColumn -> Map Id Id)
-> Map Id Id -> [RSColumn] -> Map Id Id
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id Id
y x :: RSColumn
x -> Id -> Id -> Map Id Id -> Map Id Id
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSColumn -> Id
c_name RSColumn
x) (RSColumn -> Id
c_name RSColumn
x) Map Id Id
y)
                                 Map Id Id
forall k a. Map k a
Map.empty ([RSColumn] -> Map Id Id) -> [RSColumn] -> Map Id Id
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
i
                    in
                        (Map Id RSTMap -> RSTable -> Map Id RSTMap)
-> Map Id RSTMap -> [RSTable] -> Map Id RSTMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ y :: Map Id RSTMap
y x :: RSTable
x -> Id -> RSTMap -> Map Id RSTMap -> Map Id RSTMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RSTable -> Id
t_name RSTable
x)
                                        (Map Id Id -> RSTMap
RSTMap (Map Id Id -> RSTMap) -> Map Id Id -> RSTMap
forall a b. (a -> b) -> a -> b
$ RSTable -> Map Id Id
makeRSTMap RSTable
x) Map Id RSTMap
y)
                                Map Id RSTMap
forall k a. Map k a
Map.empty ([RSTable] -> Map Id RSTMap) -> [RSTable] -> Map Id RSTMap
forall a b. (a -> b) -> a -> b
$ Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
t1
            }

-- pretty printing stuff

instance Pretty RSColumn where
    pretty :: RSColumn -> Doc
pretty c :: RSColumn
c = (if RSColumn -> Bool
c_key RSColumn
c then String -> Doc
keyword String
rsKey else Doc
empty) Doc -> Doc -> Doc
<+>
       Id -> Doc
forall a. Pretty a => a -> Doc
pretty (RSColumn -> Id
c_name RSColumn
c) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> RSDatatype -> Doc
forall a. Pretty a => a -> Doc
pretty (RSColumn -> RSDatatype
c_data RSColumn
c)

instance Pretty RSTable where
    pretty :: RSTable -> Doc
pretty t :: RSTable
t = Id -> Doc
forall a. Pretty a => a -> Doc
pretty (RSTable -> Id
t_name RSTable
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([RSColumn] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas ([RSColumn] -> Doc) -> [RSColumn] -> Doc
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
t)
               Doc -> Doc -> Doc
$+$ [Annotation] -> Doc
printAnnotationList (RSTable -> [Annotation]
rsannos RSTable
t)

instance Pretty RSTables where
    pretty :: RSTables -> Doc
pretty t :: RSTables
t = String -> Doc
keyword String
rsTables Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((RSTable -> Doc) -> [RSTable] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RSTable -> Doc
forall a. Pretty a => a -> Doc
pretty ([RSTable] -> [Doc]) -> [RSTable] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Set RSTable -> [RSTable]
forall a. Set a -> [a]
Set.toList (Set RSTable -> [RSTable]) -> Set RSTable -> [RSTable]
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
t)

instance Pretty RSTMap where
    pretty :: RSTMap -> Doc
pretty = Map Id Id -> Doc
forall a. Pretty a => a -> Doc
pretty (Map Id Id -> Doc) -> (RSTMap -> Map Id Id) -> RSTMap -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSTMap -> Map Id Id
col_map

instance Pretty RSMorphism where
    pretty :: RSMorphism -> Doc
pretty m :: RSMorphism
m = RSTables -> Doc
forall a. Pretty a => a -> Doc
pretty (RSMorphism -> RSTables
domain RSMorphism
m) Doc -> Doc -> Doc
$+$ Doc
mapsto Doc -> Doc -> Doc
<+> RSTables -> Doc
forall a. Pretty a => a -> Doc
pretty (RSMorphism -> RSTables
codomain RSMorphism
m)
                Doc -> Doc -> Doc
$+$ Map Id Id -> Doc
forall a. Pretty a => a -> Doc
pretty (RSMorphism -> Map Id Id
table_map RSMorphism
m) Doc -> Doc -> Doc
$+$ Map Id RSTMap -> Doc
forall a. Pretty a => a -> Doc
pretty (RSMorphism -> Map Id RSTMap
column_map RSMorphism
m)

instance Pretty RSSymbol where
    pretty :: RSSymbol -> Doc
pretty s :: RSSymbol
s = case RSSymbol
s of
      STable i :: Id
i -> Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
i
      SColumn i :: Id
i _ t :: RSDatatype
t k :: Bool
k -> RSColumn -> Doc
forall a. Pretty a => a -> Doc
pretty (RSColumn -> Doc) -> RSColumn -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> RSDatatype -> Bool -> RSColumn
RSColumn Id
i RSDatatype
t Bool
k

instance Show RSDatatype where
    show :: RSDatatype -> String
show dt :: RSDatatype
dt = case RSDatatype
dt of
        RSboolean -> String
rsBool
        RSbinary -> String
rsBin
        RSdate -> String
rsDate
        RSdatetime -> String
rsDatetime
        RSdecimal -> String
rsDecimal
        RSfloat -> String
rsFloat
        RSinteger -> String
rsInteger
        RSstring -> String
rsString
        RStext -> String
rsText
        RStime -> String
rsTime
        RStimestamp -> String
rsTimestamp
        RSdouble -> String
rsDouble
        RSnonPosInteger -> String
rsNonPosInteger
        RSnonNegInteger -> String
rsNonNegInteger
        RSlong -> String
rsLong
        RSPointer -> String
rsPointer

instance Pretty RSDatatype where
  pretty :: RSDatatype -> Doc
pretty = String -> Doc
keyword (String -> Doc) -> (RSDatatype -> String) -> RSDatatype -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSDatatype -> String
forall a. Show a => a -> String
show

{- we need an explicit instance declaration of Eq and Ord that
correctly deals with tables -}
instance Ord RSTable where
  compare :: RSTable -> RSTable -> Ordering
compare t1 :: RSTable
t1 t2 :: RSTable
t2 =
    (Id, Set RSColumn) -> (Id, Set RSColumn) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RSTable -> Id
t_name RSTable
t1, [RSColumn] -> Set RSColumn
forall a. Ord a => [a] -> Set a
Set.fromList ([RSColumn] -> Set RSColumn) -> [RSColumn] -> Set RSColumn
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
t1)
            (RSTable -> Id
t_name RSTable
t2, [RSColumn] -> Set RSColumn
forall a. Ord a => [a] -> Set a
Set.fromList ([RSColumn] -> Set RSColumn) -> [RSColumn] -> Set RSColumn
forall a b. (a -> b) -> a -> b
$ RSTable -> [RSColumn]
columns RSTable
t2)

instance Eq RSTable where
  a :: RSTable
a == :: RSTable -> RSTable -> Bool
== b :: RSTable
b = RSTable -> RSTable -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RSTable
a RSTable
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

isDisjoint :: RSTables -> RSTables -> Bool
isDisjoint :: RSTables -> RSTables -> Bool
isDisjoint s1 :: RSTables
s1 s2 :: RSTables
s2 =
    let
        t1 :: Set Id
t1 = (RSTable -> Id) -> Set RSTable -> Set Id
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map RSTable -> Id
t_name (Set RSTable -> Set Id) -> Set RSTable -> Set Id
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
s1
        t2 :: Set Id
t2 = (RSTable -> Id) -> Set RSTable -> Set Id
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map RSTable -> Id
t_name (Set RSTable -> Set Id) -> Set RSTable -> Set Id
forall a b. (a -> b) -> a -> b
$ RSTables -> Set RSTable
tables RSTables
s2
    in
        (Id -> Bool -> Bool) -> Bool -> Set Id -> Bool
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (\ x :: Id
x y :: Bool
y -> Bool
y Bool -> Bool -> Bool
&& (Id
x Id -> Set Id -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Id
t2)) Bool
True Set Id
t1 Bool -> Bool -> Bool
&&
        (Id -> Bool -> Bool) -> Bool -> Set Id -> Bool
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (\ x :: Id
x y :: Bool
y -> Bool
y Bool -> Bool -> Bool
&& (Id
x Id -> Set Id -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Id
t1)) Bool
True Set Id
t2