git.iko.soy/project-m36
on dc3ee07 help sign in
project-m36/src/bin/TutorialD/Interpreter/SchemaOperator.hs
79 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 TutorialD.Interpreter.RelationalExpr
10import TutorialD.Interpreter.Base
12data SchemaOperator = ModifySchemaExpr SchemaExpr |
13 SetCurrentSchema SchemaName
14 deriving Show
16schemaOperatorP :: Parser SchemaOperator
17schemaOperatorP = (ModifySchemaExpr <$> schemaExprP) <|>
18 setCurrentSchemaP
20setCurrentSchemaP :: Parser SchemaOperator
21setCurrentSchemaP = do
22 reserved ":setschema"
23 SetCurrentSchema <$> identifier
25schemaExprP :: Parser SchemaExpr
26schemaExprP = addSubschemaP <|>
27 removeSubschemaP
29addSubschemaP :: Parser SchemaExpr
30addSubschemaP = do
31 reserved ":addschema"
32 AddSubschema <$> identifier <*> parens (sepBy schemaIsomorphP comma)
34schemaIsomorphP :: Parser SchemaIsomorph
35schemaIsomorphP = isoRestrictP <|> isoUnionP <|> isoRenameP <|> isoPassthrough
37removeSubschemaP :: Parser SchemaExpr
38removeSubschemaP = do
39 reserved ":removeschema"
40 RemoveSubschema <$> identifier
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 relVarsIn <- isoUnionInRelVarsP
59 relVarsOut <- qrelVarP
60 IsoUnion <$> pure relVarsIn <*> restrictionPredicateP <*> pure relVarsOut
62isoRenameP :: Parser SchemaIsomorph
63isoRenameP = do
64 reserved "isorename"
65 IsoRename <$> qrelVarP <*> qrelVarP
67isoPassthrough :: Parser SchemaIsomorph
68isoPassthrough = do
69 reserved "isopassthrough"
70 rv <- qrelVarP
71 pure (IsoRename rv rv)
73isoUnionInRelVarsP :: Parser (RelVarName, RelVarName)
74isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP
76evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Either RelationalError ())
77evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr
78evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname