git.iko.soy/project-m36
on 62_python_dbapi help sign in
project-m36/src/bin/TutorialD/Interpreter/SchemaOperator.hs
80 lines 2.5 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
15 deriving Show
17schemaOperatorP :: Parser SchemaOperator
18schemaOperatorP = (ModifySchemaExpr <$> schemaExprP) <|>
19 setCurrentSchemaP
21setCurrentSchemaP :: Parser SchemaOperator
22setCurrentSchemaP = do
23 reserved ":setschema"
24 SetCurrentSchema <$> identifier
26schemaExprP :: Parser SchemaExpr
27schemaExprP = addSubschemaP <|>
28 removeSubschemaP
30addSubschemaP :: Parser SchemaExpr
31addSubschemaP = do
32 reserved ":addschema"
33 AddSubschema <$> identifier <*> parens (sepBy schemaIsomorphP comma)
35schemaIsomorphP :: Parser SchemaIsomorph
36schemaIsomorphP = isoRestrictP <|> isoUnionP <|> isoRenameP <|> isoPassthrough
38removeSubschemaP :: Parser SchemaExpr
39removeSubschemaP = do
40 reserved ":removeschema"
41 RemoveSubschema <$> identifier
43isoRestrictP :: Parser SchemaIsomorph
44isoRestrictP = do
45 reserved "isorestrict"
46 relVarIn <- qrelVarP
47 relvarsOut <- isoRestrictOutRelVarsP
48 IsoRestrict <$> pure relVarIn <*> restrictionPredicateP <*> pure relvarsOut
50isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)
51isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP
53qrelVarP :: Parser RelVarName
54qrelVarP = quotedString
56isoUnionP :: Parser SchemaIsomorph
57isoUnionP = do
58 reserved "isounion"
59 relVarsIn <- isoUnionInRelVarsP
60 relVarsOut <- qrelVarP
61 IsoUnion <$> pure relVarsIn <*> restrictionPredicateP <*> pure relVarsOut
63isoRenameP :: Parser SchemaIsomorph
64isoRenameP = do
65 reserved "isorename"
66 IsoRename <$> qrelVarP <*> qrelVarP
68isoPassthrough :: Parser SchemaIsomorph
69isoPassthrough = do
70 reserved "isopassthrough"
71 rv <- qrelVarP
72 pure (IsoRename rv rv)
74isoUnionInRelVarsP :: Parser (RelVarName, RelVarName)
75isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP
77evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Maybe RelationalError)
78evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr
79evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname