ParseRS.hs revision 3d3889e0cefcdce9b3f43c53aaa201943ac2e895
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos{- |
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosModule : $Header$
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosDescription : abstract syntax for Relational Schemes
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosCopyright : Dominik Luecke, Uni Bremen 2008
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosLicense : GPLv2 or higher, see LICENSE.txt or LIZENZ.txt
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosMaintainer : luecke@informatik.uni-bremen.de
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosStability : provisional
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosPortability : portable
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosParser for Relational Schemes
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos-}
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordosmodule RelationalScheme.ParseRS
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos (
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos parseRSScheme
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos , testParse
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos , longTest
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall )
5ca0e3ebbca3f4e6e71a985eaaef02346d81df44Laszlo Hordos where
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Common.AS_Annotation
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Common.AnnoState
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Common.Id
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Common.Lexer
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Common.Parsec
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordosimport Common.GlobalAnnotations (PrefixMap)
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Control.Monad
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordosimport RelationalScheme.AS
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordosimport RelationalScheme.Keywords
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordosimport RelationalScheme.Sign
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordosimport Text.ParserCombinators.Parsec
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hallimport Text.ParserCombinators.Parsec.Error
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordosimport qualified Data.Set as Set
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordosimport qualified Data.Map as Map
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos-- ^ parse a simple word not in 'rskeywords'
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallrsVarId :: [String] -> AParser st Token
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosrsVarId ks =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos do
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall tk <- pToken $ reserved (ks ++ rsKeyWords) scanAnyWords
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall addAnnos
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall return tk
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallparseRSScheme :: PrefixMap -> AParser st RSScheme
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallparseRSScheme _ =
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos spaces
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos pos1 <- getPos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos tb <- parseRSTables
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos rl <- parseRSRelationships
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall pos2 <- getPos
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall return $ RSScheme tb rl $ Range [pos1, pos2]
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall-- ^ Parser for set of relationships
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallparseRSRelationships :: AParser st RSRelationships
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosparseRSRelationships =
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos k <- try $ asKey rsRelationships
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos r <- many parseRSRel
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos return $ RSRelationships r $ catRange [k]
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos <|>
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall return (RSRelationships [] nullRange)
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall-- ^ Parser for a single relationship
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis HallparseRSRel :: AParser st (Annoted RSRel)
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallparseRSRel =
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall do
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall la <- getAnnos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos l <- parseRSQualId
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos k <- asKey rsArrow
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall r <- parseRSQualId
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall c <- parseRSRelTypes
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall ra <- getAnnos
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall return $ makeAnnoted la ra (RSRel l r c $ tokPos k)
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall-- ^ Parser for qualified Ids...
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSQualId :: AParser st [RSQualId]
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSQualId =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos tn <- rsVarId []
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos oBracketT
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos cn <- sepBy1 (rsVarId []) commaT
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall cBracketT
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall let out = map
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall (\ x -> RSQualId (simpleIdToId tn) (simpleIdToId x) $ tokPos x)
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall cn
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall return out
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos-- ^ parser for collection of tables
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSTables :: AParser st RSTables
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSTables =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos try $ asKey rsTables
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall t <- many parseRSTable
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall ot <- setConv t
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall return RSTables
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall {
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall tables = ot
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall }
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos <|>
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall return RSTables
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall {
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall tables = Set.empty
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall }
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis HallsetCol :: (Monad m) => [RSColumn] -> m (Set.Set RSColumn)
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis HallsetCol t =
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall let
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall names = map c_name t
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall in
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall do
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall foldM_ (flip insertUnique) Set.empty names
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos return $ foldl (flip Set.insert) Set.empty t
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordossetConv :: (Monad m) => [RSTable] -> m (Set.Set RSTable)
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordossetConv t =
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall let
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall names = map t_name t
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall in
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall do
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall foldM_ (flip insertUnique) Set.empty names
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall return $ foldl (flip Set.insert) Set.empty t
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosinsertUnique :: (Monad m) => Id -> Set.Set Id -> m (Set.Set Id)
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosinsertUnique t s =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos if t `Set.notMember` s then return $ Set.insert t s
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos else fail $ "Duplicate definition of " ++ show t
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall
f5e7b140a6b831b5e1752ffabad257914de758e1Travis Hall-- ^ parser for table
f5e7b140a6b831b5e1752ffabad257914de758e1Travis HallparseRSTable :: AParser st RSTable
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis HallparseRSTable =
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall do
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall la <- getAnnos
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall tid <- rsVarId []
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall oParenT
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos cl <- sepBy1 parseRSColumn commaT
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos let ccl = concat cl
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos setCol ccl
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos cParenT
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall ra <- getAnnos
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall return RSTable
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall {
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall t_name = simpleIdToId tid
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall , columns = ccl
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos , rsannos = la ++ ra
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos , t_keys = Set.fromList
c423abe89cd6f03ff5859228bd76976ba7279e27omebold $ map (\ x -> (c_name x, c_data x))
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos $ filter c_key ccl
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos }
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseEntry :: AParser st (Token, Bool)
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseEntry =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos iK <- look4Key
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos iid <- rsVarId []
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos return (iid, iK)
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSColumn :: AParser st [RSColumn]
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordosparseRSColumn =
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos iid <- sepBy1 parseEntry commaT
c423abe89cd6f03ff5859228bd76976ba7279e27omebold colonT
c423abe89cd6f03ff5859228bd76976ba7279e27omebold dt <- parseRSDatatypes
c423abe89cd6f03ff5859228bd76976ba7279e27omebold return $ map (\ (x, y) -> RSColumn (simpleIdToId x) dt y) iid
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
c423abe89cd6f03ff5859228bd76976ba7279e27omeboldlook4Key :: AParser st Bool
4b262c59b0803d047e8ed5c9837925ec9dcdb09comeboldlook4Key =
c423abe89cd6f03ff5859228bd76976ba7279e27omebold do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos asKey rsKey
c423abe89cd6f03ff5859228bd76976ba7279e27omebold return True
c423abe89cd6f03ff5859228bd76976ba7279e27omebold <|>
c423abe89cd6f03ff5859228bd76976ba7279e27omebold return False
c423abe89cd6f03ff5859228bd76976ba7279e27omebold
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordostestParse :: GenParser tok (AnnoState ()) a
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos -> [tok]
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos -> Either Text.ParserCombinators.Parsec.Error.ParseError a
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordostestParse par = runParser par (emptyAnnos ()) ""
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordoslongTest :: IO (Either ParseError RSScheme)
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo HordoslongTest = do
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos x <- readFile "RelationalScheme/test/rel.het"
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos return $ testParse (parseRSScheme Map.empty) x
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos-- boring parser for rel types
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosparseRSRelTypes :: AParser st RSRelType
0901148a508a9c433851a650cd8eb52899d1222bLaszlo HordosparseRSRelTypes =
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos do
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos asKey rs1to1
47196c962e3caf7cdf7ea5d00ccdefc9f208bdceLaszlo Hordos return RSone_to_one
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos <|>
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos do
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos asKey rs1tom
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos return RSone_to_many
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos <|>
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos do
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos asKey rsmto1
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos return RSmany_to_one
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall <|>
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall do
5ca0e3ebbca3f4e6e71a985eaaef02346d81df44Laszlo Hordos asKey rsmtom
9c4d05edc8e0887d3aad788027d46d5afedb3ee0Travis Hall return RSmany_to_many
0901148a508a9c433851a650cd8eb52899d1222bLaszlo Hordos
-- boring parser for data-types
parseRSDatatypes :: AParser st RSDatatype
parseRSDatatypes =
do
asKey rsBool
return RSboolean
<|>
do
asKey rsBin
return RSbinary
<|>
do
asKey rsDate
return RSdate
<|>
do
asKey rsDatetime
return RSdatetime
<|>
do
asKey rsDecimal
return RSdecimal
<|>
do
asKey rsFloat
return RSfloat
<|>
do
asKey rsInteger
return RSinteger
<|>
do
asKey rsString
return RSstring
<|>
do
asKey rsText
return RStext
<|>
do
asKey rsTime
return RStime
<|>
do
asKey rsTimestamp
return RStimestamp
<|>
do
asKey rsDouble
return RSdouble
<|>
do
asKey rsNonPosInteger
return RSnonPosInteger
<|>
do
asKey rsNonNegInteger
return RSnonNegInteger
<|>
do
asKey rsLong
return RSlong
<|>
do
asKey rsPointer
return RSPointer
makeAnnoted :: [Annotation] -> [Annotation] -> a -> Annoted a
makeAnnoted l r sen = Annoted
{
item = sen
, l_annos = l
, r_annos = r
, opt_pos = nullRange
}