wip - have fun

datalog/src/Datalog/Parser.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE MultilineStrings #-}
+
 module Datalog.Parser
     ( parseTerm
     , parseAtom
@@ -14,6 +16,7 @@ import Data.Void (Void)
 import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer qualified as L
+import Text.Pretty.Simple
 
 type Parser = Parsec Void Text
 
@@ -36,36 +39,63 @@ comma, period :: (MonadParsec e Text m) => m ()
 comma = () <$ symbol ","
 period = () <$ symbol "."
 
-parseCon :: (MonadParsec e Text m) => m Term
+parseCon :: (MonadParsec e Text m) => m (Term' SrcLoc)
-parseCon = Con () . ConId . T.pack <$> lexeme (liftA2 (:) (numberChar <|> lowerChar) (many alphaNumChar))
+parseCon = Con dummy . ConId . T.pack <$> lexeme (liftA2 (:) (numberChar <|> lowerChar) (many alphaNumChar))
 
-parseVar :: (MonadParsec e Text m) => m Term
+parseVar :: (MonadParsec e Text m) => m (Term' SrcLoc)
-parseVar = Var () . VarId . T.pack <$> lexeme (liftA2 (:) upperChar (many alphaNumChar))
+parseVar = Var dummy . VarId . T.pack <$> lexeme (liftA2 (:) upperChar (many alphaNumChar))
 
-parseTerm :: Parser Term
+parseTerm :: Parser (Term' SrcLoc)
 parseTerm = parseVar <|> parseCon
 
-parseAtom :: Parser Atom
+parseAtom :: Parser (Atom' SrcLoc)
 parseAtom = do
+  p <- getSourcePos
   rel <- RelId . T.pack <$> lexeme (liftA2 (:) lowerChar (many alphaNumChar))
   args <- parens (parseTerm `sepBy` comma)
-  return (Atom () rel args)
+  return (Atom SrcLoc{start = p} rel args)
 
-parseQuery :: Parser [Atom]
+parseQuery :: Parser [Atom' SrcLoc]
 parseQuery = parseAtom `sepBy` comma
 
-parseFact :: Parser Rule
+parseFact :: Parser (Rule' SrcLoc)
 parseFact = do
+  p <- getSourcePos
   headAtom <- parseAtom
   period
-  return (headAtom :- [])
+  return (Rule SrcLoc{start = p} headAtom [])
 
-parseRule :: Parser Rule
+parseRule :: Parser (Rule' SrcLoc)
 parseRule = try parseFact <|> do
+  p <- getSourcePos
   headAtom <- parseAtom <* symbol ":-"
   bodyAtoms <- parseQuery
   period
-  return (headAtom :- bodyAtoms)
+  return (Rule SrcLoc{start = p} headAtom bodyAtoms)
 
-parseProgram :: Parser Program
+parseProgram :: Parser (Program' SrcLoc)
-parseProgram = Program () <$> many parseRule
+parseProgram = Program dummy <$> many parseRule
+
+data SrcLoc = SrcLoc
+  { start :: SourcePos
+  -- , end :: (Word, Word)
+  } deriving Show
+dummy = SrcLoc{start = initialPos "dummy-file"}
+
+test = do
+  let r = runParser parseProgram "???" prog
+  pPrint @IO r
+
+prog = """
+  odd(X,Y) :- r(X,Y).
+  odd(X,Y) :- even(X,Z), r(Z,Y).
+  even(X,Y) :- odd(X,Z), r(Z,Y).
+
+  r(0,1).
+  r(1,2).
+  r(2,3).
+  r(3,4).
+  r(4,5).
+
+  r(X,Y) :- r(Y,X).
+  """

geolog-lsp.cabal

@@ -26,7 +26,8 @@ library datalog-parser
         base,
         text,
         containers,
-        megaparsec
+        megaparsec,
+        pretty-simple,
     exposed-modules:
         Datalog.Parser,
         Datalog.Syntax