wip - have fun

datalog/src/Datalog/Parser.hs

@@ -1,18 +1,18 @@
 {-# LANGUAGE MultilineStrings #-}
 
-module Datalog.Parser (
+module Datalog.Parser
-    parseTerm,
+    ( parseTerm
-    parseAtom,
+    , parseAtom
-    parseRule,
+    , parseRule
-    parseQuery,
+    , parseQuery
-    parseProgram,
+    , parseProgram
-)
+    )
-where
+  where
 
+import Datalog.Syntax
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Void (Void)
-import Datalog.Syntax
 import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer qualified as L
@@ -27,8 +27,7 @@ symbol :: (MonadParsec e Text m) => Text -> m Text
 symbol = L.symbol whitespace
 
 whitespace :: (MonadParsec e Text m) => m ()
-whitespace =
+whitespace = L.space
-    L.space
   space1
   (L.skipLineComment "--")
   (L.skipBlockComment "{-" "-}")
@@ -40,63 +39,54 @@ 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' SrcLoc)
-parseAtom = annotateSrcLoc $ do
+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' SrcLoc]
 parseQuery = parseAtom `sepBy` comma
 
 parseFact :: Parser (Rule' SrcLoc)
-parseFact = annotateSrcLoc $ do
+parseFact = do
+  p <- getSourcePos
   headAtom <- parseAtom
   period
-    return (Rule NoLoc headAtom [])
+  return (Rule SrcLoc{start = p} headAtom [])
 
 parseRule :: Parser (Rule' SrcLoc)
-parseRule =
+parseRule = try parseFact <|> do
-    annotateSrcLoc $
+  p <- getSourcePos
-        try parseFact <|> do
   headAtom <- parseAtom <* symbol ":-"
   bodyAtoms <- parseQuery
   period
-            return (Rule NoLoc headAtom bodyAtoms)
+  return (Rule SrcLoc{start = p} headAtom bodyAtoms)
 
 parseProgram :: Parser (Program' SrcLoc)
-parseProgram = annotateSrcLoc $ Program NoLoc <$> many parseRule
+parseProgram = Program dummy <$> many parseRule
 
-annotateSrcLoc :: (Functor f) => Parser (f a) -> Parser (f SrcLoc)
+data SrcLoc = SrcLoc
-annotateSrcLoc p = do
-    s <- getSourcePos
-    res <- p
-    f <- getSourcePos
-    pure (SrcLoc s f <$ res)
-
-data SrcLoc
-    = SrcLoc
   { start :: SourcePos
-        , end :: SourcePos
+  -- , end :: (Word, Word)
-        }
+  } deriving Show
-    | NoLoc
+dummy = SrcLoc{start = initialPos "dummy-file"}
-    deriving (Show)
 
 test = do
   let r = runParser parseProgram "???" prog
   pPrint @IO r
 
-prog =
+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).

datalog/src/Datalog/Syntax.hs

@@ -48,16 +48,6 @@ type Program = Program' ()
 data Program' a = Program a [Rule' a]
   deriving (Eq, Ord, Show)
 
-class Decorable t where
-    decorateNode :: a -> t a -> t a
-
-instance (Decorable Program') where decorateNode x (Program _ rs) = Program x rs
-instance (Decorable Rule') where decorateNode x (Rule _ a as) = Rule x a as
-instance (Decorable Atom') where decorateNode x (Atom _ relId ts) = Atom x relId ts
-instance (Decorable Term') where 
-    decorateNode x (Var _ varId) = Var x varId
-    decorateNode x (Con _ conId) = Con x conId
-
 class HasConstants a where
   constants :: a -> Set ConId