souffle-haskell (empty) → 0.0.1

raw patch · 15 files changed

+1827/−0 lines, 15 filesdep +basedep +hspecdep +mtlsetup-changed

Dependencies added: base, hspec, mtl, souffle-haskell, template-haskell, type-errors-pretty

Files

• CHANGELOG.md +11/−0
• LICENSE +21/−0
• README.md +182/−0
• Setup.hs +3/−0
• cbits/souffle.cpp +147/−0
• cbits/souffle.h +201/−0
• lib/Language/Souffle.hs +340/−0
• lib/Language/Souffle/Internal.hs +184/−0
• lib/Language/Souffle/Internal/Bindings.hs +258/−0
• lib/Language/Souffle/Internal/Constraints.hs +63/−0
• lib/Language/Souffle/Marshal.hs +127/−0
• lib/Language/Souffle/TH.hs +25/−0
• souffle-haskell.cabal +79/−0
• tests/Test/TestSuiteSpec.hs +184/−0
• tests/test.hs +2/−0

@@ -0,0 +1,11 @@++# Changelog++All notable changes to this project will be documented in this file.+The CHANGELOG is available on [Github](https://github.com/luc-tielen/souffle-haskell.git/CHANGELOG.md).+++## [0.0.1] - 2019-10-23+### Added++- Initial version of the library

@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2019 Luc Tielen++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.

@@ -0,0 +1,182 @@++# Souffle-haskell++[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://github.com/luc-tielen/souffle-haskell/blob/master/LICENSE)++This repo provides Haskell bindings for performing analyses with the+[Souffle Datalog language](https://github.com/souffle-lang/souffle).+It does this by binding directly to an "embedded" Souffle program+(previously generated with `souffle -g`).++Fun fact: this library combines both functional programming (Haskell),+logic programming (Datalog / Souffle) and imperative / OO programming (C / C++).+++## Motivating example++Let's first write a datalog program that can check if 1 point+is reachable from another:++```prolog+// We define 2 data types:+.decl edge(n: symbol, m: symbol)+.decl reachable(n: symbol, m: symbol)++// We indicate we are interested in "reachable" facts.+// NOTE: If you forget to add outputs, the souffle compiler will+//       try to be smart and remove most generated code!+.output reachable++// We write down some pre-defined facts on the datalog side.+edge("a", "b").+edge("b", "c").+edge("c", "e").+edge("e", "f").+edge("c", "d").++// And we tell datalog how to check if 1 point is reachable from another.+reachable(x, y) :- edge(x, y).                  // base rule+reachable(x, z) :- edge(x, y), reachable(y, z). // inductive rule+```++Now that we have the datalog code, we can generate a `path.cpp` from it+using `souffle -g path.cpp path.dl`. `souffle-haskell` can bind to this program+in the following way:++```haskell+-- Enable some necessary extensions:+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, TypeFamilies, DeriveGeneric #-}++module Main ( main ) where++import Data.Foldable ( traverse_ )+import Control.Monad.IO.Class+import GHC.Generics+import qualified Language.Souffle.TH as Souffle+import qualified Language.Souffle as Souffle++-- We only use template haskell for directly embedding the .cpp file into this file.+-- If we do not do this, it will link incorrectly due to the way the+-- C++ code is generated.+Souffle.embedProgram "/path/to/path.cpp"+++-- We define a data type representing our datalog program.+data Path = Path++-- Facts are represent in Haskell as simple product types,+-- Numbers map to Int32, Strings to symbols.++data Edge = Edge String String+  deriving (Eq, Show, Generic)++data Reachable = Reachable String String+  deriving (Eq, Show, Generic)++-- By making Path an instance of Program, we provide Haskell with information+-- about the datalog program. It uses this to perform compile-time checks to+-- limit the amount of possible programmer errors to a minimum.+instance Souffle.Program Path where+  type ProgramFacts Path = [Edge, Reachable]+  programName = const "path"++-- By making a data type an instance of Edge, we give Haskell the+-- necessary information to bind to the datalog fact.+instance Souffle.Fact Edge where+  factName = const "edge"++instance Souffle.Fact Reachable where+  factName = const "reachable"++-- For simple product types, we can automatically generate the+-- marshalling/unmarshalling code of data between Haskell and datalog.+instance Souffle.Marshal Edge+instance Souffle.Marshal Reachable+++main :: IO ()+main = Souffle.runSouffle $ do+  maybeProgram <- Souffle.init Path  -- Initializes the Souffle program.+  case maybeProgram of+    Nothing -> liftIO $ putStrLn "Failed to load program."+    Just prog -> do+      Souffle.addFact prog $ Edge "d" "i"   -- Adding a single fact from Haskell side+      Souffle.addFacts prog [ Edge "e" "f"  -- Adding multiple facts+                            , Edge "f" "g"+                            , Edge "f" "g"+                            , Edge "f" "h"+                            , Edge "g" "i"+                            ]++      Souffle.run prog  -- Run the Souffle program++      -- NOTE: You can change type param to fetch different relations+      --       Here it requires an annotation since we directly print it+      --       to stdout, but if passed to another function, it can infer+      --       the correct type automatically.+      results :: [Reachable] <- Souffle.getFacts prog+      liftIO $ traverse_ print results++      -- We can also look for a specific fact:+      maybeFact <- Souffle.findFact prog $ Reachable "a" "c"+      liftIO $ print $ maybeFact+```++For more examples of how to use the top level API, you can also take a look at+the tests.+++## Getting started++This library assumes that the Souffle include paths are properly set.+This is needed in order for the C++ code to be compiled correctly.+The easiest way to do this (that I know of) is via [Nix](https://nixos.org/nix/).+Add `souffle` to the build inputs of your derivation and everything will+be set correctly.+Without Nix, you will have to follow the manual install instructions+on the [Souffle website](https://souffle-lang.github.io/install).++In your package.yaml / *.cabal file, make sure to add the following options+(assuming package.yaml here):++```yaml+# ...+cpp-options:+  - -D__EMBEDDED_SOUFFLE__++# ...+```++This will instruct the Souffle compiler to compile the C++ in such a way that+it can be linked with other languages (including Haskell!).+++## Contributing++TLDR: Nix-based project; the Makefile contains the most commonly used commands.+++Long version:++The project makes use of [Nix](https://nixos.org/nix/download.html) to setup the development environment.+Setup your environment by entering the following command:++```bash+$ nix-shell+```++After this command, you can build the project:++```bash+$ make configure  # configures the project+$ make build      # builds the haskell code+$ make lint       # runs the linter+$ make hoogle     # starts a local hoogle webserver+```+++## Issues++Found an issue or missing a piece of functionality?+Please open an issue with a description of the problem.+

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

@@ -0,0 +1,147 @@+#include "souffle/SouffleInterface.h"+#include "souffle.h"+++extern "C" {+    souffle_t* souffle_init(const char* progName) {+        auto prog = souffle::ProgramFactory::newInstance(progName);+        return reinterpret_cast<souffle_t*>(prog);+    }++    void souffle_free(souffle_t* program) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        delete prog;+    }++    void souffle_set_num_threads(souffle_t* program, size_t num_cores) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        prog->setNumThreads(num_cores);+    }++    size_t souffle_get_num_threads(souffle_t* program) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        return prog->getNumThreads();+    }++    void souffle_run(souffle_t* program) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        prog->run();+    }++    void souffle_load_all(souffle_t* program, const char* directory) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        assert(directory);+        prog->loadAll(directory);+    }++    void souffle_print_all(souffle_t* program) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        prog->printAll();+    }++    relation_t* souffle_relation(souffle_t* program, const char* relation_name) {+        auto prog = reinterpret_cast<souffle::SouffleProgram*>(program);+        assert(prog);+        assert(relation_name);+        auto relation = prog->getRelation(relation_name);+        assert(relation);+        return reinterpret_cast<relation_t*>(relation);+    }++    struct relation_iterator {+        using iterator_t = souffle::Relation::iterator;+        iterator_t iterator;+        iterator_t end;++        relation_iterator(const iterator_t& begin_, const iterator_t& end_)+            : iterator(begin_)+            , end(end_) {}+    };++    relation_iterator_t* souffle_relation_iterator(relation_t* relation) {+        auto rel = reinterpret_cast<souffle::Relation*>(relation);+        assert(rel);+        relation_iterator_t* it = new relation_iterator_t(rel->begin(), rel->end());+        return it;+    }++    void souffle_relation_iterator_free(relation_iterator_t* iterator) {+        assert(iterator);+        delete iterator;+    }++    bool souffle_relation_iterator_has_next(const relation_iterator_t* iterator) {+        assert(iterator);+        return iterator->iterator != iterator->end;+    }++    tuple_t* souffle_relation_iterator_next(relation_iterator_t* iterator) {+        assert(iterator);+        auto tuple = reinterpret_cast<tuple_t*>(&*iterator->iterator);+        ++iterator->iterator;+        return tuple;+    }++    bool souffle_contains_tuple(relation_t* relation, tuple_t* tuple) {+        auto rel = reinterpret_cast<souffle::Relation*>(relation);+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(rel);+        assert(t);+        return rel->contains(*t);+    }++    tuple_t *souffle_tuple_alloc(relation_t* relation) {+        auto rel = reinterpret_cast<souffle::Relation*>(relation);+        assert(rel);+        auto tuple = new souffle::tuple(rel);+        return reinterpret_cast<tuple_t*>(tuple);+    }++    void souffle_tuple_free(tuple_t* tuple) {+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(t);+        delete t;+    }++    void souffle_tuple_push_int(tuple_t* tuple, int32_t value) {+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(t);+        *t << value;+    }++    void souffle_tuple_push_string(tuple_t* tuple, const char* value) {+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(t);+        *t << value;+    }++    void souffle_tuple_add(relation_t* relation, tuple_t* tuple) {+        auto rel = reinterpret_cast<souffle::Relation*>(relation);+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(rel);+        assert(t);+        rel->insert(*t);+    }++    void souffle_tuple_pop_int(tuple_t* tuple, int32_t* result) {+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(t);+        assert(result);+        *t >> *result;+    }++    void souffle_tuple_pop_string(tuple_t* tuple, char** result) {+        auto t = reinterpret_cast<souffle::tuple*>(tuple);+        assert(t);+        assert(result);+        std::string value;+        *t >> value;+        *result = strdup(value.c_str());+    }+}

@@ -0,0 +1,201 @@+#ifndef SOUFFLE_H+#define SOUFFLE_H+#include <stdint.h>+#include <stdlib.h>+#include <stdbool.h>++#ifdef __cplusplus+extern "C" {+#endif++    // Opaque struct representing a Souffle program+    typedef struct souffle_interface souffle_t;+    // Opaque struct representing a Souffle relation+    typedef struct relation relation_t;+    // Opaque struct representing an iterator to a Souffle relation+    typedef struct relation_iterator relation_iterator_t;+    // Opaque struct representing a Souffle tuple (fact).+    typedef struct tuple tuple_t;++    /*+     * Initializes a Souffle program. The name of the program should be the+     * same as the filename (minus the .dl extension).+     *+     * The pointer that is returned can be NULL in case something went wrong.+     * If a valid pointer is returned, it needs to be freed by "souffle_free"+     * after it is no longer needed.+     */+    souffle_t* souffle_init(const char* progName);++    /*+     * Frees the memory in use by "program".+     * You need to check if the pointer is non-NULL before passing it to this+     * function. Not doing so results in undefined behavior.+     */+    void souffle_free(souffle_t* program);++    /*+     * Sets the number of cores this program should use.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     */+    void souffle_set_num_threads(souffle_t* program, size_t num_cores);++    /*+     * Gets the number of cores this program should use.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     * Returns the number of cores the program will use.+     */+    size_t souffle_get_num_threads(souffle_t* program);++    /*+     * Runs the Souffle program.+     * You need to check if the pointer is non-NULL before passing it to this+     * function. Not doing so results in undefined behavior.+     */+    void souffle_run(souffle_t* program);++    /*+     * Load all facts from files in a certain directory.+     * You need to check if both pointers are non-NULL before passing it to this+     * function. Not doing so results in undefined behavior.+     */+    void souffle_load_all(souffle_t* program, const char* directory);++    /*+     * Write out all facts of the program to CSV files+     * (as defined in the Souffle program).+     *+     * You need to check if the pointer is non-NULL before passing it to this+     * function. Not doing so results in undefined behavior.+     */+    void souffle_print_all(souffle_t* program);++    /*+     * Lookup a relation in the Souffle program.+     * You need to check if both passed pointers are non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * The returned pointer can be NULL if the relation is not found.+     * The pointer does not need to be freed, it is managed by the Souffle program.+     */+    relation_t* souffle_relation(souffle_t* program, const char* relation_name);++    /*+     * Create an iterator for iterating over the facts of a relation.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * The returned pointer needs to be freed up with+     * "souffle_relation_iterator_free" after it is no longer needed.+     */+    relation_iterator_t* souffle_relation_iterator(relation_t* relation);++    /*+     * Frees a relation_iterator pointer.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     */+    void souffle_relation_iterator_free(relation_iterator_t* iterator);++    /*+     * Checks if the relation iterator contains more results.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Returns true if iterator contains more results; otherwise false.+     */+    bool souffle_relation_iterator_has_next(const relation_iterator_t* iterator);++    /*+     * Advances the relation iterator by 1 position.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     * Always check if there is a next record with "souffle_relation_iterator_has_next"+     * before using this function to prevent crashes.+     *+     * Returns a pointer to the next record. This pointer is not allowed to be freed.+     */+    tuple_t* souffle_relation_iterator_next(relation_iterator_t* iterator);++    /*+     * Checks if a relation contains a certain tuple.+     * You need to check if the passed pointers are non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Returns true if the tuple was found in the relation; otherwise false.+     */+    bool souffle_contains_tuple(relation_t* relation, tuple_t* tuple);++    /*+     * Allocates memory for a tuple to be added to a relation.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Returns a pointer to a new tuple. Use "souffle_tuple_free" when tuple+     * is no longer required.+     */+    tuple_t* souffle_tuple_alloc(relation_t* relation);++    /*+     * Frees memory of a tuple that was previously allocated.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     */+    void souffle_tuple_free(tuple_t* tuple);++    /*+     * Adds a tuple to a relation.+     * You need to check if both passed pointers are non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     */+    void souffle_tuple_add(relation_t* relation, tuple_t* tuple);++    /*+     * Pushes an integer value into a tuple.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Pushing an integer value onto a tuple that expects another type results+     * in a crash.+     */+    void souffle_tuple_push_int(tuple_t* tuple, int32_t value);++    /*+     * Pushes a string value into a tuple.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Pushing a string value onto a tuple that expects another type results+     * in a crash.+     */+    void souffle_tuple_push_string(tuple_t* tuple, const char* value);++    /*+     * Extracts an integer value from a tuple.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Extracting an integer value from a tuple that expects another type results+     * in a crash.+     * The popped integer will be stored in the result pointer.+     */+    void souffle_tuple_pop_int(tuple_t* tuple, int32_t* result);++    /*+     * Extracts a string value from a tuple.+     * You need to check if the passed pointer is non-NULL before passing it+     * to this function. Not doing so results in undefined behavior.+     *+     * Extracting a string value from a tuple that expects another type results+     * in a crash.+     * The popped string will be stored in the result pointer.+     */+    void souffle_tuple_pop_string(tuple_t* tuple, char** result);++#ifdef __cplusplus+}+#endif++#endif

@@ -0,0 +1,340 @@++{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, DataKinds #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators #-}+{-# LANGUAGE DerivingVia, InstanceSigs, UndecidableInstances #-}++-- | This module provides the top level API of this library.+--   It makes use of Haskell's powerful typesystem to make certain invalid states+--   impossible to represent. It does this with a small type level DSL for+--   describing properties of the Datalog program (see the 'Program' and 'Fact'+--   typeclasses for more information).+--   This module also provides a MTL-style interface to Souffle related operations+--   so it can be integrated with existing monad transformer stacks.+module Language.Souffle+  ( Program(..)+  , Fact(..)+  , Marshal.Marshal(..)+  , Handle+  , MonadSouffle(..)+  , SouffleM+  , runSouffle+  ) where++import Prelude hiding ( init )+import Data.Foldable ( traverse_ )+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Control.Monad.Except+import Foreign.ForeignPtr+import Foreign.Ptr+import Type.Errors.Pretty+import Data.Proxy+import Data.Kind+import Data.Word+import qualified Language.Souffle.Internal as Internal+import qualified Language.Souffle.Marshal as Marshal+++-- | A datatype representing a handle to a datalog program.+--   The type parameter is used for keeping track of which program+--   type the handle belongs to for additional type safety.+newtype Handle prog = Handle (ForeignPtr Internal.Souffle)++-- | A typeclass for describing a datalog program.+--+-- Example usage (assuming the program was generated from path.dl+-- and contains 2 facts: Edge and Reachable):+--+-- @+-- data Path = Path  -- Handle for the datalog program+--+-- instance Program Path where+--   type ProgramFacts Path = '[Edge, Reachable]+--   factName = const "path"+-- @+class Program a where+  -- | A type level list of facts that belong to this program.+  --   This list is used to check that only known facts are added to a program.+  type ProgramFacts a :: [Type]++  -- | Function for obtaining the name of a Datalog program.+  --   This has to be the same as the name of the .dl file (minus the extension).+  --+  -- It uses a 'Proxy' to select the correct instance.+  programName :: Proxy a -> String++-- | A typeclass for data types representing a fact in datalog.+class Marshal.Marshal a => Fact a where+  -- | Function for obtaining the name of a fact+  --   (has to be the same as described in the Datalog program).+  --+  -- It uses a 'Proxy' to select the correct instance.+  --+  -- Example usage:+  --+  -- @+  -- instance Fact Edge where+  --   factName = const "edge"+  -- @+  factName :: Proxy a -> String++type family ContainsFact prog fact :: Constraint where+  ContainsFact prog fact =+    CheckContains prog (ProgramFacts prog) fact++type family CheckContains prog facts fact :: Constraint where+  CheckContains prog '[] fact =+    TypeError ("You tried to perform an action with a fact of type '" <> fact+    <> "' for program '" <> prog <> "'."+    % "The program contains the following facts: " <> ProgramFacts prog <> "."+    % "It does not contain fact: " <> fact <> "."+    % "You can fix this error by adding the type '" <> fact+    <> "' to the ProgramFacts type in the Program instance for " <> prog <> ".")+  CheckContains _ (a ': _) a = ()+  CheckContains prog (_ ': as) b = CheckContains prog as b+++-- | A monad for executing Souffle-related actions in.+newtype SouffleM a+  = SouffleM+  { runSouffle :: IO a  -- ^ Returns the underlying IO action.+  } deriving ( Functor, Applicative, Monad, MonadIO ) via IO++-- | A mtl-style typeclass for Souffle-related actions.+class Monad m => MonadSouffle m where+  {- | Initializes a Souffle program.++     The action will return 'Nothing' if it failed to load the Souffle program.+     Otherwise it will return a 'Handle' that can be used in other functions+     in this module.+  -}+  init :: Program prog => prog -> m (Maybe (Handle prog))++  -- | Runs the Souffle program.+  run :: Handle prog -> m ()++  -- | Sets the number of CPU cores this Souffle program should use.+  setNumThreads :: Handle prog -> Word64 -> m ()++  -- | Gets the number of CPU cores this Souffle program should use.+  getNumThreads :: Handle prog -> m Word64++  -- | Load all facts from files in a certain directory.+  loadFiles :: Handle prog -> FilePath -> m ()++  -- | Write out all facts of the program to CSV files+  --   (as defined in the Souffle program).+  writeFiles :: Handle prog -> m ()++  -- | Returns all facts of a program. This function makes use of type inference+  --   to select the type of fact to return.+  getFacts :: (Fact a, ContainsFact prog a)+           => Handle prog -> m [a]++  -- | Searches for a fact in a program.+  --   Returns 'Nothing' if no matching fact was found;+  --   otherwise 'Just' the fact.+  findFact :: (Fact a, ContainsFact prog a)+           => Handle prog -> a -> m (Maybe a)++  -- | Adds a fact to the program.+  addFact :: (Fact a, ContainsFact prog a)+          => Handle prog -> a -> m ()++  -- | Adds multiple facts to the program. This function could be implemented+  --   in terms of 'addFact', but this is done as a minor optimization.+  addFacts :: (Foldable t, Fact a, ContainsFact prog a)+           => Handle prog -> t a -> m ()++instance MonadSouffle SouffleM where+  init :: forall prog. Program prog+       => prog -> SouffleM (Maybe (Handle prog))+  init _ =+    let progName = programName (Proxy :: Proxy prog)+    in SouffleM $ fmap Handle <$> Internal.init progName+  {-# INLINABLE init #-}++  run (Handle prog) = SouffleM $ Internal.run prog+  {-# INLINABLE run #-}++  setNumThreads (Handle prog) numCores =+    SouffleM $ Internal.setNumThreads prog numCores+  {-# INLINABLE setNumThreads #-}++  getNumThreads (Handle prog) =+    SouffleM $ Internal.getNumThreads prog+  {-# INLINABLE getNumThreads #-}++  loadFiles (Handle prog) = SouffleM . Internal.loadAll prog+  {-# INLINABLE loadFiles #-}++  writeFiles (Handle prog) = SouffleM $ Internal.printAll prog+  {-# INLINABLE writeFiles #-}++  addFact :: forall a prog. (Fact a, ContainsFact prog a)+          => Handle prog -> a -> SouffleM ()+  addFact (Handle prog) fact = liftIO $ do+    let relationName = factName (Proxy :: Proxy a)+    relation <- Internal.getRelation prog relationName+    addFact' relation fact+  {-# INLINABLE addFact #-}++  addFacts :: forall t a prog. (Foldable t, Fact a, ContainsFact prog a)+           => Handle prog -> t a -> SouffleM ()+  addFacts (Handle prog) facts = liftIO $ do+    let relationName = factName (Proxy :: Proxy a)+    relation <- Internal.getRelation prog relationName+    traverse_ (addFact' relation) facts+  {-# INLINABLE addFacts #-}++  getFacts :: forall a prog. (Fact a, ContainsFact prog a)+           => Handle prog -> SouffleM [a]+  getFacts (Handle prog) = SouffleM $ do+    let relationName = factName (Proxy :: Proxy a)+    relation <- Internal.getRelation prog relationName+    Internal.getRelationIterator relation >>= go []+    where+      go acc it = do+        hasNext <- Internal.relationIteratorHasNext it+        if hasNext+          then do+            tuple <- Internal.relationIteratorNext it+            result <- Marshal.runMarshalT Marshal.pop tuple+            go (result : acc) it+          else pure acc+  {-# INLINABLE getFacts #-}++  findFact :: forall a prog. (Fact a, ContainsFact prog a)+             => Handle prog -> a -> SouffleM (Maybe a)+  findFact (Handle prog) a = SouffleM $ do+    let relationName = factName (Proxy :: Proxy a)+    relation <- Internal.getRelation prog relationName+    tuple <- Internal.allocTuple relation+    withForeignPtr tuple $ Marshal.runMarshalT (Marshal.push a)+    found <- Internal.containsTuple relation tuple+    pure $ if found+             then Just a+             else Nothing+  {-# INLINABLE findFact #-}++addFact' :: Fact a => Ptr Internal.Relation -> a -> IO ()+addFact' relation fact = do+  tuple <- Internal.allocTuple relation+  withForeignPtr tuple $ Marshal.runMarshalT (Marshal.push fact)+  Internal.addTuple relation tuple+{-# INLINABLE addFact' #-}+++instance MonadSouffle m => MonadSouffle (ReaderT r m) where+  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}+  getFacts = lift . getFacts+  {-# INLINABLE getFacts #-}+  findFact prog = lift . findFact prog+  {-# INLINABLE findFact #-}+  addFact fact = lift . addFact fact+  {-# INLINABLE addFact #-}+  addFacts facts = lift . addFacts facts+  {-# INLINABLE addFacts #-}++instance (Monoid w, MonadSouffle m) => MonadSouffle (WriterT w m) where+  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}+  getFacts = lift . getFacts+  {-# INLINABLE getFacts #-}+  findFact prog = lift . findFact prog+  {-# INLINABLE findFact #-}+  addFact fact = lift . addFact fact+  {-# INLINABLE addFact #-}+  addFacts facts = lift . addFacts facts+  {-# INLINABLE addFacts #-}++instance MonadSouffle m => MonadSouffle (StateT s m) where+  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}+  getFacts = lift . getFacts+  {-# INLINABLE getFacts #-}+  findFact prog = lift . findFact prog+  {-# INLINABLE findFact #-}+  addFact fact = lift . addFact fact+  {-# INLINABLE addFact #-}+  addFacts facts = lift . addFacts facts+  {-# INLINABLE addFacts #-}++instance (MonadSouffle m, Monoid w) => MonadSouffle (RWST r w s m) where+  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}+  getFacts = lift . getFacts+  {-# INLINABLE getFacts #-}+  findFact prog = lift . findFact prog+  {-# INLINABLE findFact #-}+  addFact fact = lift . addFact fact+  {-# INLINABLE addFact #-}+  addFacts facts = lift . addFacts facts+  {-# INLINABLE addFacts #-}++instance MonadSouffle m => MonadSouffle (ExceptT s m) where+  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}+  getFacts = lift . getFacts+  {-# INLINABLE getFacts #-}+  findFact prog = lift . findFact prog+  {-# INLINABLE findFact #-}+  addFact fact = lift . addFact fact+  {-# INLINABLE addFact #-}+  addFacts facts = lift . addFacts facts+  {-# INLINABLE addFacts #-}+

@@ -0,0 +1,184 @@++{-# Language LambdaCase #-}++-- | An internal module, providing a slightly higher level interface than+--   "Language.Souffle.Internal.Bindings".+--   It uses more commonly found data types instead of the low level C types+--   for easier integration with other parts of a Haskell application.+--   Also it takes care of garbage collection so other modules do not have+--   to take this into account anymore.+--+--   Used only internally, so prone to changes, use at your own risk.+module Language.Souffle.Internal+  ( Souffle+  , Relation+  , RelationIterator+  , Tuple+  , init+  , setNumThreads+  , getNumThreads+  , run+  , loadAll+  , printAll+  , getRelation+  , getRelationIterator+  , relationIteratorHasNext+  , relationIteratorNext+  , allocTuple+  , addTuple+  , containsTuple+  , tuplePushInt+  , tuplePushString+  , tuplePopInt+  , tuplePopString+  ) where++import Prelude hiding ( init )+import Data.Functor ( (<&>) )+import Data.Word+import Data.Int+import Foreign.Marshal.Alloc+import Foreign.Storable+import Foreign.C.String+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Ptr+import qualified Language.Souffle.Internal.Bindings as Bindings+import Language.Souffle.Internal.Bindings+  ( Souffle, Relation, RelationIterator, Tuple )+++{- | Initializes a Souffle program.++     The string argument is the name of the program and should be the same+     as the filename (minus the .dl extension).++     The action will return 'Nothing' if it failed to load the Souffle program.+     Otherwise it will return a pointer that can be used in other functions+     in this module.+-}+init :: String -> IO (Maybe (ForeignPtr Souffle))+init prog = do+  ptr <- withCString prog Bindings.init+  if ptr == nullPtr+    then pure Nothing+    else Just <$> newForeignPtr Bindings.free ptr+{-# INLINABLE init #-}++-- | Sets the number of CPU cores this Souffle program should use.+setNumThreads :: ForeignPtr Souffle -> Word64 -> IO ()+setNumThreads prog numThreads = withForeignPtr prog $ \ptr ->+    Bindings.setNumThreads ptr $ CSize numThreads+{-# INLINABLE setNumThreads #-}++-- | Gets the number of CPU cores this Souffle program should use.+getNumThreads :: ForeignPtr Souffle -> IO Word64+getNumThreads prog = withForeignPtr prog $ \ptr -> do+    (CSize numThreads) <- Bindings.getNumThreads ptr+    pure numThreads+{-# INLINABLE getNumThreads #-}++-- | Runs the Souffle program.+run :: ForeignPtr Souffle -> IO ()+run prog = withForeignPtr prog Bindings.run+{-# INLINABLE run #-}++-- | Load all facts from files in a certain directory.+loadAll :: ForeignPtr Souffle -> FilePath -> IO ()+loadAll prog str = withForeignPtr prog $ withCString str . Bindings.loadAll+{-# INLINABLE loadAll #-}++-- | Write out all facts of the program to CSV files+--   (as defined in the Souffle program).+printAll :: ForeignPtr Souffle -> IO ()+printAll prog = withForeignPtr prog Bindings.printAll+{-# INLINABLE printAll #-}++{-| Lookup a relation by name in the Souffle program.++    Note that the returned pointer can be 'nullPtr' if it is not defined+    in the Souffle program.+-}+getRelation :: ForeignPtr Souffle -> String -> IO (Ptr Relation)+getRelation prog relation = withForeignPtr prog $ \ptr ->+  withCString relation $ Bindings.getRelation ptr+{-# INLINABLE getRelation #-}++-- | Create an iterator for iterating over the facts of a relation.+getRelationIterator :: Ptr Relation -> IO (ForeignPtr RelationIterator)+getRelationIterator relation =+  Bindings.getRelationIterator relation >>= newForeignPtr Bindings.freeRelationIterator+{-# INLINABLE getRelationIterator #-}++{-| Checks if the relation iterator contains more results.++    Returns 'True' if there are more results; otherwise 'False'.+-}+relationIteratorHasNext :: ForeignPtr RelationIterator -> IO Bool+relationIteratorHasNext iter = withForeignPtr iter $ \ptr ->+  Bindings.relationIteratorHasNext ptr <&> \case+    CBool 0 -> False+    CBool _ -> True+{-# INLINABLE relationIteratorHasNext #-}++{-| Advances the relation iterator by 1 position.++    Make sure to use 'relationIteratorHasNext' for checking if there are more+    results before calling this function to avoid potential crashes.+-}+relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple)+relationIteratorNext iter = withForeignPtr iter Bindings.relationIteratorNext+{-# INLINABLE relationIteratorNext #-}++-- | Allocates memory for a tuple (fact) to be added to a relation.+allocTuple :: Ptr Relation -> IO (ForeignPtr Tuple)+allocTuple relation =+  Bindings.allocTuple relation >>= newForeignPtr Bindings.freeTuple+{-# INLINABLE allocTuple #-}++-- | Adds a tuple (fact) to a relation.+addTuple :: Ptr Relation -> ForeignPtr Tuple -> IO ()+addTuple relation tuple =+  withForeignPtr tuple $ Bindings.addTuple relation+{-# INLINABLE addTuple #-}++{- | Checks if a relation contains a certain tuple.++     Returns True if the tuple was found in the relation; otherwise False.+-}+containsTuple :: Ptr Relation -> ForeignPtr Tuple -> IO Bool+containsTuple relation tuple = withForeignPtr tuple $ \ptr ->+  Bindings.containsTuple relation ptr <&> \case+    CBool 0 -> False+    CBool _ -> True+{-# INLINABLE containsTuple #-}++-- | Pushes an integer value into a tuple.+tuplePushInt :: Ptr Tuple -> Int32 -> IO ()+tuplePushInt tuple i = Bindings.tuplePushInt tuple (CInt i)+{-# INLINABLE tuplePushInt #-}++-- | Pushes a string value into a tuple.+tuplePushString :: Ptr Tuple -> String -> IO ()+tuplePushString tuple str =+  withCString str $ Bindings.tuplePushString tuple+{-# INLINABLE tuplePushString #-}++-- | Extracts an integer value from a tuple.+tuplePopInt :: Ptr Tuple -> IO Int32+tuplePopInt tuple = alloca $ \ptr -> do+  Bindings.tuplePopInt tuple ptr+  (CInt res) <- peek ptr+  pure res+{-# INLINABLE tuplePopInt #-}++-- | Extracts a string value from a tuple.+tuplePopString :: Ptr Tuple -> IO String+tuplePopString tuple = alloca $ \ptr -> do+  Bindings.tuplePopString tuple ptr+  cstr <- peek ptr+  str <- peekCString cstr+  free cstr+  pure str+{-# INLINABLE tuplePopString #-}+

@@ -0,0 +1,258 @@++-- | This module provides C bindings exposed by the files in the cbits directory.+--   This is an internal module, that is prone to have frequent changes,+--   use at your own risk.+module Language.Souffle.Internal.Bindings+  ( Souffle+  , Relation+  , RelationIterator+  , Tuple+  , init+  , free+  , setNumThreads+  , getNumThreads+  , run+  , loadAll+  , printAll+  , getRelation+  , getRelationIterator+  , freeRelationIterator+  , relationIteratorHasNext+  , relationIteratorNext+  , allocTuple+  , freeTuple+  , addTuple+  , containsTuple+  , tuplePushInt+  , tuplePushString+  , tuplePopInt+  , tuplePopString+  ) where++import Prelude hiding ( init )+import Foreign.C.String+import Foreign.C.Types+import Foreign.Ptr+++-- | A void type, used for tagging a pointer that points to an embedded+--   Souffle program.+data Souffle++-- | A void type, used for tagging a pointer that points to a relation.+data Relation++-- | A void type, used for tagging a pointer that points to an+--   iterator used for iterating over a relation.+data RelationIterator++-- | A void type, used for tagging a pointer that points to a tuple+--   (term used in the Souffle compiler for a fact).+data Tuple+++{- | Initializes a Souffle program.++     The string argument is the name of the program and should be the same+     as the filename (minus the .dl extension).+     The pointer that is returned can be 'nullPtr' in case something went wrong.+     If a valid pointer is returned, it needs to be freed by 'free'+     after it is no longer needed.+-}+foreign import ccall unsafe "souffle_init" init+  :: CString -> IO (Ptr Souffle)++{-| Frees the memory in use by the pointer, previously allocated by 'init'.++    You need to check if the pointer is not equal to 'nullPtr'+    before passing it to this function. Not doing so results in+    undefined behavior (in C++).+-}+foreign import ccall unsafe "&souffle_free" free+  :: FunPtr (Ptr Souffle -> IO ())++{-| Sets the number of CPU cores this Souffle program should use.++    You need to check if the pointer is not equal to 'nullPtr'+    before passing it to this function. Not doing so results in+    undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_set_num_threads" setNumThreads+  :: Ptr Souffle -> CSize -> IO ()++{-| Gets the number of CPU cores this Souffle program should use.++    You need to check if the pointer is equal to 'nullPtr' before passing+    it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_get_num_threads" getNumThreads+  :: Ptr Souffle -> IO CSize++{-| Runs the Souffle program.++    You need to check if the pointer is equal to 'nullPtr' before passing+    it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_run" run+  :: Ptr Souffle -> IO ()++{-| Load all facts from files in a certain directory.++    You need to check if both pointers are not equal to 'nullPtr' before passing+    it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_load_all" loadAll+  :: Ptr Souffle -> CString -> IO ()++{-| Write out all facts of the program to CSV files+    (as defined in the Souffle program).++    You need to check if the pointer is not equal to 'nullPtr' before passing it+    to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_print_all" printAll+  :: Ptr Souffle -> IO ()++{-| Lookup a relation in the Souffle program.++    You need to check if both passed pointers are not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    The returned pointer can be 'nullPtr' if the relation is not found.+    The pointer does not need to be freed, it is managed by the Souffle program.+-}+foreign import ccall unsafe "souffle_relation" getRelation+  :: Ptr Souffle -> CString -> IO (Ptr Relation)++{-| Create an iterator for iterating over the facts of a relation.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    The returned pointer needs to be freed with 'freeRelationIterator'+    after it is no longer needed.+-}+foreign import ccall unsafe "souffle_relation_iterator" getRelationIterator+  :: Ptr Relation -> IO (Ptr RelationIterator)++{-| Frees a pointer previously allocated with 'getRelationIterator'.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "&souffle_relation_iterator_free" freeRelationIterator+  :: FunPtr (Ptr RelationIterator -> IO ())++{-| Checks if the relation iterator contains more results.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    Returns true if iterator contains more results; otherwise false.+-}+foreign import ccall unsafe "souffle_relation_iterator_has_next" relationIteratorHasNext+  :: Ptr RelationIterator -> IO CBool++{-| Advances the relation iterator by 1 position.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    Always check if there is a next record with 'relationIteratorHasNext'+    before using this function to prevent crashes.++    Returns a pointer to the next tuple. This pointer is not allowed to be freed+    as it is managed by the Souffle program already.+-}+foreign import ccall unsafe "souffle_relation_iterator_next" relationIteratorNext+  :: Ptr RelationIterator -> IO (Ptr Tuple)++{-| Allocates memory for a tuple (fact) to be added to a relation.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    Returns a pointer to a new tuple. Use 'freeTuple' when the tuple+    is no longer required.+-}+foreign import ccall unsafe "souffle_tuple_alloc" allocTuple+  :: Ptr Relation -> IO (Ptr Tuple)++{-| Frees memory of a tuple that was previously allocated (in Haskell).++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "&souffle_tuple_free" freeTuple+  :: FunPtr (Ptr Tuple -> IO ())++{-| Adds a tuple to a relation.++    You need to check if both passed pointers are not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).+-}+foreign import ccall unsafe "souffle_tuple_add" addTuple+  :: Ptr Relation -> Ptr Tuple -> IO ()++{- | Checks if a relation contains a certain tuple.++     You need to check if the passed pointers are non-NULL before passing it+     to this function. Not doing so results in undefined behavior.++     Returns True if the tuple was found in the relation; otherwise False.+-}+foreign import ccall unsafe "souffle_contains_tuple" containsTuple+  :: Ptr Relation -> Ptr Tuple -> IO CBool++{-| Pushes an integer value into a tuple.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    Pushing an integer value onto a tuple that expects another type results+    in a crash. Pushing a value into a tuple when it already is "full"+    also results in a crash.+-}+foreign import ccall unsafe "souffle_tuple_push_int" tuplePushInt+  :: Ptr Tuple -> CInt -> IO ()++{-| Pushes a string value into a tuple.++    You need to check if the passed pointer is not equal to 'nullPtr' before+    passing it to this function. Not doing so results in undefined behavior (in C++).++    Pushing a string value onto a tuple that expects another type results+    in a crash. Pushing a value into a tuple when it already is "full"+    also results in a crash.+-}+foreign import ccall unsafe "souffle_tuple_push_string" tuplePushString+  :: Ptr Tuple -> CString -> IO ()++{-| Extracts an integer value from a tuple.++    You need to check if the passed pointer is not equal to 'nullPtr' before passing it+    to this function. Not doing so results in undefined behavior.++    Extracting an integer value from a tuple that expects another type results+    in a crash. Extracting a value from a tuple when it is already "empty"+    also results in a crash.++    The popped integer will be stored in the pointer that is passed in.+-}+foreign import ccall unsafe "souffle_tuple_pop_int" tuplePopInt+  :: Ptr Tuple -> Ptr CInt -> IO ()++{-| Extracts a string value from a tuple.++    You need to check if the passed pointer is not equal to 'nullPtr' before passing it+    to this function. Not doing so results in undefined behavior.++    Extracting a string value from a tuple that expects another type results+    in a crash. Extracting a value from a tuple when it is already "empty"+    also results in a crash.++    The popped string will be stored in the result pointer.+-}+foreign import ccall unsafe "souffle_tuple_pop_string" tuplePopString+  :: Ptr Tuple -> Ptr CString -> IO ()+

@@ -0,0 +1,63 @@++{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, UndecidableInstances #-}++-- | A helper module for generating more user friendly type errors in the form+--   of custom constraints.+--   This is an internal module, not meant to be used directly.+module Language.Souffle.Internal.Constraints+  ( SimpleProduct+  ) where++import Type.Errors.Pretty+import GHC.Generics+import Data.Kind+import Data.Int+++-- | A helper type family used for generating a more user-friendly type error+--   for incompatible types when generically deriving marshalling code for+--   the 'Language.Souffle.Marshal.Marshal' typeclass.+--+--   The __a__ type parameter is the original type, used when displaying the type error.+--   The __f__ type parameter should be equal to 'Rep a', used for analyzing the+--   structure of the data type.+--+--   A type error is returned if the passed in type is not a simple product type+--   consisting of only simple types like Int32 and String.+type family SimpleProduct (a :: Type) (f :: Type -> Type) :: Constraint where+  SimpleProduct a f = (ProductLike a f, OnlySimpleFields a f)++type family ProductLike (t :: Type) (f :: Type -> Type) :: Constraint where+  ProductLike t (_ :*: b) = ProductLike t b+  ProductLike t (M1 _ _ a) = ProductLike t a+  ProductLike _ (K1 _ _) = ()+  ProductLike t (_ :+: _) =+    TypeError ( "Error while deriving marshalling code for type " <> t <> ":"+              % "Cannot derive sum type, only product types are supported.")+  ProductLike t U1 =+    TypeError ( "Error while deriving marshalling code for type " <> t <> ":"+              % "Cannot automatically derive code for 0 argument constructor.")+  ProductLike t V1 =+    TypeError ( "Error while deriving marshalling code for type " <> t <> ":"+              % "Cannot derive void type.")++type family OnlySimpleFields (t :: Type) (f :: Type -> Type) :: Constraint where+  OnlySimpleFields t (a :*: b) = (OnlySimpleField t a, OnlySimpleFields t b)+  OnlySimpleFields t (a :+: b) = (OnlySimpleFields t a, OnlySimpleFields t b)+  OnlySimpleFields t (M1 _ _ a) = OnlySimpleFields t a+  OnlySimpleFields _ U1 = ()+  OnlySimpleFields _ V1 = ()+  OnlySimpleFields t k = OnlySimpleField t k++type family OnlySimpleField (a :: Type) (f :: Type -> Type) :: Constraint where+  OnlySimpleField t (M1 _ _ a) = OnlySimpleField t a+  OnlySimpleField t (K1 _ a) = DirectlyMarshallable t a++type family DirectlyMarshallable (a :: Type) (b :: Type) :: Constraint where+  DirectlyMarshallable _ Int32 = ()+  DirectlyMarshallable _ String = ()+  DirectlyMarshallable t a =+    TypeError ( "Error while generating marshalling code for " <> t <> ":"+              % "Can only marshal values of Int32 and String directly"+             <> ", but found " <> a <> " type instead.")+

@@ -0,0 +1,127 @@++{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE DerivingVia, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts, DataKinds #-}+{-# LANGUAGE UndecidableInstances, DefaultSignatures #-}+{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}++-- | This module exposes a uniform interface to marshal values+--   to and from Souffle Datalog. This is done via the 'Marshal' typeclass+--   and 'MarshalT' monad transformer.+--   Also, a mechanism is exposed for generically deriving marshalling+--   and unmarshalling code for simple product types.+module Language.Souffle.Marshal+  ( MarshalT+  , runMarshalT+  , Marshal(..)+  ) where++import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.Except+import Control.Monad.RWS+import GHC.Generics+import Foreign.Ptr+import Data.Int+import qualified Language.Souffle.Internal as Internal+import qualified Language.Souffle.Internal.Constraints as C+++type Tuple = Ptr Internal.Tuple++-- | A monad transformer, used solely for marshalling and unmarshalling+--   between Haskell and Souffle Datalog.+newtype MarshalT m a = MarshalT (ReaderT Tuple m a)+  deriving ( Functor, Applicative, Monad+           , MonadIO, MonadReader Tuple, MonadWriter w+           , MonadState s, MonadRWS Tuple w s, MonadError e )+  via ( ReaderT Tuple m )+  deriving MonadTrans via (ReaderT Tuple)++-- | Execute the monad transformer and return the result.+--   The tuple that is passed in will be used to marshal the data back and forth.+runMarshalT :: MarshalT m a -> Tuple -> m a+runMarshalT (MarshalT m) = runReaderT m+{-# INLINABLE runMarshalT #-}+++{- | A typeclass for providing a uniform API to marshal/unmarshal values+     between Haskell and Souffle datalog.++The marshalling is done via a stack-based approach, where elements are+pushed/popped one by one. The programmer needs to make sure that the+marshalling values happens in the correct order or unexpected things+might happen (including crashes). Pushing and popping of fields should+happen in the same order (from left to right, as defined in Datalog).++Generic implementations for 'push' and 'pop' that perform the previously+described behavior are available. This makes it possible to+write very succinct code:++@+data Edge = Edge String String deriving Generic++instance Marshal Edge+@+-}+class Marshal a where+  -- | Marshals a value to the datalog side.+  push :: MonadIO m => a -> MarshalT m ()+  -- | Unmarshals a value from the datalog side.+  pop :: MonadIO m => MarshalT m a++  default push :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a), MonadIO m)+               => a -> MarshalT m ()+  default pop :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a), MonadIO m)+              => MarshalT m a+  push a = gpush (from a)+  {-# INLINABLE push #-}+  pop = to <$> gpop+  {-# INLINABLE pop #-}++instance Marshal Int32 where+  push int = do+    tuple <- ask+    liftIO $ Internal.tuplePushInt tuple int+  {-# INLINABLE push #-}+  pop = do+    tuple <- ask+    liftIO $ Internal.tuplePopInt tuple+  {-# INLINABLE pop #-}++instance Marshal String where+  push str = do+    tuple <- ask+    liftIO $ Internal.tuplePushString tuple str+  {-# INLINABLE push #-}+  pop = do+    tuple <- ask+    liftIO $ Internal.tuplePopString tuple+  {-# INLINABLE pop #-}+++class GMarshal f where+  gpush :: MonadIO m => f a -> MarshalT m ()+  gpop :: MonadIO m => MarshalT m (f a)++instance Marshal a => GMarshal (K1 i a) where+  gpush (K1 x) = push x+  {-# INLINABLE gpush #-}+  gpop = K1 <$> pop+  {-# INLINABLE gpop #-}++instance (GMarshal f, GMarshal g) => GMarshal (f :*: g) where+  gpush (a :*: b) = do+    gpush a+    gpush b+  {-# INLINABLE gpush #-}+  gpop = (:*:) <$> gpop <*> gpop+  {-# INLINABLE gpop #-}++instance GMarshal a => GMarshal (M1 i c a) where+  gpush (M1 x) = gpush x+  {-# INLINABLE gpush #-}+  gpop = M1 <$> gpop+  {-# INLINABLE gpop #-}+

@@ -0,0 +1,25 @@++-- | Helper module for easier integration of generated embedded souffle programs+--   with Haskell code. Without these helper functions, it becomes much harder+--   to link the C++ code directly to Haskell due to the way how Souffle+--   generates the code.+module Language.Souffle.TH ( embedProgram ) where++import Language.Haskell.TH.Syntax+++-- | Helper function for embedding a Souffle program in Haskell.+--   Requires the use of the TemplateHaskell language extension.+--+--   The passed in String should be a path relative from the root of the+--   project where the .cpp file is located.+--+--   Example usage:+--+-- @+-- module Main where+-- import Language.Haskell.TH.Syntax as Souffle+-- Souffle.embedProgram "path/to/file.cpp"  -- NOTE: call directly on top level!+-- @+embedProgram :: String -> Q [Dec]+embedProgram path = [] <$ qAddForeignFilePath LangCxx path

@@ -0,0 +1,79 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: a74bc91fd3ca58647ff0b218a4aec49ebe837c8af230504def1bf57726751265++name:           souffle-haskell+version:        0.0.1+synopsis:       Souffle Datalog bindings for Haskell+description:    Souffle Datalog bindings for Haskell.+category:       Logic Programming, Foreign Binding, Bindings+homepage:       https://github.com/luc-tielen/souffle-haskell#README.md+bug-reports:    https://github.com/luc-tielen/souffle-haskell/issues+author:         Luc Tielen+maintainer:     luc.tielen@gmail.com+copyright:      2019 Luc Tielen+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md+    LICENSE+    cbits/souffle.h++source-repository head+  type: git+  location: https://github.com/luc-tielen/souffle-haskell++library+  exposed-modules:+      Language.Souffle+      Language.Souffle.Internal+      Language.Souffle.Internal.Bindings+      Language.Souffle.Internal.Constraints+      Language.Souffle.Marshal+      Language.Souffle.TH+  other-modules:+      Paths_souffle_haskell+  autogen-modules:+      Paths_souffle_haskell+  hs-source-dirs:+      lib+  default-extensions: OverloadedStrings+  ghc-options: -Wall -Weverything -Wno-safe -Wno-unsafe -Wno-implicit-prelude -Wno-missed-specializations -Wno-all-missed-specializations -Wno-missing-import-lists -Wno-type-defaults -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-deriving-strategies -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits+  cpp-options: -std=c++17+  cxx-options: -Wall+  cxx-sources:+      cbits/souffle.cpp+  build-depends:+      base >=4.12 && <5+    , mtl >=2.0 && <3+    , template-haskell >=2 && <3+    , type-errors-pretty >=0.0.1.0 && <1+  default-language: Haskell2010++test-suite souffle-haskell-test+  type: exitcode-stdio-1.0+  main-is: test.hs+  other-modules:+      Test.TestSuiteSpec+      Paths_souffle_haskell+  hs-source-dirs:+      tests+  default-extensions: OverloadedStrings+  ghc-options: -Wall -Weverything -Wno-safe -Wno-unsafe -Wno-implicit-prelude -Wno-missed-specializations -Wno-all-missed-specializations -Wno-missing-import-lists -Wno-type-defaults -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-deriving-strategies -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits+  cpp-options: -std=c++17 -D__EMBEDDED_SOUFFLE__+  extra-libraries:+      c+++  build-depends:+      base >=4.12 && <5+    , hspec >=2.6.1 && <3.0.0+    , mtl >=2.0 && <3+    , souffle-haskell+    , template-haskell >=2 && <3+    , type-errors-pretty >=0.0.1.0 && <1+  default-language: Haskell2010

@@ -0,0 +1,184 @@++{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds #-}+{-# LANGUAGE TypeFamilies, DeriveGeneric #-}++module Test.TestSuiteSpec ( module Test.TestSuiteSpec ) where++import Test.Hspec+import GHC.Generics+import Data.Maybe+import qualified Language.Souffle.TH as Souffle+import qualified Language.Souffle as Souffle++Souffle.embedProgram "tests/fixtures/path.cpp"++data Path = Path++data Edge = Edge String String+  deriving (Eq, Show, Generic)++data Reachable = Reachable String String+  deriving (Eq, Show, Generic)++instance Souffle.Program Path where+  type ProgramFacts Path = [Edge, Reachable]+  programName = const "path"++instance Souffle.Fact Edge where+  factName = const "edge"++instance Souffle.Fact Reachable where+  factName = const "reachable"++instance Souffle.Marshal Edge+instance Souffle.Marshal Reachable+++data BadPath = BadPath++instance Souffle.Program BadPath where+  type ProgramFacts BadPath = [Edge, Reachable]+  programName = const "bad_path"++{-+-+-import Data.Foldable ( traverse_ )+-import Control.Monad.IO.Class+-import GHC.Generics+-+-main :: IO ()+-main = Souffle.runSouffle $ do+-  maybeProgram <- Souffle.init Path+-  case maybeProgram of+-    Nothing -> liftIO $ putStrLn "Failed to load program."+-    Just prog -> do+-      Souffle.addFact prog $ Edge "d" "i"+-      Souffle.addFacts prog [ Edge "e" "f"+-                    , Edge "f" "g"+-                    , Edge "f" "g"+-                    , Edge "f" "h"+-                    , Edge "g" "i"+-                    ]+-      Souffle.run prog+  -}+++spec :: Spec+spec = describe "Souffle API" $ parallel $ do+  describe "init" $ parallel $ do+    it "returns nothing if it cannot load a souffle program" $ do+      prog <- Souffle.runSouffle (Souffle.init BadPath)+      isJust prog `shouldBe` False++    it "returns just the program if it can load a souffle program" $ do+      prog <- Souffle.runSouffle (Souffle.init Path)+      isJust prog `shouldBe` True++  describe "getFacts" $ parallel $ do+    it "can retrieve facts" $ do+      (edges, reachables) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        es <- Souffle.getFacts prog+        rs <- Souffle.getFacts prog+        pure (es , rs)+      edges `shouldBe` [Edge "b" "c", Edge "a" "b"]+      reachables `shouldBe` [Reachable "b" "c", Reachable "a" "c", Reachable "a" "b"]++    it "returns empty list if program hasn't run yet" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.getFacts prog+      edges `shouldBe` ([] :: [Edge])++  describe "addFact" $ parallel $ do+    it "adds a fact" $ do+      (edgesBefore, edgesAfter) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        es1 <- Souffle.getFacts prog+        Souffle.addFact prog $ Edge "e" "f"+        Souffle.run prog+        es2 <- Souffle.getFacts prog+        pure (es1, es2)+      edgesBefore `shouldBe` [Edge "b" "c", Edge "a" "b"]+      edgesAfter `shouldBe` [Edge "e" "f", Edge "b" "c", Edge "a" "b"]++    it "can add a fact even if it is marked as output" $ do+      reachables <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.addFact prog $ Reachable "e" "f"+        Souffle.run prog+        Souffle.getFacts prog+      reachables `shouldBe` [ Reachable "e" "f", Reachable "b" "c"+                            , Reachable "a" "c", Reachable "a" "b" ]++  describe "addFacts" $ parallel $+    it "can add multiple facts at once" $ do+      (edgesBefore, edgesAfter) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        es1 <- Souffle.getFacts prog+        Souffle.addFacts prog [Edge "e" "f", Edge "f" "g"]+        Souffle.run prog+        es2 <- Souffle.getFacts prog+        pure (es1, es2)+      edgesBefore `shouldBe` [Edge "b" "c", Edge "a" "b"]+      edgesAfter `shouldBe` [Edge "f" "g", Edge "e" "f", Edge "b" "c", Edge "a" "b"]++  describe "run" $ parallel $ do+    it "is OK to run a program multiple times" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` [Edge "b" "c", Edge "a" "b"]++    it "discovers new facts after running with new facts" $ do+      (reachablesBefore, reachablesAfter) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        rs1 <- Souffle.getFacts prog+        Souffle.addFacts prog [Edge "e" "f", Edge "f" "g"]+        Souffle.run prog+        rs2 <- Souffle.getFacts prog+        pure (rs1, rs2)+      reachablesBefore `shouldBe` [Reachable "b" "c", Reachable "a" "c", Reachable "a" "b"]+      reachablesAfter `shouldBe` [ Reachable "f" "g", Reachable "e" "g", Reachable "e" "f"+                                 , Reachable "b" "c",Reachable "a" "c", Reachable "a" "b" ]++  describe "configuring number of cores" $ parallel $+    it "is possible to configure number of cores" $ do+      results <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        numCpus1 <- Souffle.getNumThreads prog+        Souffle.setNumThreads prog 4+        numCpus2 <- Souffle.getNumThreads prog+        Souffle.setNumThreads prog 2+        numCpus3 <- Souffle.getNumThreads prog+        pure (numCpus1, numCpus2, numCpus3)+      results `shouldBe` (1, 4, 2)++  describe "findFact" $ parallel $ do+    it "returns Nothing if no matching fact was found" $ do+      (edge, reachable) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        e <- Souffle.findFact prog $ Edge "c" "d"+        r <- Souffle.findFact prog $ Reachable "d" "e"+        pure (e, r)+      edge `shouldBe` Nothing+      reachable `shouldBe` Nothing++    it "returns Just the fact if matching fact was found" $ do+      (edge, reachable) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.run prog+        e <- Souffle.findFact prog $ Edge "a" "b"+        r <- Souffle.findFact prog $ Reachable "a" "c"+        pure (e, r)+      edge `shouldBe` Just (Edge "a" "b")+      reachable `shouldBe` Just (Reachable "a" "c")++  -- TODO writeFiles / loadFiles

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -Wno-missing-export-lists #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}