Lseed validator program
authorJoachim Breitner <mail@joachim-breitner.de>
Tue, 5 May 2009 22:47:43 +0000 (00:47 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Tue, 5 May 2009 22:47:43 +0000 (00:47 +0200)
src/validate.hs [new file with mode: 0644]

diff --git a/src/validate.hs b/src/validate.hs
new file mode 100644 (file)
index 0000000..8c06621
--- /dev/null
@@ -0,0 +1,31 @@
+{- 
+Helper program: Expects a L-seed grammar on stdin and outputs its validity in JSON format:
+$ echo "RULE is invalid" | ./validate 
+{"valid":false,"line":1,"column":9,"msg":"\nunexpected \"i\"\nexpecting \"WHEN\", \"BRANCH\" or \"GROW\""}
+$ echo "RULE trivial GROW BY 1" | ./validate 
+{"valid":true}
+-}
+
+import Text.Parsec.Error
+import Text.Parsec.Pos
+import Lseed.Grammar.Parse
+import Text.JSON
+
+valid = encode $ makeObj [ ("valid", showJSON True) ]
+
+invalid error = encode $ makeObj
+       [ ("valid", showJSON False)
+       , ("line",  showJSON . sourceLine .   errorPos $ error) 
+       , ("column",showJSON . sourceColumn . errorPos $ error) 
+       , ("msg",   showJSON .
+                   showErrorMessages "or" "unknown parse error"
+                                      "expecting" "unexpected" "end of input" .
+                    errorMessages $ error)
+       ]
+
+main = do
+       file <- getContents
+       case parseGrammar "stdin" file of
+         Left error -> putStrLn $ invalid error
+         Right _ -> putStrLn valid