git.iko.soy/project-m36
on da528b7 help sign in
project-m36/TutorialD/Interpreter/Base.hs
79 lines 2.7 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module TutorialD.Interpreter.Base where
3import Text.Parsec
4import Text.Parsec.String
5import qualified Text.Parsec.Token as Token
6import Text.Parsec.Language
7import ProjectM36.Base
8import qualified Data.Text as T
9import qualified Data.List as L
10import qualified Data.Vector as V
11import qualified Data.Text.IO as TIO
12import System.IO
14lexer :: Token.TokenParser ()
15lexer = Token.makeTokenParser tutD
16 where tutD = emptyDef {
17 Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],
18 Token.reservedNames = [],
19 Token.identStart = letter <|> char '_',
20 Token.opLetter = oneOf ":!#$%&*+./<=>?\\^|-~", -- remove "@" so it can be used as attribute marker without spaces
21 Token.identLetter = alphaNum <|> char '_' <|> char '#'} -- # needed for Date examples
23parens :: Parser a -> Parser a
24parens = Token.parens lexer
26reservedOp :: String -> Parser ()
27reservedOp = Token.reservedOp lexer
29reserved :: String -> Parser ()
30reserved = Token.reserved lexer
32braces :: Parser a -> Parser a
33braces = Token.braces lexer
35identifier :: Parser String
36identifier = Token.identifier lexer
38comma :: Parser String
39comma = Token.comma lexer
41semi :: Parser String
42semi = Token.semi lexer
44whiteSpace :: Parser ()
45whiteSpace = Token.whiteSpace lexer
47integer :: Parser (Integer)
48integer = Token.integer lexer
50atomTypeToTutDType :: AtomType -> Maybe T.Text
51atomTypeToTutDType atomType = case atomType of
52 StringAtomType -> Just "char"
53 IntAtomType -> Just "int"
54 RelationAtomType attrs -> Just $ "relation" `T.append` showRelationAttributes attrs
55 _ -> Nothing
57showRelationAttributes :: Attributes -> T.Text
58showRelationAttributes attrs = "{" `T.append` T.concat (L.intersperse ", " $ map showAttribute attrsL) `T.append` "}"
59 where
60 showAttribute (Attribute name atomType) = name `T.append` " " `T.append` case atomTypeToTutDType atomType of
61 Just t -> t
62 Nothing -> "unknown"
63 attrsL = V.toList attrs
65data TutorialDOperatorResult = QuitResult |
66 DisplayResult StringType |
67 DisplayIOResult (IO ()) |
68 DisplayErrorResult StringType |
69 QuietSuccessResult
71type TransactionGraphWasUpdated = Bool
73displayOpResult :: TutorialDOperatorResult -> IO ()
74displayOpResult QuitResult = return ()
75displayOpResult (DisplayResult out) = TIO.putStrLn out
76displayOpResult (DisplayIOResult ioout) = ioout
77displayOpResult (DisplayErrorResult err) = TIO.hPutStrLn stderr ("ERR: " `T.append` err)
78displayOpResult QuietSuccessResult = return ()