diff --git a/CHANGELOG.md b/CHANGELOG.md index 1000288..5b5cfcb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,4 +4,4 @@ * We have a basic parser and a very naive evaluator for datalog programs that can extend a database with all the facts which are immediate consequences of the rules and the current (initially empty) relations, which can be iterated to a fixed point to produce all consequences. - +* Added some prettyprinters and a separate parser for conjunctive queries which we needed for the web frontend. diff --git a/src/Datalog/Parser.hs b/src/Datalog/Parser.hs index 571ab39..b92d182 100644 --- a/src/Datalog/Parser.hs +++ b/src/Datalog/Parser.hs @@ -2,10 +2,12 @@ module Datalog.Parser ( parseTerm , parseAtom , parseRule + , parseQuery , parseProgram ) where +import Control.Applicative (liftA2) import Datalog.Syntax import Data.Text (Text) import Data.Text qualified as T @@ -36,7 +38,7 @@ comma = () <$ symbol "," period = () <$ symbol "." parseCon :: (MonadParsec e Text m) => m Term -parseCon = Con . ConId . T.pack <$> lexeme (many alphaNumChar) +parseCon = Con . ConId . T.pack <$> lexeme (liftA2 (:) (numberChar <|> lowerChar) (many alphaNumChar)) parseVar :: (MonadParsec e Text m) => m Term parseVar = Var . VarId . T.pack <$> lexeme (liftA2 (:) upperChar (many alphaNumChar)) @@ -50,6 +52,9 @@ parseAtom = do args <- parens (parseTerm `sepBy` comma) return (Atom rel args) +parseQuery :: Parser [Atom] +parseQuery = parseAtom `sepBy` comma + parseFact :: Parser Rule parseFact = do headAtom <- parseAtom @@ -59,7 +64,7 @@ parseFact = do parseRule :: Parser Rule parseRule = try parseFact <|> do headAtom <- parseAtom <* symbol ":-" - bodyAtoms <- parseAtom `sepBy` comma + bodyAtoms <- parseQuery period return (headAtom :- bodyAtoms) diff --git a/src/Datalog/Syntax.hs b/src/Datalog/Syntax.hs index 5982e7a..7ed4939 100644 --- a/src/Datalog/Syntax.hs +++ b/src/Datalog/Syntax.hs @@ -58,3 +58,29 @@ instance HasConstants Rule where instance HasConstants Program where constants (Program rs) = constants rs + +class Pretty t where + pretty :: t -> Text + +instance Pretty ConId where + pretty (ConId t) = t + +instance Pretty VarId where + pretty (VarId t) = t + +instance Pretty RelId where + pretty (RelId t) = t + +instance Pretty Term where + pretty (Con conId) = pretty conId + pretty (Var varId) = pretty varId + +instance Pretty Atom where + pretty (Atom relId terms) = pretty relId <> "(" <> T.intercalate "," (map pretty terms) <> ")" + +instance Pretty Rule where + pretty (h :- []) = pretty h <> "." + pretty (h :- ts) = pretty h <> " :- " <> T.intercalate ", " (map pretty ts) <> "." + +instance Pretty Program where + pretty (Program rs) = T.unlines (map pretty rs)