git.iko.soy/project-m36
on master help sign in
import tutoriald from https test
commit744adbaa14cd6529b2ac2c67b35578de7e6edb6c authorAgentM <agentm@themactionfaction.com> dateThu 1 Apr 2021, 23:55 (6 years ago) parent39de5a3
8 files changed+16−23
compare with master
unifiedsplit
scripts/DateExamples.tutd+2−2 scripts/multiline.tutd+2 src/bin/TutorialD/Interpreter/Base.hs+4−9 src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs−5 src/bin/TutorialD/Interpreter/Import/TutorialD.hs+1−2 src/bin/TutorialD/Interpreter/RelationalExpr.hs−1 test/TutorialD/Interpreter/Import/TutorialD.hs+2−2 test/scripts.hs+5−2
scripts/DateExamples.tutd+2−2
@@ -20,7 +20,7 @@ sp := relation{tuple{s# "S1",p# "P1",qty 300},
2020 tuple{s# "S3",p# "P2",qty 200},
2121 tuple{s# "S4",p# "P4",qty 300},
2222 tuple{s# "S4",p# "P5",qty 400}};
23−key s_pkey {s#} s
24−key p_key {p#} p
23+key s_pkey {s#} s;
24+key p_key {p#} p;
2525foreign key s_sp_fk sp{s#} in s{s#};
2626foreign key p_sp_fk sp{p#} in p{p#};
scripts/multiline.tutdnew file+2
@@ -0,0 +1,2 @@
1+x:=relation{
2+tuple{ x 2}} -- nice
src/bin/TutorialD/Interpreter/Base.hs+4−9
@@ -17,7 +17,7 @@ import ProjectM36.Relation
1717import ProjectM36.DataFrame
1818
1919#if MIN_VERSION_megaparsec(6,0,0)
20−import Text.Megaparsec.Char
20+import Text.Megaparsec.Char
2121import qualified Text.Megaparsec.Char.Lexer as Lex
2222import Text.Megaparsec
2323import Data.Void
@@ -82,14 +82,9 @@ type ParseStr = Text
8282type ParseStr = String
8383#endif
8484
85+-- consumes only horizontal spaces
8586spaceConsumer :: Parser ()
86−spaceConsumer = Lex.space (void sc) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")
87− where
88− sc = takeWhile1P (Just "horizontal whitespace") isHSpace'
89−
90−--backported from megaparsec 9
91−isHSpace' :: Char -> Bool
92−isHSpace' x = isSpace x && x /= '\n' && x /= '\r'
87+spaceConsumer = Lex.space space1 (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")
9388
9489opChar :: Parser Char
9590opChar = oneOf (":!#$%&*+./<=>?\\^|-~" :: String)-- remove "@" so it can be used as attribute marker without spaces
@@ -245,6 +240,6 @@ colonOp opStr = do
245240hex :: Parser Text
246241hex = takeWhileP (Just "hexadecimal")
247242 (\c ->
248− (c >= '0' && c <= '9')
243+ isDigit c
249244 || (c >= 'a' && c <= 'f'))
250245
src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs−5
@@ -56,11 +56,6 @@ multipleDatabaseContextExprP :: Parser DatabaseContextExpr
5656multipleDatabaseContextExprP =
5757 MultipleExpr <$> sepBy1 databaseContextExprP semi
5858
59−--good for reading from files instead of the repl
60−multilineDatabaseContextExprP :: Parser DatabaseContextExpr
61−multilineDatabaseContextExprP =
62− MultipleExpr <$> sepBy1 databaseContextExprP (nline <|> semi)
63−
6459insertP :: Parser DatabaseContextExpr
6560insertP = do
6661 reservedOp "insert"
src/bin/TutorialD/Interpreter/Import/TutorialD.hs+1−2
@@ -1,4 +1,3 @@
1−{-# LANGUAGE TypeApplications #-}
21module TutorialD.Interpreter.Import.TutorialD where
32import ProjectM36.Base
43import TutorialD.Interpreter.Import.Base
@@ -39,7 +38,7 @@ importTutorialDBytes tutdBytes =
3938 case TE.decodeUtf8' tutdBytes of
4039 Left err -> pure (Left (ImportError (ImportFileDecodeError (T.pack (show err)))))
4140 Right tutdUtf8 ->
42− case parse (multilineDatabaseContextExprP <* eof) "import" tutdUtf8 of
41+ case parse (multipleDatabaseContextExprP <* eof) "import" tutdUtf8 of
4342 --parseErrorPretty is new in megaparsec 5
4443 Left err -> pure (Left (PM36E.ParseError (T.pack (errorBundlePretty err))))
4544 Right expr -> pure (Right expr)
src/bin/TutorialD/Interpreter/RelationalExpr.hs−1
@@ -212,7 +212,6 @@ atomExprP = consumeAtomExprP True
212212consumeAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)
213213consumeAtomExprP consume = try functionAtomExprP <|>
214214 try (parens (constructedAtomExprP True)) <|>
215− try (parens relationalAtomExprP) <|>
216215 constructedAtomExprP consume <|>
217216 attributeAtomExprP <|>
218217 try nakedAtomExprP <|>
test/TutorialD/Interpreter/Import/TutorialD.hs+2−2
@@ -33,8 +33,8 @@ testTutdFileImport = TestCase $
3333testTutdHTTPSImport :: Test
3434testTutdHTTPSImport = TestCase $ do
3535 uri <- mkURI "https://raw.githubusercontent.com/agentm/project-m36/master/test/TutorialD/Interpreter/Import/httpimporttest.tutd"
36− let hash = ""
37− expected = Right NoOperation
36+ let hash = "bae2e29414d9d72e920182185d2b62aefc12aed1cc47b3b330b0e7de7432d831"
37+ expected = Right (MultipleExpr [Assign "x" (RelationVariable "true" ()),Assign "y" (RelationVariable "false" ())])
3838 actual <- importTutorialDViaHTTP uri (Just hash)
3939 assertEqual "github https" expected actual
4040
test/scripts.hs+5−2
@@ -4,6 +4,8 @@ import TutorialD.Interpreter.Import.TutorialD
44import System.Directory
55import Data.List (isSuffixOf)
66import System.Exit
7+import qualified Data.Text as T
8+import Text.URI
79
810testList :: IO Test
911testList = do
@@ -20,7 +22,8 @@ main = do
2022
2123testScript :: FilePath -> Test
2224testScript tutdFile = TestCase $ do
23− eImport <- importTutorialD tutdFile
25+ fileURI <- mkURI (T.pack ("file://" <> tutdFile))
26+ eImport <- importTutorialDFromFile fileURI Nothing
2427 case eImport of
2528 Left err -> assertFailure ("tutd import failure in " ++ tutdFile ++ ": " ++ show err)
26− Right _ -> pure ()
29+ Right _ -> pure ()