AS.der.hs revision e9458b1a7a19a63aa4c179f9ab20f4d50681c168
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowski{-# LANGUAGE DeriveDataTypeable #-}
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill MossakowskiDescription : abstract syntax for Relational Schemes
1ac0c4de66a297fd7e345d9275f723fd83bb7bd1Christian MaederCopyright : Dominik Luecke, Uni Bremen 2008
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : luecke@informatik.uni-bremen.de
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill MossakowskiStability : provisional
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill MossakowskiPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederAbstract syntax for Relational Schemes
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder ( RSRelType (..)
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder , RSQualId (..)
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowski , RSRelationships (..)
d9b1a9c8fce2e68aaf4a8b415ab40ab461a1b488cmaeder , RSScheme (..)
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder , getSignature
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowskiimport qualified Data.Map as Map
b161fda9df774b071a907cc9b18f0e7aee244129cmaeder-- DrIFT command
d9b1a9c8fce2e68aaf4a8b415ab40ab461a1b488cmaeder{-! global: GetRange !-}
ad270004874ce1d0697fb30d7309f180553bb315Christian Maederdata RSRelType = RSone_to_one | RSone_to_many | RSmany_to_one | RSmany_to_many
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowski deriving (Eq, Ord, Typeable, Data)
b161fda9df774b071a907cc9b18f0e7aee244129cmaeder-- first Id is TableId, second is columnId
b161fda9df774b071a907cc9b18f0e7aee244129cmaederdata RSQualId = RSQualId
b161fda9df774b071a907cc9b18f0e7aee244129cmaeder table :: Id
b161fda9df774b071a907cc9b18f0e7aee244129cmaeder , column :: Id
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder , q_pos :: Range
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maeder deriving (Eq, Ord, Show, Typeable, Data)
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maederdata RSRel = RSRel
0db76fa4de562d31f829d0113500e70771f0852dcmaeder r_lhs :: [RSQualId]
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowski , r_rhs :: [RSQualId]
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder , r_type :: RSRelType
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder , r_pos :: Range
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder deriving (Eq, Ord, Show, Typeable, Data)
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaederdata RSRelationships = RSRelationships [Annoted RSRel] Range
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder deriving (Eq, Ord, Show, Typeable, Data)
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaederdata RSScheme = RSScheme RSTables RSRelationships Range
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder deriving (Eq, Ord, Show, Typeable, Data)
2857cf346f2387af92b04a43c41e829c00664ed1cmaedertype Sentence = RSRel
3a6decfd748f532d5cb03fbcb7a42fa37b0faab3Christian Maeder-- Pretty printing stuff
f04d7c1dac7b1dc835e63c671027455f8db17837Christian Maederinstance Pretty RSScheme where
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder pretty (RSScheme t r _) = pretty t $++$ pretty r
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaederinstance Pretty RSRelationships where
aa0ef8adb2833838c1954e6f93c61d85d2cb226aTill Mossakowski pretty (RSRelationships rs _) = if null rs then empty else
d9b1a9c8fce2e68aaf4a8b415ab40ab461a1b488cmaeder keyword rsRelationships $+$ vcat (map pretty rs)
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaederinstance Pretty RSRel where
d9b1a9c8fce2e68aaf4a8b415ab40ab461a1b488cmaeder pretty (RSRel i1 i2 tp _) =
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich let tbl is = case is of
e24ad3f655daa60ddabe690e4b11de3187996c16cmaeder [] -> empty
e24ad3f655daa60ddabe690e4b11de3187996c16cmaeder t : _ -> pretty (table t)
90fbaf1cd73486129e26e1ac94a413550832e4d6Thiemo Wiedemeyer <> brackets (ppWithCommas is)
90fbaf1cd73486129e26e1ac94a413550832e4d6Thiemo Wiedemeyer in fsep [tbl i1, funArrow, tbl i2, keyword (show tp)]
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maederinstance Pretty RSQualId where
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maeder pretty = pretty . column
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maederinstance Show RSRelType where
1d3635d5ca4cfbe47c3f1add3790f68b6c76c57dChristian Maeder show r = case r of
1d3635d5ca4cfbe47c3f1add3790f68b6c76c57dChristian Maeder RSone_to_one -> rs1to1
1d3635d5ca4cfbe47c3f1add3790f68b6c76c57dChristian Maeder RSone_to_many -> rs1tom
1d3635d5ca4cfbe47c3f1add3790f68b6c76c57dChristian Maeder RSmany_to_one -> rsmto1
1d3635d5ca4cfbe47c3f1add3790f68b6c76c57dChristian Maeder RSmany_to_many -> rsmtom
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maedermap_qualId :: RSMorphism -> RSQualId -> Result RSQualId
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maedermap_qualId mor qid =
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maeder (tid, rid, rn) = case qid of
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maeder RSQualId i1 i2 rn1 -> (i1, i2, rn1)
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maeder in maybe (fail "map_qualId") return $ do
eb9c04f9cff47a81f6d362ca03fbf4cb7ab97e7ccmaeder mtid <- Map.lookup tid $ table_map mor
f094a7999dfa79cad2eb34ce15f1939c0d6b9e39Till Mossakowski rmor <- Map.lookup tid $ column_map mor
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maeder mrid <- Map.lookup rid $ col_map rmor
c44c23429c72f3a709e22a18f2ed6f05fc8cc765Christian Maeder return $ RSQualId mtid mrid rn
f094a7999dfa79cad2eb34ce15f1939c0d6b9e39Till Mossakowskimap_rel :: RSMorphism -> RSRel -> Result RSRel
2eb18519bf2f61e04ffbe68ab06ec1e32eee07d7Christian Maedermap_rel mor rel =
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian Maeder (q1, q2, rt, rn) = case rel of
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder RSRel qe1 qe2 rte rne -> (qe1, qe2, rte, rne)
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder mq1 <- mapM (map_qualId mor) q1
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder mq2 <- mapM (map_qualId mor) q2
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder return $ RSRel mq1 mq2 rt rn
135bcb7f65991146c103e5e7599adbc49fe7359dChristian Maedermap_arel :: RSMorphism -> (Annoted RSRel) -> Result (Annoted RSRel)
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maedermap_arel mor arel =
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder rel = item arel
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maeder (q1, q2, rt, rn) = case rel of
4ef05f4edeb290beb89845f57156baa5298af7c4Christian Maeder RSRel qe1 qe2 rte rne -> (qe1, qe2, rte, rne)
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder mq1 <- mapM (map_qualId mor) q1
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder mq2 <- mapM (map_qualId mor) q2
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder return $ arel
b6a54d7292d7a3713000847334de4316d105f40fChristian Maeder item = RSRel mq1 mq2 rt rn
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maedermap_relships :: RSMorphism -> RSRelationships -> Result RSRelationships
b6a54d7292d7a3713000847334de4316d105f40fChristian Maedermap_relships mor rsh =
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder (arel, rn) = case rsh of
ef7cdc5bb04f4c0d1a14cbd3008959edd2d6336cChristian Maeder RSRelationships arel1 rn1 -> (arel1, rn1)
3fe4d4988c6d17ce5df9b413af03944114dc5d63Christian Maeder orel <- mapM (map_arel mor) arel
3a6decfd748f532d5cb03fbcb7a42fa37b0faab3Christian Maeder return $ RSRelationships orel rn
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- ^ oo-style getter function for Relations
80c2d23821d095b55d9a547f48fc3fcdc27df405Christian MaedergetRels :: RSScheme -> [Annoted RSRel]
b6a54d7292d7a3713000847334de4316d105f40fChristian MaedergetRels spec = case spec of
b418a0262aa84ea68de72623793361bebed51f9eChristian Maeder RSScheme _ (RSRelationships rels _) _ -> rels
177b47384142a17a086bf08966097e9c624d7891Christian Maeder-- ^ oo-style getter function for signatures
177b47384142a17a086bf08966097e9c624d7891Christian MaedergetSignature :: RSScheme -> RSTables
177b47384142a17a086bf08966097e9c624d7891Christian MaedergetSignature spec = case spec of
177b47384142a17a086bf08966097e9c624d7891Christian Maeder RSScheme tb _ _ -> tb