git.iko.soy/project-m36
on ca59541 help sign in
project-m36/src/bin/TutorialD/Interpreter/SchemaOperator.hs
66 lines 2.1 kB history raw
1module TutorialD.Interpreter.SchemaOperator where
2import Text.Megaparsec
3import Text.Megaparsec.Text
5import ProjectM36.Base
6import ProjectM36.IsomorphicSchema
7import ProjectM36.Session
8import ProjectM36.Client
9import ProjectM36.Error
10import TutorialD.Interpreter.RelationalExpr
11import TutorialD.Interpreter.Base
13data SchemaOperator = ModifySchemaExpr SchemaExpr |
14 SetCurrentSchema SchemaName
16schemaOperatorP :: Parser SchemaOperator
17schemaOperatorP = (ModifySchemaExpr <$> schemaExprP) <|>
18 setCurrentSchemaP
20setCurrentSchemaP :: Parser SchemaOperator
21setCurrentSchemaP = do
22 reserved ":setschema"
23 SetCurrentSchema <$> identifier
25schemaExprP :: Parser SchemaExpr
26schemaExprP = addSubschemaIsoMorphP <|>
27 addSubschemaP
29addSubschemaP :: Parser SchemaExpr
30addSubschemaP = do
31 reserved ":addsubschema"
32 AddSubschema <$> identifier
34addSubschemaIsoMorphP :: Parser SchemaExpr
35addSubschemaIsoMorphP = do
36 reserved ":addsubschemaisomorph"
37 AddSubschemaIsomorph <$> identifier <*> schemaIsomorphP
39schemaIsomorphP :: Parser SchemaIsomorph
40schemaIsomorphP = isoRestrictP <|> isoUnionP
42isoRestrictP :: Parser SchemaIsomorph
43isoRestrictP = do
44 reserved "isorestrict"
45 relVarIn <- qrelVarP
46 relvarsOut <- isoRestrictOutRelVarsP
47 IsoRestrict <$> pure relVarIn <*> restrictionPredicateP <*> pure relvarsOut
49isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)
50isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP
52qrelVarP :: Parser RelVarName
53qrelVarP = quotedString
55isoUnionP :: Parser SchemaIsomorph
56isoUnionP = do
57 reserved "isounion"
58 IsoUnion <$> isoUnionInRelVarsP <*> restrictionPredicateP <*> qrelVarP
60isoUnionInRelVarsP :: Parser (RelVarName, RelVarName)
61isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP
63evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Maybe RelationalError)
64evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr
65evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname