Refactor parser to decorate with void

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
 
@@ -58,14 +61,44 @@ parseFact :: Parser Rule
 parseFact = do
   headAtom <- parseAtom
   period
-  return (headAtom :- [])
+  return (Rule () headAtom [])
 
 parseRule :: Parser Rule
 parseRule = try parseFact <|> do
   headAtom <- parseAtom <* symbol ":-"
   bodyAtoms <- parseQuery
   period
-  return (headAtom :- bodyAtoms)
+  return (Rule () headAtom bodyAtoms)
 
 parseProgram :: Parser Program
 parseProgram = Program () <$> many parseRule
+
+annotateSrcLoc :: Functor f => Parser (f a) -> Parser (f SrcLoc)
+annotateSrcLoc p = do
+    s <- getSourcePos
+    res <- p
+    f <- getSourcePos
+    pure (SrcLoc s f <$ res)
+
+data SrcLoc = SrcLoc
+  { start :: SourcePos
+  , end :: SourcePos
+  } deriving Show
+
+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).
+  """