├── bower.json ├── src └── Datalog │ ├── AST.purs │ ├── Parser │ └── Util.purs │ └── Parser.purs ├── README.org └── test └── Main.purs /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-datalog-parsers", 3 | "license": "MIT", 4 | "authors": [ 5 | "Erik Post (http://www.shinsetsu.nl)" 6 | ], 7 | "version": "0.1.0", 8 | "repository": { 9 | "type": "git", 10 | "url": "git://github.com/epost/purescript-datalog-parsers.git" 11 | }, 12 | "ignore": [ 13 | "**/.*", 14 | "node_modules", 15 | "bower_components", 16 | "output" 17 | ], 18 | "dependencies": { 19 | "purescript-parsing": "^4.3.1" 20 | }, 21 | "devDependencies": { 22 | "purescript-spec": "^1.0.0", 23 | "purescript-console": "^3.0.0" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /src/Datalog/AST.purs: -------------------------------------------------------------------------------- 1 | module Language.Datalog.AST where 2 | 3 | import Prelude hiding (between) 4 | 5 | data Term = Con String | Var String 6 | 7 | data Atom = Pred String (Array Term) 8 | 9 | data Rule = Rule Atom (Array Atom) 10 | 11 | instance termEq :: Eq Term where 12 | eq (Con x) (Con y) = x == y 13 | eq (Var x) (Var y) = x == y 14 | eq _ _ = false 15 | 16 | instance termShow :: Show Term where 17 | show (Var name) = "(Var " <> name <> ")" 18 | show (Con name) = "(Con " <> name <> ")" 19 | 20 | instance atomEq :: Eq Atom where 21 | eq (Pred n1 terms1) (Pred n2 terms2) = n1 == n2 && terms1 == terms2 22 | eq _ _ = false 23 | 24 | instance atomShow :: Show Atom where 25 | show (Pred name vars) = "(Pred " <> name <> " " <> show vars <> ")" 26 | 27 | instance ruleEq :: Eq Rule where 28 | eq (Rule h1 terms1) (Rule h2 terms2) = h1 == h2 && terms1 == terms2 29 | eq _ _ = false 30 | 31 | instance ruleShow :: Show Rule where 32 | show (Rule head body) = "(Rule " <> show head <> " :- " <> show body <> ")" 33 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | # #+title:Datalog parsers for PureScript 2 | 3 | * Supported formats 4 | 5 | | Syntax flavour | constants | variables | rule | support | 6 | |----------------------------------+-----------+----------------+------+---------------| 7 | | 'Standard' datalog (like Prolog) | lowercase | uppercase | ~:-~ | getting there | 8 | | Prolog | lowercase | uppercase | ~:-~ | | 9 | | Datalog with ~?~ variables | | start with ~?~ | ~:-~ | | 10 | | Datomic | | start with ~?~ | | | 11 | | LogiQL | | | ~<-~ | | 12 | 13 | 14 | * Examples 15 | 16 | Syntax example adapted from MITRE datalog: 17 | 18 | #+BEGIN_SRC prolog 19 | % facts 20 | parent(john, douglas). 21 | parent(bob, john). 22 | parent(ebbon, bob). 23 | 24 | % rules 25 | ancestor(A, B) :- 26 | parent(A, B). 27 | 28 | ancestor(A, B) :- 29 | parent(A, C), 30 | D = C, 31 | ancestor(D, B). 32 | 33 | % query 34 | ancestor(A, B)? 35 | #+END_SRC 36 | -------------------------------------------------------------------------------- /src/Datalog/Parser/Util.purs: -------------------------------------------------------------------------------- 1 | module Language.Datalog.Parser.Util where 2 | 3 | import Prelude 4 | import Data.Array (some, many) 5 | import Data.String (fromCharArray) 6 | import Data.String as String 7 | import Data.String.Regex as R 8 | import Data.String.Regex.Flags (noFlags) 9 | import Data.String.Regex.Unsafe (unsafeRegex) 10 | import Text.Parsing.Parser (Parser) 11 | import Text.Parsing.Parser.Combinators (skipMany) 12 | import Text.Parsing.Parser.String (satisfy) 13 | 14 | -- adapted from https://github.com/slamdata/purescript-markdown/blob/master/src/Text/Markdown/SlamDown/Parser/Inline.purs 15 | 16 | isAlphaNum :: Char -> Boolean 17 | -- isAlphaNum c = isAlpha c || isDigit c 18 | isAlphaNum = isAlpha || isDigit 19 | 20 | isAlpha :: Char -> Boolean 21 | -- isAlpha c = isAlphaLower c || isAlphaUpper c 22 | isAlpha = isAlphaLower || isAlphaUpper 23 | 24 | isAlphaLower :: Char -> Boolean 25 | isAlphaLower c = c >= 'a' && c <= 'z' 26 | 27 | isAlphaUpper :: Char -> Boolean 28 | isAlphaUpper c = c >= 'A' && c <= 'Z' 29 | 30 | isDigit :: Char -> Boolean 31 | isDigit c = c >= '0' && c <= '9' 32 | 33 | isWhitespace :: Char -> Boolean 34 | isWhitespace = R.test wsRegex <<< String.singleton 35 | where 36 | wsRegex = unsafeRegex "^\\s$" noFlags 37 | flags = { unicode: false 38 | , sticky: false 39 | , multiline: false 40 | , ignoreCase: false 41 | , global: false 42 | } 43 | 44 | someOf :: (Char -> Boolean) -> Parser String String 45 | someOf p = fromCharArray <$> some (satisfy p) 46 | 47 | manyOf :: (Char -> Boolean) -> Parser String String 48 | manyOf p = fromCharArray <$> many (satisfy p) 49 | 50 | inSpaces :: Parser String String -> Parser String String 51 | inSpaces x = spaces *> x <* spaces 52 | 53 | spaces :: Parser String Unit 54 | spaces = skipMany (satisfy isWhitespace) 55 | -------------------------------------------------------------------------------- /src/Datalog/Parser.purs: -------------------------------------------------------------------------------- 1 | module Language.Datalog.Parser where 2 | 3 | import Prelude hiding (between) 4 | import Control.Alt ((<|>)) 5 | import Data.Array (fromFoldable) 6 | import Data.String as String 7 | import Data.List (List(..)) 8 | import Text.Parsing.Parser (Parser) 9 | import Text.Parsing.Parser.Combinators 10 | import Text.Parsing.Parser.String 11 | 12 | import Language.Datalog.AST (Atom(..), Rule(..), Term(..)) 13 | import Language.Datalog.Parser.Util 14 | 15 | term :: Parser String Term 16 | term = (Con <$> (conName <|> conStr)) 17 | <|> (Var <$> varName) 18 | 19 | varName :: Parser String String 20 | varName = nameStartingWith isAlphaUpper 21 | 22 | conName :: Parser String String 23 | conName = nameStartingWith isAlphaLower 24 | 25 | conStr :: Parser String String 26 | conStr = between (string "\"") (string "\"") 27 | (someOf $ isAlphaNum || isWhitespace || (_ == '_') || (_ == '-')) 28 | 29 | predName :: Parser String String 30 | predName = nameStartingWith isAlphaLower 31 | 32 | nameStartingWith :: (Char -> Boolean) -> Parser String String 33 | nameStartingWith prefixCharPred = do 34 | prefixChar <- satisfy prefixCharPred 35 | suffix <- option "" (someOf $ isAlphaNum || (_ == '_')) 36 | pure $ String.singleton prefixChar <> suffix 37 | 38 | atom :: Parser String Atom 39 | atom = do 40 | pn <- predName 41 | _ <- string "(" 42 | -- TODO disallow nullary predicates using sepBy1? 43 | vars <- (spaces *> term <* spaces) `sepBy` string "," 44 | _ <- string ")" 45 | pure $ Pred pn (fromFoldable vars) 46 | 47 | clauses :: Parser String (List Atom) 48 | clauses = atom `sepEndBy` (spaces *> string "." <* spaces) 49 | 50 | rule :: Parser String Rule 51 | rule = do 52 | head <- atom 53 | _ <- inSpaces (string ":-") 54 | bodyAtoms <- (spaces *> atom <* spaces) `sepEndBy` string "," 55 | _ <- string "." 56 | pure $ Rule head (fromFoldable bodyAtoms) 57 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (Eff) 5 | import Control.Monad.Eff.Console (CONSOLE, log) 6 | import Data.Either (Either(..)) 7 | import Data.List (many, fromFoldable) 8 | import Language.Datalog.AST (Term(..), Atom(..), Rule(..)) 9 | import Language.Datalog.Parser (atom, clauses, rule, term) 10 | import Text.Parsing.Parser (runParser) 11 | import Text.Parsing.Parser.String (satisfy) 12 | import Test.Spec (describe, pending, it) 13 | import Test.Spec.Runner (run) 14 | import Test.Spec.Assertions (shouldEqual) 15 | import Test.Spec.Reporter.Console (consoleReporter) 16 | 17 | main :: _ 18 | main = run [consoleReporter] do 19 | describe "term parsers" do 20 | itParses "abc,def" term $ Con "abc" 21 | 22 | describe "predicate parsers" do 23 | itParses "abc()" atom $ Pred "abc" [] 24 | itParses "abc(xxx)" atom $ Pred "abc" [Con "xxx"] 25 | itParses "abc(UPPERCASEVAR)" atom $ Pred "abc" [Var "UPPERCASEVAR"] 26 | itParses "abc(MixedCaseVar)" atom $ Pred "abc" [Var "MixedCaseVar"] 27 | itParses "abc(con,VAR)" atom $ Pred "abc" [Con "con", Var "VAR"] 28 | itParses "abc(xxx, yyy)" atom $ Pred "abc" [Con "xxx", Con "yyy"] 29 | itParses "abc(\"This is a string constant_-_\")" atom $ Pred "abc" [Con "This is a string constant_-_"] 30 | 31 | describe "clause parsers" do 32 | itParses "path(x,y).path(y,z)" clauses $ fromFoldable [ Pred "path" [Con "x", Con "y"] 33 | , Pred "path" [Con "y", Con "z"] 34 | ] 35 | itParses "path(x,y).path(y,z)." clauses $ fromFoldable [ Pred "path" [Con "x", Con "y"] 36 | , Pred "path" [Con "y", Con "z"] 37 | ] 38 | itParses "path(x,y). path(y,z)." clauses $ fromFoldable [ Pred "path" [Con "x", Con "y"] 39 | , Pred "path" [Con "y", Con "z"] 40 | ] 41 | itParses "path(x,y). \n path(y,z)." clauses $ fromFoldable [ Pred "path" [Con "x", Con "y"] 42 | , Pred "path" [Con "y", Con "z"] 43 | ] 44 | describe "rule parsers" do 45 | itParses "happy(X) :- has_drink(X)." rule $ Rule ( Pred "happy" [Var "X"] ) 46 | [ Pred "has_drink" [Var "X"] ] 47 | itParses "happy(X) :- has_drink(X)." rule $ Rule ( Pred "happy" [Var "X"] ) 48 | [ Pred "has_drink" [Var "X"] ] 49 | itParses "happy(X) :- has_drink(X), hair_ok(X)." rule $ Rule ( Pred "happy" [Var "X"] ) 50 | [ Pred "has_drink" [Var "X"] 51 | , Pred "hair_ok" [Var "X"] ] 52 | 53 | itParses str p exp = it ("should parse: " <> str) $ (runParser str p) `shouldParseTo` exp 54 | 55 | shouldParseTo v exp = shouldEqual v (Right exp) 56 | --------------------------------------------------------------------------------