b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel{- |

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselModule : $Header$

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselDescription : abstract syntax for Relational Schemes

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselCopyright : Dominik Luecke, Uni Bremen 2008

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselLicense : GPLv2 or higher or LIZENZ.txt

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselMaintainer : luecke@informatik.uni-bremen.de

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselStability : provisional

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselPortability : portable

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake FeaselAbstract syntax for Relational Schemes

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel-}

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselmodule RelationalScheme.AS

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel (

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel RSRelType(..)

da116edbfb79f5ad53b65bd43a928900c2c0459aJake Feasel , RSQualId(..)

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel , RSRel(..)

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel , RSRelationships(..)

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feasel , RSScheme(..)

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel , Sentence

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel , map_rel

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel , getRels

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel , getSignature

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel )

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel where

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feaselimport Common.Id

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feaselimport Common.AS_Annotation

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feaselimport Common.Doc

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselimport Common.DocUtils

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselimport RelationalScheme.Keywords

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselimport RelationalScheme.Sign

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselimport qualified Data.Map as Map

b412f3c08f7621383d949c49539fa6c0a1644bf3Jake Feaselimport Common.Result

dc53767f6614db736c8a95a165beae870ac1e3d9Jake Feasel

-- DrIFT command

{-! global: GetRange !-}

data RSRelType = RSone_to_one | RSone_to_many | RSmany_to_one | RSmany_to_many

deriving (Eq, Ord)

-- first Id is TableId, second is columnId

data RSQualId = RSQualId

{

table :: Id

, column :: Id

, q_pos :: Range

}

deriving (Eq, Ord)

data RSRel = RSRel

{

r_lhs :: [RSQualId]

, r_rhs :: [RSQualId]

, r_type :: RSRelType

, r_pos :: Range

}

deriving (Eq, Ord)

data RSRelationships = RSRelationships [Annoted RSRel] Range

deriving (Eq, Ord)

data RSScheme = RSScheme RSTables RSRelationships Range

deriving (Eq, Ord)

type Sentence = RSRel

-- Pretty printing stuff

instance Show RSScheme where

show s = case s of

RSScheme t r _ -> (show t) ++ "\n" ++ (show r)

instance Show RSRelationships where

show r = case r of

RSRelationships r1 _ ->

case r1 of

[] -> ""

_ -> rsRelationships ++ "\n" ++

(unlines $ map (show . item) r1)

instance Show RSRel where

show r = case r of

RSRel i1 i2 tp _ ->

let

hi1 = case head $ i1 of

RSQualId a _ _ -> a

hi2 = case head $ i2 of

RSQualId a _ _ -> a

in

show hi1 ++ "[" ++ (concatComma $ map show i1) ++ "] " ++ rsArrow ++ " "++

show hi2 ++ "[" ++ (concatComma $ map show i2) ++ "]" ++ show tp

instance Show RSQualId where

show q = case q of

RSQualId _ i2 _ -> (show i2)

instance Show RSRelType where

show r = case r of

RSone_to_one -> rs1to1

RSone_to_many -> rs1tom

RSmany_to_one -> rsmto1

RSmany_to_many -> rsmtom

instance Pretty RSScheme where

pretty = text . show

instance Pretty RSRel where

pretty = text . show

map_qualId :: RSMorphism -> RSQualId -> Result RSQualId

map_qualId mor qid =

let

(tid, rid, rn) = case qid of

RSQualId i1 i2 rn1 -> (i1, i2,rn1)

in maybe (fail "map_qualId") return $ do

mtid <- Map.lookup tid $ table_map mor

rmor <- Map.lookup tid $ column_map mor

mrid <- Map.lookup rid $ col_map rmor

return $ RSQualId mtid mrid rn

map_rel :: RSMorphism -> RSRel -> Result RSRel

map_rel mor rel =

let

(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 $ RSRel mq1 mq2 rt 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 spec = case spec of

RSScheme _ (RSRelationships rels _) _ -> rels

-- ^ oo-style getter function for signatures

getSignature :: RSScheme -> RSTables

getSignature spec = case spec of

RSScheme tb _ _ -> tb