wipp

datalog/src/Datalog/Parser.hs

@@ -1,18 +1,19 @@
 {-# LANGUAGE MultilineStrings #-}
+{-# LANGUAGE BlockArguments #-}
 
-module Datalog.Parser
+module Datalog.Parser (
-    ( parseTerm
+    parseTerm,
-    , parseAtom
+    parseAtom,
-    , parseRule
+    parseRule,
-    , parseQuery
+    parseQuery,
-    , parseProgram
+    parseProgram,
 )
 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,7 +28,8 @@ symbol :: (MonadParsec e Text m) => Text -> m Text
 symbol = L.symbol whitespace
 
 whitespace :: (MonadParsec e Text m) => m ()
-whitespace = L.space
+whitespace =
+    L.space
         space1
         (L.skipLineComment "--")
         (L.skipBlockComment "{-" "-}")
@@ -64,16 +66,39 @@ parseFact = do
     return (Rule () headAtom [])
 
 parseRule :: Parser Rule
-parseRule = try parseFact <|> do
+parseRule =
+    try parseFact <|> do
         headAtom <- parseAtom <* symbol ":-"
         bodyAtoms <- parseQuery
         period
         return (Rule () headAtom bodyAtoms)
+parseRule' :: Parser (Rule' SrcLoc)
+parseRule' = _
 
-parseProgram :: Parser Program
+-- parseProgram :: Parser Program
-parseProgram = Program () <$> many parseRule
+parseProgram :: Parser (Program' SrcLoc)
+parseProgram = do
+    -- annotateSrcLoc $
+    s <- getSourcePos
+    c <- many parseRule'
+    e <- getSourcePos
+    -- Program _ <$> many parseRule
+    pure $ Program (SrcLoc s e) c
 
-annotateSrcLoc :: Functor f => Parser (f a) -> Parser (f SrcLoc)
+parseProgram' :: Parser (Program' SrcLoc)
+parseProgram' = parseThingWithSub (many parseRule') Program
+
+parseThingWithSub :: (Parser c) -> (SrcLoc -> c -> f SrcLoc) -> Parser (f SrcLoc)
+parseThingWithSub parseSub f = do
+    -- annotateSrcLoc $
+    s <- getSourcePos
+    -- c <- many parseRule'
+    c <- parseSub
+    e <- getSourcePos
+    -- Program _ <$> many parseRule
+    pure $ f (SrcLoc s e) c
+
+annotateSrcLoc :: (Functor f) => Parser (f a) -> Parser (f SrcLoc)
 annotateSrcLoc p = do
     s <- getSourcePos
     res <- p
@@ -83,13 +108,15 @@ annotateSrcLoc p = do
 data SrcLoc = SrcLoc
     { start :: SourcePos
     , end :: SourcePos
-  } deriving Show
+    }
+    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

@@ -3,10 +3,10 @@
 module Datalog.Syntax where
 
 import Data.Char (isUpper)
+import Data.Set (Set)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
-import Data.Set qualified as Set
-import Data.Set (Set)
 
 newtype ConId = ConId Text
     deriving (Eq, Ord, Show)
@@ -56,7 +56,7 @@ instance HasConstants (Term' a) where
         Con _ x -> Set.singleton x
         Var _ _ -> Set.empty
 
-instance HasConstants a => HasConstants [a] where
+instance (HasConstants a) => HasConstants [a] where
     constants xs = Set.unions (map constants xs)
 
 instance HasConstants (Atom' a) where