src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs · project-m36

git.iko.soy/project-m36

project-m36/src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs

43 lines 1.8 kB history raw

1--compiling the script requires the IO monad because it must load modules from the filesystem, so we create the function and generate the requisite DatabaseExpr here.

2module TutorialD.Interpreter.DatabaseContextIOOperator where

3import ProjectM36.Base

5import TutorialD.Interpreter.Base

6import TutorialD.Interpreter.Types

7import Text.Megaparsec

8import Text.Megaparsec.Text

9import Data.Text

11addAtomFunctionExprP :: Parser DatabaseContextIOExpr

12addAtomFunctionExprP = dbioexprP "addatomfunction" AddAtomFunction

14addDatabaseContextFunctionExprP :: Parser DatabaseContextIOExpr

15addDatabaseContextFunctionExprP = dbioexprP "adddatabasecontextfunction" AddDatabaseContextFunction

17dbioexprP :: String -> (Text -> [TypeConstructor] -> Text -> DatabaseContextIOExpr) -> Parser DatabaseContextIOExpr

18dbioexprP res adt = do

19 reserved res

20 funcName <- quotedString

21 funcType <- atomTypeSignatureP

22 funcScript <- quotedString

23 pure $ adt funcName funcType funcScript

25atomTypeSignatureP :: Parser [TypeConstructor]

26atomTypeSignatureP = sepBy typeConstructorP arrow

28dbContextIOExprP :: Parser DatabaseContextIOExpr

29dbContextIOExprP = addAtomFunctionExprP <|>

30 addDatabaseContextFunctionExprP <|>

31 loadAtomFunctionsP <|>

32 loadDatabaseContextFunctionsP

34loadAtomFunctionsP :: Parser DatabaseContextIOExpr

35loadAtomFunctionsP = do

36 reserved "loadatomfunctions"

37 LoadAtomFunctions <$> quotedString <*> quotedString <*> fmap unpack quotedString

39loadDatabaseContextFunctionsP :: Parser DatabaseContextIOExpr

40loadDatabaseContextFunctionsP = do

41 reserved "loaddatabasecontextfunctions"

42 LoadDatabaseContextFunctions <$> quotedString <*> quotedString <*> fmap unpack quotedString