Commit 70d797cd authored by Paul Ogris's avatar Paul Ogris
Browse files

Initial commit

parents
# Stack uses this directory as scratch space.
/.stack-work/
# Stack generates the Cabal file from `package.yaml` through hpack.
/*.cabal
# Change log
lars-relax uses [Semantic Versioning][].
The change log is available through the [releases on GitHub][].
[Semantic Versioning]: http://semver.org/spec/v2.0.0.html
[releases on GitHub]: https://github.com/githubuser/lars-relax/releases
[The MIT License (MIT)][]
Copyright (c) 2019 Author name here
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
[The MIT License (MIT)]: https://opensource.org/licenses/MIT
# [lars-relax][]
Thanks for starting a project with Haskeleton! If you haven't heard of it
before, I suggest reading the introductory blog post. You can find it here:
<http://taylor.fausak.me/2014/03/04/haskeleton-a-haskell-project-skeleton/>.
Before you get started, there are a few things that this template couldn't
provide for you. You should:
- Add a synopsis to `package.yaml`. It should be a short (one sentence)
explanation of your project.
- Add a description to `package.yaml`. This can be whatever you want it to
be.
- Add a category to `package.yaml`. A list of categories is available on
Hackage at <http://hackage.haskell.org/packages>.
- Rename `library/Example.hs` to whatever you want your top-level module to
be called. Typically this is the same as your package name but in
`CamelCase` instead of `kebab-case`.
- Don't forget to rename the reference to it in
`executable/Main.hs`!
- If you are on an older version of Stack (<1.0.4), delete `package.yaml` and
remove `/*.cabal` from your `.gitignore`.
Once you've done that, start working on your project with the Stack commands
you know and love.
``` sh
# Build the project.
stack build
# Run the test suite.
stack test
# Run the benchmarks.
stack bench
# Generate documentation.
stack haddock
```
Thanks again, and happy hacking!
[lars-relax]: https://github.com/githubuser/lars-relax
-- This script is used to build and install your package. Typically you don't
-- need to change it. The Cabal documentation has more information about this
-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.
import qualified Distribution.Simple
main :: IO ()
main = Distribution.Simple.defaultMain
-- It is generally a good idea to keep all your business logic in your library
-- and only use it in the executable. Doing so allows others to use what you
-- wrote in their libraries.
main :: IO ()
main = putStrLn "Hello World"
{-# LANGUAGE OverloadedStrings #-}
module Language.LARS
(
Statement(..),
Atom,
Relation,
Rule(..),
BodyElement(..),
SignedAtom(..),
-- * Pretty Printing
prettyOneLine,
-- * Parsing
parse,
stmt,
atom,
relation,
signedAtom,
rule,
bodyElement
)
where
import Data.Text (Text, pack)
import Text.Megaparsec
import Data.Void
import Text.PrettyPrint.Leijen.Text (Pretty, (<+>))
import qualified Text.Megaparsec.Char as P
import qualified Text.PrettyPrint.Leijen.Text as PP
import qualified Text.Megaparsec.Char.Lexer as L
newtype Statement = StmtRule Rule
deriving (Eq, Show, Ord, Read)
instance Pretty Statement where
pretty (StmtRule r) = PP.pretty r
type Atom = Text
type Relation = Text
data Rule = Rule Atom [BodyElement]
deriving (Eq, Show, Ord, Read)
instance Pretty Rule where
pretty (Rule h []) = PP.textStrict h <> PP.dot
pretty (Rule h bs) =
PP.textStrict h
<+> ":-"
<+> PP.hcat (PP.punctuate (PP.comma <> PP.space) (map PP.pretty bs))
<> PP.dot
data BodyElement = BodyAtom SignedAtom | BodyRelation Relation
deriving (Eq, Show, Ord, Read)
instance Pretty BodyElement where
pretty (BodyAtom x) = PP.pretty x
pretty (BodyRelation x) = PP.textStrict x
data SignedAtom = Positive Atom | Negative Atom
deriving (Eq, Show, Ord, Read)
instance Pretty SignedAtom where
pretty (Positive x) = PP.textStrict x
pretty (Negative x) = "not" <+> PP.textStrict x
prettyOneLine :: Pretty a => a -> Text
prettyOneLine = PP.displayTStrict . PP.renderOneLine . PP.pretty
type Parser = Parsec Void Text
-- | Space Consumer
sc :: Parser ()
sc = L.space P.space1 lineCmnt blockCmnt
where
lineCmnt = L.skipLineComment "//"
blockCmnt = L.skipBlockComment "/*" "*/"
-- | Wrapper for lexemes
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
-- | Wrapper for symbols
symbol :: Text -> Parser Text
symbol = L.symbol sc
atom :: Parser Atom
atom = lexeme $ do
identifier <- pack <$> ((:) <$> (P.char '-' <|> P.lowerChar) <*> many P.alphaNumChar)
pure $ identifier <> ""
rule :: Parser Rule
rule =
Rule <$> atom <*> option [] (ruleIf *> bodyElement `sepBy1` comma) <* dot
ruleIf :: Parser Text
ruleIf = symbol ":-"
bodyElement :: Parser BodyElement
bodyElement = (BodyAtom <$> signedAtom) <|> (BodyRelation <$> relation)
comma :: Parser Text
comma = symbol ","
dot :: Parser Text
dot = symbol "."
negation :: Parser Text
negation = symbol "not"
signedAtom :: Parser SignedAtom
signedAtom = (try (negation *> (Negative <$> atom))) <|> (Positive <$> atom)
relation :: Parser Relation
relation = lexeme $ takeWhileP Nothing (\x -> x `notElem` [',','.'])
stmt :: Parser Statement
stmt = StmtRule <$> rule
module Relax where
import Language.LARS
import Data.Maybe (mapMaybe)
relax :: [Statement] -> [Statement]
relax = map go
where go (StmtRule (Rule h bs)) = StmtRule (Rule h (mapMaybe removeNegation bs))
removeNegation :: BodyElement -> Maybe BodyElement
removeNegation (BodyAtom (Negative _)) = Nothing
removeNegation (BodyAtom (Positive x)) = Just (BodyAtom (Positive x))
removeNegation (BodyRelation r) = Just (BodyRelation r)
name: lars-relax
version: '0.0.0'
github: "tsahyt/lars-relax"
license: MIT
author: "Paul Ogris"
maintainer: "Paul Ogris"
synopsis: A LARS preprocessor
description: |
lars-relax relaxes the given LARS encoding into one that is
guaranteed to be polynomial. It achieves this by removing all negation.
category: Logic Programming
extra-source-files:
- CHANGELOG.md
- LICENSE.md
- package.yaml
- README.md
- stack.yaml
ghc-options: -Wall
library:
dependencies:
- base
- megaparsec
- text
- wl-pprint-text
source-dirs: library
executables:
lars-relax:
source-dirs: executable
main: Main.hs
dependencies:
- base
- lars-relax
ghc-options:
- -rtsopts
- -threaded
- -with-rtsopts=-N
tests:
lars-relax-test-suite:
source-dirs: test-suite
main: Main.hs
dependencies:
- base
- lars-relax
- tasty
- tasty-hspec
- hspec-megaparsec
ghc-options:
- -rtsopts
- -threaded
- -with-rtsopts=-N
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-14.13
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.1"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
size: 525876
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/13.yaml
sha256: 4a0e79eb194c937cc2a1852ff84d983c63ac348dc6bad5f38d20cab697036eef
original: lts-14.13
{-# LANGUAGE OverloadedStrings #-}
import qualified Test.Tasty
import Test.Tasty.Hspec
import Test.Hspec.Megaparsec
import Language.LARS
main :: IO ()
main = do
test <- testSpec "lars-relax" spec
Test.Tasty.defaultMain test
spec :: Spec
spec = parallel $ do
describe "LARS Pretty Printing" pprint
describe "LARS Parsing" parser
pprint :: Spec
pprint = parallel $ do
it "pretty prints positive atoms as atoms"
$ prettyOneLine (Positive "foo(1,2)")
`shouldBe` "foo(1,2)"
it "pretty prints negative atoms as negated atoms"
$ prettyOneLine (Negative "foo(1,2)")
`shouldBe` "not foo(1,2)"
it "pretty prints body relations"
$ prettyOneLine (BodyRelation "A = B")
`shouldBe` "A = B"
it "pretty prints positive body atoms"
$ prettyOneLine (BodyAtom $ Positive "foo(1,2)")
`shouldBe` "foo(1,2)"
it "pretty prints negative body atoms"
$ prettyOneLine (BodyAtom $ Negative "foo(1,2)")
`shouldBe` "not foo(1,2)"
it "pretty prints facts"
$ prettyOneLine (Rule "head(a,1)" [])
`shouldBe` "head(a,1)."
it "pretty prints basic rules"
$ prettyOneLine (Rule "head(a,X)" [BodyAtom (Positive "body(X)")])
`shouldBe` "head(a,X) :- body(X)."
it "pretty prints complex rules"
$ prettyOneLine
(Rule
"head(a,X)"
[ BodyAtom (Positive "body(X)")
, BodyAtom (Negative "foo(Y)")
, BodyRelation "X = Y"
]
)
`shouldBe` "head(a,X) :- body(X), not foo(Y), X = Y."
parser :: Spec
parser = parallel $ do
it "parses an atom with arguments"
$ parse atom "" "foo(1,2)"
`shouldParse` "foo(1,2)"
it "parses an atom without arguments"
$ parse atom "" "fooBar"
`shouldParse` "fooBar"
it "parses positive signed atoms"
$ parse signedAtom "" "bar(a,b)"
`shouldParse` Positive "bar(a,b)"
it "parses negative signed atoms"
$ parse signedAtom "" "not bar(a,b)"
`shouldParse` Negative "bar(a,b)"
it "parses facts"
$ parse rule "" "someFact."
`shouldParse` Rule "someFact" []
it "parses simple rules"
$ parse rule "" "someHead(X) :- body(X)."
`shouldParse` Rule "someHead(X)" [BodyAtom (Positive "body(X)")]
it "parses complex rules"
$ parse rule "" "head(X) :- body(X), not foo(Y), X = Y."
`shouldParse` Rule
"head(X)"
[ BodyAtom (Positive "body(X)")
, BodyAtom (Negative "foo(Y)")
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment