souffle-haskell 0.1.0 → 0.2.0

raw patch · 14 files changed

+1305/−613 lines, 14 filesdep +deepseqdep +directorydep +filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, directory, filepath, free, process, temporary

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• README.md +69/−4
• lib/Language/Souffle.hs +4/−364
• lib/Language/Souffle/Class.hs +288/−0
• lib/Language/Souffle/Compiled.hs +192/−0
• lib/Language/Souffle/Internal.hs +0/−2
• lib/Language/Souffle/Internal/Constraints.hs +1/−2
• lib/Language/Souffle/Interpreted.hs +301/−0
• lib/Language/Souffle/Marshal.hs +48/−57
• lib/Language/Souffle/TH.hs +1/−1
• souffle-haskell.cabal +29/−9
• tests/Test/Language/Souffle/CompiledSpec.hs +175/−0
• tests/Test/Language/Souffle/InterpretedSpec.hs +183/−0
• tests/Test/TestSuiteSpec.hs +0/−173

@@ -1,9 +1,22 @@  # Changelog -All notable changes to this project will be documented in this file.+All notable changes to this project (as seen by library users) will be documented in this file. The CHANGELOG is available on [Github](https://github.com/luc-tielen/souffle-haskell.git/CHANGELOG.md). +## [0.2.0] - 2020-04-22+### Added++- Added Language.Souffle.Interpreted module for running Souffle programs in interpreted mode.+  NOTE: For this mode the CSV fact files must use TAB (`'\t'`) characters as separators.+- In interpreted mode, you can configure where the library looks for datalog files or where+  the souffle executable is located. For more information, see the `runSouffle` and `runSouffleWith`+  functions in the Language.Souffle.Interpreted module.++### Changed++- Introduced Language.Souffle.Class module as separation of the typeclass and the+  Language.Souffle.Compiled module to offer a uniform API in both interpreted and compiled mode.  ## [0.1.0] - 2019-12-21 ### Added

@@ -2,12 +2,11 @@ # Souffle-haskell  [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://github.com/luc-tielen/souffle-haskell/blob/master/LICENSE)+[![CircleCI](https://circleci.com/gh/luc-tielen/souffle-haskell.svg?style=svg&circle-token=07fcf633c70820100c529dda8869baa60d4b6dd8)](https://circleci.com/gh/luc-tielen/souffle-haskell) [![Hackage](https://img.shields.io/hackage/v/souffle-haskell?style=flat-square)](https://hackage.haskell.org/package/souffle-haskell)  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++).@@ -15,7 +14,7 @@  ## Motivating example -Let's first write a datalog program that can check if 1 point+Let's first write a datalog program that can check if one point is reachable from another:  ```prolog@@ -55,7 +54,7 @@ import GHC.Generics import Data.Vector import qualified Language.Souffle.TH as Souffle-import qualified Language.Souffle as Souffle+import qualified Language.Souffle.Compiled 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@@ -144,6 +143,7 @@  ```yaml # ...+ cpp-options:   - -D__EMBEDDED_SOUFFLE__ @@ -152,6 +152,71 @@  This will instruct the Souffle compiler to compile the C++ in such a way that it can be linked with other languages (including Haskell!).+++## Supported modes++Souffle programs can be run in 2 ways. They can either run in **interpreted** mode+(using the `souffle` CLI command), or they can be **compiled** to C++-code and+called from a host program for improved efficiency. This library supports both+modes (since version 0.2.0). The two variants have only a few minor differences+and can be swapped fairly easily.+++### Interpreted mode++This is probably the mode you want to start out with if you are developing a+program that uses Datalog for computing certain relations. Interpreted mode+offers quick development iterations (no compiling of C++ code each time you+change your Datalog code). However because the Souffle code is interpreted,+it can't offer the same speed as in compiled mode.++The main differences with compiled mode are the following:++1. You need to import `Language.Souffle.Interpreted`+2. You need to call `Souffle.cleanup` after you no longer need the Souffle+   functionality. This will clean up the generated CSV fact files located in+   a temporary directory.+3. You don't need to import `Language.Souffle.TH` to embed a Datalog program.+++#### Interpreter configuration++The interpreter uses CSV files to read or write facts. The configuration+allows specifiying where the fact directory is located. With the default+configuration, it will try to lookup `DATALOG_DIR` in the environment and+fall back to the current directory (or `.`).++You can also configure which souffle executable will be used. By default,+it will first look at the `SOUFFLE_BIN` environment variable. If this is+not set, it will try to find the executable using the `which` shell-command.+If it also can't find the executable this way, then it will fail to+initialize the interpreter.++For more information regarding configuration, take a look at the+`runSouffleWith` function.++The separators in the CSV fact files cannot be configured at the moment.+A tab character (`'\t'`) is used to separate the different columns.+++### Compiled mode++Once the prototyping phase of the Datalog algorithm is over, it is advised+to switch over to the compiled mode. It offers much improved performance+compared to the interpreted mode, at the cost of having to recompile your+Datalog algorithm each time it changes.++The main differences with interpreted mode are the following:++1. Compile the Datalog code with `souffle -g`.+2. You need to import `Language.Souffle.TH` to embed a Datalog program+   using `Language.Souffle.TH.embedProgram`, as shown in the+   [motivating example](#motivating-example).+3. Remove `Souffle.cleanup` if it is present in your code, compiled mode+   leaves no CSV artifacts.++The [motivating example](#motivating-example) is a complete example for the compiled mode.   ## Contributing

@@ -1,367 +1,7 @@--{-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, DataKinds #-}-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators #-}-{-# LANGUAGE DerivingVia, InstanceSigs, UndecidableInstances, BangPatterns #-}---- | 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.+-- | This module functions as a re-export for the compiled, more performant+--   variant of the API available in this library (due to legacy reasons). module Language.Souffle-  ( Program(..)-  , Fact(..)-  , Marshal.Marshal(..)-  , Handle-  , CollectFacts-  , MonadSouffle(..)-  , SouffleM-  , runSouffle+  ( module Language.Souffle.Compiled   ) 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 Data.Vector as V-import qualified Data.Vector.Mutable as MV-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---- | Helper typeclass for collecting facts into a container-like structure.---   The order of returned facts is unspecified for performance reasons.---   Only used internally.-class CollectFacts c where-  collectFacts :: Marshal.Marshal a-               => Int-               -> ForeignPtr Internal.RelationIterator-               -> IO (c a)--instance CollectFacts V.Vector where-  collectFacts factCount iterator = do-    vec <- MV.unsafeNew factCount-    go vec 0 factCount iterator-    where-      go vec idx count _ | idx == count = V.unsafeFreeze vec-      go vec idx count it = do-        tuple <- Internal.relationIteratorNext it-        result <- Marshal.runMarshalT Marshal.pop tuple-        MV.unsafeWrite vec idx result-        go vec (idx + 1) count it-  {-# INLINABLE collectFacts #-}--instance CollectFacts [] where-  collectFacts factCount = go 0 factCount []-    where-      go idx count acc _ | idx == count = pure acc-      go idx count !acc !it = do-        tuple <- Internal.relationIteratorNext it-        result <- Marshal.runMarshalT Marshal.pop tuple-        go (idx + 1) count (result : acc) it-  {-# INLINABLE collectFacts #-}---- | 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, CollectFacts c)-           => Handle prog -> m (c a)--  -- | Searches for a fact in a program.-  --   Returns 'Nothing' if no matching fact was found; otherwise 'Just' the fact.-  ---  --   Conceptually equivalent to @List.find (== fact) \<$\> getFacts prog@, but this operation-  --   can be implemented much faster.-  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 c. (Fact a, ContainsFact prog a, CollectFacts c)-           => Handle prog -> SouffleM (c a)-  getFacts (Handle prog) = SouffleM $ do-    let relationName = factName (Proxy :: Proxy a)-    relation <- Internal.getRelation prog relationName-    factCount <- Internal.countFacts relation-    Internal.getRelationIterator relation >>= collectFacts factCount-  {-# 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 #-}-+import Language.Souffle.Compiled

@@ -0,0 +1,288 @@+{-# LANGUAGE DataKinds, UndecidableInstances, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, TypeOperators #-}++-- | This module provides the top level API for Souffle related operations.+--   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).+--+--   The Souffle operations are exposed via 2 mtl-style interfaces+--   (see `MonadSouffle` and `MonadSouffleFileIO`) that allows them to be+--   integrated with existing monad transformer stacks.+--+--   This module also contains some helper type families for additional+--   type safety and user-friendly error messages.+module Language.Souffle.Class+  ( ContainsFact+  , Program(..)+  , Fact(..)+  , MonadSouffle(..)+  , MonadSouffleFileIO(..)+  ) where++import Prelude hiding ( init )++import Control.Monad.Except+import Control.Monad.RWS.Strict+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+import Data.Proxy+import Data.Kind+import Data.Word+import qualified Language.Souffle.Marshal as Marshal+import Type.Errors.Pretty+++-- | A helper type family for checking if a specific Souffle `Program` contains a certain `Fact`.+--   This will generate a user-friendly type error if this is not the case.+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 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+++-- | A mtl-style typeclass for Souffle-related actions.+class Monad m => MonadSouffle m where+  -- | Represents a handle for interacting with a Souffle program.+  --   See also `init`, which returns a handle of this type.+  type Handler m :: Type -> Type++  -- | Helper associated type constraint that allows collecting facts from+  --   Souffle in a list or vector. Only used internally.+  type CollectFacts m (c :: Type -> Type) :: Constraint++  {- | Initializes a Souffle program.++     The action will return 'Nothing' if it failed to load the Souffle C+++     program or if it failed to find the Souffle interpreter (depending on+     compiled/interpreted variant).+     Otherwise it will return a handle that can be used in other functions+     in this module.+  -}+  init :: Program prog => prog -> m (Maybe (Handler m prog))++  -- | Runs the Souffle program.+  run :: Handler m prog -> m ()++  -- | Sets the number of CPU cores this Souffle program should use.+  setNumThreads :: Handler m prog -> Word64 -> m ()++  -- | Gets the number of CPU cores this Souffle program should use.+  getNumThreads :: Handler m prog -> m Word64++  -- | 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, CollectFacts m c)+           => Handler m prog -> m (c a)++  -- | Searches for a fact in a program.+  --   Returns 'Nothing' if no matching fact was found; otherwise 'Just' the fact.+  --+  --   Conceptually equivalent to @List.find (== fact) \<$\> getFacts prog@,+  --   but this operation can be implemented much faster.+  findFact :: (Fact a, ContainsFact prog a, Eq a)+           => Handler m prog -> a -> m (Maybe a)++  -- | Adds a fact to the program.+  addFact :: (Fact a, ContainsFact prog a)+          => Handler m 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)+           => Handler m prog -> t a -> m ()++instance MonadSouffle m => MonadSouffle (ReaderT r m) where+  type Handler (ReaderT r m) = Handler m+  type CollectFacts (ReaderT r m) c = CollectFacts m c++  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  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+  type Handler (WriterT w m) = Handler m+  type CollectFacts (WriterT w m) c = CollectFacts m c++  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  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+  type Handler (StateT s m) = Handler m+  type CollectFacts (StateT s m) c = CollectFacts m c++  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  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+  type Handler (RWST r w s m) = Handler m+  type CollectFacts (RWST r w s m) c = CollectFacts m c++  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  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 e m) where+  type Handler (ExceptT e m) = Handler m+  type CollectFacts (ExceptT e m) c = CollectFacts m c++  init = lift . init+  {-# INLINABLE init #-}+  run = lift . run+  {-# INLINABLE run #-}+  setNumThreads prog = lift . setNumThreads prog+  {-# INLINABLE setNumThreads #-}+  getNumThreads = lift . getNumThreads+  {-# INLINABLE getNumThreads #-}+  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 #-}+++-- | A mtl-style typeclass for Souffle-related actions that involve file IO.+class MonadSouffle m => MonadSouffleFileIO m where+  -- | Load all facts from files in a certain directory.+  loadFiles :: Handler m prog -> FilePath -> m ()++  -- | Write out all facts of the program to CSV files+  --   (as defined in the Souffle program).+  writeFiles :: Handler m prog -> m ()++instance MonadSouffleFileIO m => MonadSouffleFileIO (ReaderT r m) where+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}++instance (Monoid w, MonadSouffleFileIO m) => MonadSouffleFileIO (WriterT w m) where+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}++instance MonadSouffleFileIO m => MonadSouffleFileIO (StateT s m) where+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}++instance (MonadSouffleFileIO m, Monoid w) => MonadSouffleFileIO (RWST r w s m) where+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}++instance MonadSouffleFileIO m => MonadSouffleFileIO (ExceptT s m) where+  loadFiles prog = lift . loadFiles prog+  {-# INLINABLE loadFiles #-}+  writeFiles = lift . writeFiles+  {-# INLINABLE writeFiles #-}

@@ -0,0 +1,192 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE TypeFamilies, TypeOperators, DerivingVia, InstanceSigs, BangPatterns #-}+{-# LANGUAGE DataKinds, FlexibleContexts #-}++-- | This module provides an implementation for the typeclasses defined in+--   "Language.Souffle.Class".+--   It makes use of the low level Souffle C++ API to offer a much more+--   performant alternative implementation to the implementation in+--   "Language.Souffle.Interpreted".+--+--   This module is mainly intended to be used after the prototyping phase is+--   over since the iteration cycle is slower due to the additional+--   C++ compilation times.+module Language.Souffle.Compiled+  ( Program(..)+  , Fact(..)+  , Marshal(..)+  , Handle+  , SouffleM+  , MonadSouffle(..)+  , runSouffle+  ) where++import Prelude hiding ( init )++import Control.Monad.Except+import Control.Monad.RWS.Strict+import Control.Monad.Reader+import Data.Foldable ( traverse_ )+import Data.Proxy+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import Foreign.ForeignPtr+import Foreign.Ptr+import Language.Souffle.Class+import qualified Language.Souffle.Internal as Internal+import Language.Souffle.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 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++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)++runM :: Monad m => MarshalT m a -> Tuple -> m a+runM (MarshalT m) = runReaderT m+{-# INLINABLE runM #-}++-- | Execute the monad transformer and return the result.+--   The tuple that is passed in will be used to marshal the data back and forth.+runPushT :: MonadIO m => MarshalM PushF a -> Tuple -> m a+runPushT = runM . interpret pushAlgM where+  pushAlgM (PushInt int v) = do+    tuple <- ask+    liftIO $ Internal.tuplePushInt tuple int+    pure v+  pushAlgM (PushStr str v) = do+    tuple <- ask+    liftIO $ Internal.tuplePushString tuple str+    pure v+{-# INLINABLE runPushT #-}++-- | Execute the monad transformer and return the result.+--   The tuple that is passed in will be used to marshal the data back and forth.+runPopT :: MonadIO m => MarshalM PopF a -> Tuple -> m a+runPopT = runM . interpret popAlgM where+  popAlgM (PopStr f) = MarshalT $ do+    tuple <- ask+    str   <- liftIO $ Internal.tuplePopString tuple+    pure $ f str+  popAlgM (PopInt f) = MarshalT $ do+    tuple <- ask+    int   <- liftIO $ Internal.tuplePopInt tuple+    pure $ f int+{-# INLINABLE runPopT #-}++class Collect c where+  collect :: Marshal a => Int -> ForeignPtr Internal.RelationIterator -> IO (c a)++instance Collect [] where+  collect factCount = go 0 factCount []+    where+      go idx count acc _ | idx == count = pure acc+      go idx count !acc !it = do+        tuple <- Internal.relationIteratorNext it+        result <- runPopT pop tuple+        go (idx + 1) count (result : acc) it+  {-# INLINABLE collect #-}++instance Collect V.Vector where+  collect factCount iterator = do+    vec <- MV.unsafeNew factCount+    go vec 0 factCount iterator+    where+      go vec idx count _ | idx == count = V.unsafeFreeze vec+      go vec idx count it = do+        tuple <- Internal.relationIteratorNext it+        result <- runPopT pop tuple+        MV.unsafeWrite vec idx result+        go vec (idx + 1) count it+  {-# INLINABLE collect #-}++instance MonadSouffle SouffleM where+  type Handler SouffleM = Handle+  type CollectFacts SouffleM c = Collect c++  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 #-}++  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 c prog. (Fact a, ContainsFact prog a, Collect c)+           => Handle prog -> SouffleM (c a)+  getFacts (Handle prog) = SouffleM $ do+    let relationName = factName (Proxy :: Proxy a)+    relation <- Internal.getRelation prog relationName+    factCount <- Internal.countFacts relation+    Internal.getRelationIterator relation >>= collect factCount+  {-# 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 $ runPushT (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 $ runPushT (push fact)+  Internal.addTuple relation tuple+{-# INLINABLE addFact' #-}+++instance MonadSouffleFileIO SouffleM where+  loadFiles (Handle prog) = SouffleM . Internal.loadAll prog+  {-# INLINABLE loadFiles #-}++  writeFiles (Handle prog) = SouffleM $ Internal.printAll prog+  {-# INLINABLE writeFiles #-}+

@@ -1,6 +1,4 @@ -{-# 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

@@ -1,4 +1,3 @@- {-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, UndecidableInstances #-}  -- | A helper module for generating more user friendly type errors in the form@@ -25,7 +24,7 @@ --   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.+--   consisting of only simple types like Int32, String and Text. type family SimpleProduct (a :: Type) (f :: Type -> Type) :: Constraint where   SimpleProduct a f = (ProductLike a f, OnlySimpleFields a f) 

@@ -0,0 +1,301 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE DataKinds, FlexibleContexts, TypeFamilies, DerivingVia, InstanceSigs #-}++-- | This module provides an implementation for the `MonadSouffle` typeclass+--   defined in "Language.Souffle.Class".+--   It makes use of the Souffle interpreter and CSV files to offer an+--   implementation optimized for quick development speed compared to+--   "Language.Souffle.Compiled".+--+--   It is however __much__ slower so users are advised to switch over to+--   the compiled alternative once the prototyping phase is finished.+module Language.Souffle.Interpreted+  ( Program(..)+  , Fact(..)+  , Marshal(..)+  , Config(..)+  , Handle+  , SouffleM+  , MonadSouffle(..)+  , runSouffle+  , runSouffleWith+  , defaultConfig+  , cleanup+  ) where++import Prelude hiding (init)++import Control.DeepSeq (deepseq)+import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.IORef+import Data.Foldable (traverse_)+import Data.List hiding (init)+import Data.Semigroup (Last(..))+import Data.Maybe (fromMaybe)+import Data.Proxy+import qualified Data.Vector as V+import Data.Word+import Language.Souffle.Class+import Language.Souffle.Marshal+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO (hGetContents)+import System.IO.Temp+import System.Process+import Text.Printf+++-- | A monad for executing Souffle-related actions in.+newtype SouffleM a+  = SouffleM (ReaderT Config IO a)+  deriving (Functor, Applicative, Monad, MonadIO)+  via (ReaderT Config IO)++-- | A helper data type for storing the configurable settings of the+--   interpreter.+--+--   - __cfgDatalogDir__: The directory where the datalog file(s) are located.+--   - __cfgSouffleBin__: The name of the souffle binary. Has to be available in+--   \$PATH or an absolute path needs to be provided. Note: Passing in `Nothing`+--   will fail to start up the interpreter in the `MonadSouffle.init` function.+data Config+  = Config+  { cfgDatalogDir :: FilePath+  , cfgSouffleBin :: Maybe FilePath+  } deriving Show++-- | Retrieves the default config for the interpreter. These settings can+--   be overridden using record update syntax if needed.+--+--   By default, the settings will be configured as follows:+--+--   - __cfgDatalogDir__: Looks at environment variable \$DATALOG_DIR,+--   falls back to the current directory if not set.+--   - __cfgSouffleBin__: Looks at environment variable \$SOUFFLE_BIN,+--   or tries to locate the souffle binary using the which shell command+--   if the variable is not set.+defaultConfig :: MonadIO m => m Config+defaultConfig = liftIO $ do+  dlDir <- lookupEnv "DATALOG_DIR"+  envSouffleBin <- fmap Last <$> lookupEnv "SOUFFLE_BIN"+  locatedBin <- fmap Last <$> locateSouffle+  let souffleBin = getLast <$> locatedBin <> envSouffleBin+  pure $ Config (fromMaybe "." dlDir) souffleBin+{-# INLINABLE defaultConfig #-}++-- | Returns an IO action that will run the Souffle interpreter with+--   default settings (see `defaultConfig`).+runSouffle :: SouffleM a -> IO a+runSouffle m = do+  cfg <- defaultConfig+  runSouffleWith cfg m+{-# INLINABLE runSouffle #-}++-- | Returns an IO action that will run the Souffle interpreter with+--   the given interpreter settings.+runSouffleWith :: Config -> SouffleM a -> IO a+runSouffleWith cfg (SouffleM m) = runReaderT m cfg+{-# INLINABLE runSouffleWith #-}++-- | 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 (IORef HandleData)++-- | The data needed for the interpreter is the path where the souffle+--   executable can be found, and a template directory where the program+--   is stored.+data HandleData = HandleData+  { soufflePath :: FilePath+  , basePath    :: FilePath+  , factPath    :: FilePath+  , outputPath  :: FilePath+  , datalogExec :: FilePath+  , noOfThreads :: Word64+  }++newtype IMarshal a = IMarshal (State [String] a)+  deriving+    ( Functor+    , Applicative+    , Monad+    , MonadState [String]+    )+  via (State [String])++popMarshalT :: MarshalM PopF a -> [String] -> a+popMarshalT = runM . interpret popAlgM where+  runM (IMarshal m) = evalState m+  popAlgM (PopStr f) = do+    str <- state (\case+              [] -> error "Empty fact stack"+              (h:t) -> (h, t))+    pure $ f str+  popAlgM (PopInt f) = do+    int <- state (\case+              [] -> error "Empty fact stack"+              (h:t) -> (read h, t))+    pure $ f int+{-# INLINABLE popMarshalT #-}++pushMarshalT :: MarshalM PushF a -> [String]+pushMarshalT = runM . interpret pushAlgM where+  runM (IMarshal m) = reverse $ execState m []+  pushAlgM (PushInt i v) = do+    modify (show i:)+    pure v+  pushAlgM (PushStr s v) = do+    modify (s:)+    pure v+{-# INLINABLE pushMarshalT #-}+++class Collect c where+  collect :: Marshal a => FilePath -> IO (c a)++instance Collect [] where+  collect factFile = do+    factLines <- readCSVFile factFile+    let facts = map (popMarshalT pop) factLines+    pure $! facts+  {-# INLINABLE collect #-}++instance Collect V.Vector where+  collect factFile = V.fromList <$!> collect factFile+  {-# INLINABLE collect #-}++instance MonadSouffle SouffleM where+  type Handler SouffleM = Handle+  type CollectFacts SouffleM c = Collect c++  init :: forall prog. Program prog => prog -> SouffleM (Maybe (Handle prog))+  init prg = SouffleM $ datalogProgramFile prg >>= \case+    Nothing -> pure Nothing+    Just datalogExecutable -> do+      souffleTempDir <- liftIO $ do+        tmpDir <- getCanonicalTemporaryDirectory+        createTempDirectory tmpDir "souffle-haskell"+      let factDir = souffleTempDir </> "fact"+          outDir  = souffleTempDir </> "out"+      liftIO $ do+        createDirectoryIfMissing True factDir+        createDirectoryIfMissing True outDir+      mSouffleBin <- asks cfgSouffleBin+      liftIO $ forM mSouffleBin $ \souffleBin ->+        fmap Handle $ newIORef $ HandleData+          { soufflePath = souffleBin+          , basePath    = souffleTempDir+          , factPath    = factDir+          , outputPath  = outDir+          , datalogExec = datalogExecutable+          , noOfThreads = 1+          }+  {-# INLINABLE init #-}++  run (Handle ref) = liftIO $ do+    handle <- readIORef ref+    -- Invoke the souffle binary using parameters, supposing that the facts+    -- are placed in the factPath, rendering the output into the outputPath.+    callCommand $+      printf "%s -F%s -D%s -j%d %s"+        (soufflePath handle)+        (factPath handle)+        (outputPath handle)+        (noOfThreads handle)+        (datalogExec handle)+  {-# INLINABLE run #-}++  setNumThreads (Handle ref) n = liftIO $+    modifyIORef' ref (\h -> h { noOfThreads = n })+  {-# INLINABLE setNumThreads #-}++  getNumThreads (Handle ref) = liftIO $+    noOfThreads <$> readIORef ref+  {-# INLINABLE getNumThreads #-}++  getFacts :: forall a c prog. (Marshal a, Fact a, ContainsFact prog a, Collect c)+           => Handle prog -> SouffleM (c a)+  getFacts (Handle ref) = liftIO $ do+    handle <- readIORef ref+    let relationName = factName (Proxy :: Proxy a)+    let factFile = outputPath handle </> relationName <.> "csv"+    facts <- collect factFile+    pure $! facts  -- force facts before running to avoid issues with lazy IO+  {-# INLINABLE getFacts #-}++  findFact :: (Fact a, ContainsFact prog a, Eq a)+           => Handle prog -> a -> SouffleM (Maybe a)+  findFact prog fact = do+    facts :: [a] <- getFacts prog+    pure $ find (== fact) facts+  {-# INLINABLE findFact #-}++  addFact :: forall a prog. (Fact a, ContainsFact prog a, Marshal a)+          => Handle prog -> a -> SouffleM ()+  addFact (Handle ref) fact = liftIO $ do+    handle <- readIORef ref+    let relationName = factName (Proxy :: Proxy a)+    let factFile = factPath handle </> relationName <.> "facts"+    let line = pushMarshalT (push fact)+    appendFile factFile $ intercalate "\t" line ++ "\n"+  {-# INLINABLE addFact #-}++  addFacts :: forall a prog f. (Fact a, ContainsFact prog a, Marshal a, Foldable f)+           => Handle prog -> f a -> SouffleM ()+  addFacts (Handle ref) facts = SouffleM $ liftIO $ do+    handle <- readIORef ref+    let relationName = factName (Proxy :: Proxy a)+    let factFile = factPath handle </> relationName <.> "facts"+    let factLines = map (pushMarshalT . push) (foldMap pure facts)+    traverse_ (\line -> appendFile factFile (intercalate "\t" line ++ "\n")) factLines+  {-# INLINABLE addFacts #-}++datalogProgramFile :: forall prog. Program prog => prog -> ReaderT Config IO (Maybe FilePath)+datalogProgramFile _ = do+  dir <- asks cfgDatalogDir+  let dlFile = dir </> programName (Proxy :: Proxy prog) <.> "dl"+  liftIO $ doesFileExist dlFile >>= \case+    False -> pure Nothing+    True -> pure $ Just dlFile+{-# INLINABLE datalogProgramFile #-}++locateSouffle :: IO (Maybe FilePath)+locateSouffle = do+  let locateCmd = (shell "which souffle") { std_out = CreatePipe }+  (_, Just hout, _, locateCmdHandle) <- createProcess locateCmd+  waitForProcess locateCmdHandle >>= \case+    ExitFailure _ -> pure Nothing+    ExitSuccess ->+      words <$> hGetContents hout >>= \case+        [souffleBin] -> pure $ Just souffleBin+        _ -> pure Nothing+{-# INLINABLE locateSouffle #-}++readCSVFile :: FilePath -> IO [[String]]+readCSVFile path = doesFileExist path >>= \case+  False -> pure []+  True -> do+    contents <- readFile path+    -- deepseq needed to avoid issues with lazy IO+    pure $ contents `deepseq` (map (splitOn '\t') . lines) contents+{-# INLINABLE readCSVFile #-}++-- | Cleans up the temporary directory that this library has written files to.+--   This functionality is only provided for the interpreted version since the+--   compiled version directly (de-)serializes data via the C++ API.+cleanup :: forall prog. Program prog => Handle prog -> SouffleM ()+cleanup (Handle ref) = liftIO $ do+  handle <- readIORef ref+  traverse_ removeDirectoryRecursive [factPath handle, outputPath handle, basePath handle]+{-# INLINABLE cleanup #-}++splitOn :: Char -> String -> [String]+splitOn c s =+  let (x, rest) = break (== c) s+      rest' = drop 1 rest+   in x : splitOn c rest'+{-# INLINABLE splitOn #-}+

@@ -1,61 +1,61 @@- {-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# LANGUAGE DerivingVia, TypeFamilies #-}-{-# LANGUAGE FlexibleInstances, FlexibleContexts, DataKinds #-}-{-# LANGUAGE UndecidableInstances, DefaultSignatures #-}-{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts, DeriveFunctor #-}+{-# LANGUAGE DefaultSignatures, TypeOperators, RankNTypes #-}  -- | 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.+--   and 'MarshalM' monad. --   Also, a mechanism is exposed for generically deriving marshalling --   and unmarshalling code for simple product types. module Language.Souffle.Marshal-  ( MarshalT-  , runMarshalT-  , Marshal(..)+  ( Marshal(..)+  , PushF(..)+  , PopF(..)+  , MarshalM+  , interpret   ) where -import Control.Monad.Reader-import Control.Monad.Writer-import Control.Monad.State-import Control.Monad.Except-import Control.Monad.RWS+import Control.Monad.Free import GHC.Generics-import Foreign.Ptr import Data.Int import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import qualified Language.Souffle.Internal as Internal import qualified Language.Souffle.Internal.Constraints as C  -type Tuple = Ptr Internal.Tuple+-- | A data type used for deserializing a `Marshal`-able value+--   from Souffle to Haskell, only used internally.+data PopF a+  = PopInt (Int32 -> a)+  | PopStr (String -> a)+  deriving Functor --- | 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)+-- | A data type used for serializing a `Marshal`-able value+--   from Haskell to Souffle, only used internally.+data PushF a+  = PushInt Int32 a+  | PushStr String a+  deriving Functor --- | 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 #-}+-- | The monad used for serializing and deserializing of values that+--   implement the `Marshal` typeclass.+type MarshalM = Free +-- | Helper function for interpreting the actual (de-)serialization of values.+--   This allows both the compiled and interpreted variant to handle+--   (de-)serialization in their own way.+interpret :: Monad m => (forall x. f x -> m x) -> MarshalM f a -> m a+interpret = foldFree+{-# INLINABLE interpret #-}  {- | 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).+pushed/popped one by one. You need to make sure that the marshalling+of 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@@ -69,54 +69,46 @@ -} class Marshal a where   -- | Marshals a value to the datalog side.-  push :: MonadIO m => a -> MarshalT m ()+  push :: a -> MarshalM PushF ()   -- | Unmarshals a value from the datalog side.-  pop :: MonadIO m => MarshalT m a+  pop :: MarshalM PopF 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+  default push :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a))+               => a -> MarshalM PushF ()+  default pop :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a))+              => MarshalM PopF 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+  push int = liftF (PushInt int ())   {-# INLINABLE push #-}-  pop = do-    tuple <- ask-    liftIO $ Internal.tuplePopInt tuple+  pop  = liftF (PopInt id)   {-# INLINABLE pop #-}  instance Marshal String where-  push str = do-    tuple <- ask-    liftIO $ Internal.tuplePushString tuple str+  push str = liftF (PushStr str ())   {-# INLINABLE push #-}-  pop = do-    tuple <- ask-    liftIO $ Internal.tuplePopString tuple+  pop  = liftF (PopStr id)   {-# INLINABLE pop #-}  instance Marshal T.Text where   push = push . T.unpack   {-# INLINABLE push #-}-  pop = T.pack <$> pop+  pop  = T.pack <$> pop   {-# INLINABLE pop #-}  instance Marshal TL.Text where   push = push . TL.unpack   {-# INLINABLE push #-}-  pop = TL.pack <$> pop+  pop  = TL.pack <$> pop   {-# INLINABLE pop #-}  class GMarshal f where-  gpush :: MonadIO m => f a -> MarshalT m ()-  gpop :: MonadIO m => MarshalT m (f a)+  gpush :: f a -> MarshalM PushF ()+  gpop  :: MarshalM PopF (f a)  instance Marshal a => GMarshal (K1 i a) where   gpush (K1 x) = push x@@ -137,4 +129,3 @@   {-# INLINABLE gpush #-}   gpop = M1 <$> gpop   {-# INLINABLE gpop #-}-

@@ -19,7 +19,7 @@ -- @ -- module Main where -- import Language.Haskell.TH.Syntax as Souffle--- Souffle.embedProgram "path/to/file.cpp"  -- NOTE: call directly on top level!+-- Souffle.embedProgram "path\/to\/file.cpp"  -- NOTE: call directly on top level! -- @ embedProgram :: String -> Q [Dec] embedProgram path = [] <$ qAddForeignFilePath LangCxx path

@@ -1,13 +1,13 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 16e962a64944c83557da55c667cc898e3e27687753e1f4439a658668e50b015b+-- hash: 3cc0bdbc7d2a4e5c9d8aa3151d7c875a61de85bddc1f6d1136c77e58cb874c3e  name:           souffle-haskell-version:        0.1.0+version:        0.2.0 synopsis:       Souffle Datalog bindings for Haskell description:    Souffle Datalog bindings for Haskell. category:       Logic Programming, Foreign Binding, Bindings@@ -15,7 +15,7 @@ bug-reports:    https://github.com/luc-tielen/souffle-haskell/issues author:         Luc Tielen maintainer:     luc.tielen@gmail.com-copyright:      2019 Luc Tielen+copyright:      2020 Luc Tielen license:        MIT license-file:   LICENSE build-type:     Simple@@ -32,9 +32,12 @@ library   exposed-modules:       Language.Souffle+      Language.Souffle.Class+      Language.Souffle.Compiled       Language.Souffle.Internal       Language.Souffle.Internal.Bindings       Language.Souffle.Internal.Constraints+      Language.Souffle.Interpreted       Language.Souffle.Marshal       Language.Souffle.TH   other-modules:@@ -43,7 +46,7 @@       Paths_souffle_haskell   hs-source-dirs:       lib-  default-extensions: OverloadedStrings+  default-extensions: OverloadedStrings LambdaCase ScopedTypeVariables   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@@ -51,11 +54,20 @@       cbits/souffle.cpp   build-depends:       base >=4.12 && <5+    , deepseq >=1.4.4 && <2+    , directory >=1.3.3 && <2+    , filepath >=1.4.2 && <2+    , free >=5.1 && <6     , mtl >=2.0 && <3+    , process >=1.6 && <2     , template-haskell >=2 && <3+    , temporary >=1.3 && <2     , text >=1.0 && <2     , type-errors-pretty >=0.0.1.0 && <1     , vector <=1.0+  if os(linux)+    extra-libraries:+        stdc++   default-language: Haskell2010   build-tools:       souffle@@ -64,24 +76,32 @@   type: exitcode-stdio-1.0   main-is: test.hs   other-modules:-      Test.TestSuiteSpec+      Test.Language.Souffle.CompiledSpec+      Test.Language.Souffle.InterpretedSpec       Paths_souffle_haskell   hs-source-dirs:       tests-  default-extensions: OverloadedStrings+  default-extensions: OverloadedStrings LambdaCase ScopedTypeVariables   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-tools:       souffle   build-depends:       base >=4.12 && <5+    , deepseq >=1.4.4 && <2+    , directory >=1.3.3 && <2+    , filepath >=1.4.2 && <2+    , free >=5.1 && <6     , hspec >=2.6.1 && <3.0.0     , mtl >=2.0 && <3+    , process >=1.6 && <2     , souffle-haskell     , template-haskell >=2 && <3+    , temporary >=1.3 && <2     , text >=1.0 && <2     , type-errors-pretty >=0.0.1.0 && <1     , vector <=1.0+  if os(darwin)+    extra-libraries:+        c++   default-language: Haskell2010

@@ -0,0 +1,175 @@+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds #-}+{-# LANGUAGE TypeFamilies, DeriveGeneric #-}++module Test.Language.Souffle.CompiledSpec+  ( module Test.Language.Souffle.CompiledSpec+  ) where++import Test.Hspec+import GHC.Generics+import Data.Maybe+import qualified Data.Vector as V+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"+++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 as a list" $ 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 "can retrieve facts as a vector" $ 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` V.fromList [Edge "a" "b", Edge "b" "c"]+      reachables `shouldBe` V.fromList [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]++    it "returns no facts 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"]++    -- NOTE: this is different compared to interpreted version (bug in Souffle?)+    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,183 @@++{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, DeriveGeneric #-}++module Test.Language.Souffle.InterpretedSpec+  ( module Test.Language.Souffle.InterpretedSpec+  ) where++import Test.Hspec+import GHC.Generics+import Data.Maybe+import qualified Data.Vector as V+import qualified Language.Souffle.Interpreted as Souffle+++data Path = Path++data PathNoInput = PathNoInput  -- doesn't mark edge as an input++data BadPath = BadPath++data Edge = Edge String String+  deriving (Eq, Show, Generic)++data Reachable = Reachable String String+  deriving (Eq, Show, Generic)++instance Souffle.Fact Edge where+  factName = const "edge"++instance Souffle.Fact Reachable where+  factName = const "reachable"++instance Souffle.Marshal Edge+instance Souffle.Marshal Reachable++instance Souffle.Program Path where+  type ProgramFacts Path = [Edge, Reachable]+  programName = const "path"++instance Souffle.Program PathNoInput where+  type ProgramFacts PathNoInput = [Edge, Reachable]+  programName = const "path_no_input"++instance Souffle.Program BadPath where+  type ProgramFacts BadPath = [Edge, Reachable]+  programName = const "bad_path"+++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 $ do+        handle <- fromJust <$> Souffle.init Path+        Souffle.cleanup handle+        pure $ Just handle+      isJust prog `shouldBe` True++  describe "getFacts" $ parallel $ do+    it "can retrieve facts as a list" $ do+      (edges, reachables) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init PathNoInput+        Souffle.run prog+        es <- Souffle.getFacts prog+        rs <- Souffle.getFacts prog+        Souffle.cleanup prog+        pure (es , rs)+      edges `shouldBe` [Edge "a" "b", Edge "b" "c"]+      reachables `shouldBe` [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]++    it "can retrieve facts as a vector" $ do+      (edges, reachables) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init PathNoInput+        Souffle.run prog+        es <- Souffle.getFacts prog+        rs <- Souffle.getFacts prog+        Souffle.cleanup prog+        pure (es , rs)+      edges `shouldBe` V.fromList [Edge "a" "b", Edge "b" "c"]+      reachables `shouldBe` V.fromList [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]++    it "returns no facts if program hasn't run yet" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        results <- Souffle.getFacts prog+        Souffle.cleanup prog+        pure results+      edges `shouldBe` ([] :: [Edge])++  describe "addFact" $ parallel $ do+    it "adds a fact" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.addFact prog $ Edge "e" "f"+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` [Edge "a" "b", Edge "b" "c", Edge "e" "f"]++    -- NOTE: this is different compared to compiled version (bug in Souffle?)+    it "can not add a fact if it is not marked as input" $ do+      reachables <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init PathNoInput+        Souffle.addFact prog $ Reachable "e" "f"+        Souffle.run prog+        Souffle.getFacts prog+      reachables `shouldBe`+        [ Reachable "a" "b", Reachable "a" "c", Reachable "b" "c" ]++  describe "addFacts" $ parallel $+    it "can add multiple facts at once" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.addFacts prog [Edge "e" "f", Edge "f" "g"]+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` [Edge "a" "b", Edge "b" "c", Edge "e" "f", Edge "f" "g"]++  describe "run" $ parallel $ do+    it "is OK to run a program multiple times" $ do+      edges <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init PathNoInput+        Souffle.run prog+        Souffle.run prog+        facts <- Souffle.getFacts prog+        Souffle.cleanup prog+        pure facts+      edges `shouldBe` [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]++    it "discovers new facts after running with new facts" $ do+      (reachablesBefore, reachablesAfter) <- Souffle.runSouffle $ do+        prog <- fromJust <$> Souffle.init Path+        Souffle.addFacts prog [Edge "c" "d"]+        Souffle.run prog+        rs1 <- Souffle.getFacts prog+        Souffle.addFacts prog [Edge "b" "e"]+        Souffle.run prog+        rs2 <- Souffle.getFacts prog+        Souffle.cleanup prog+        pure (rs1, rs2)+      reachablesBefore `shouldBe`+        [ Reachable "a" "b", Reachable "a" "c", Reachable "a" "d"+        , Reachable "b" "c", Reachable "b" "d", Reachable "c" "d" ]+      reachablesAfter `shouldBe`+        [ Reachable "a" "b", Reachable "a" "c", Reachable "a" "d"+        , Reachable "a" "e", Reachable "b" "c", Reachable "b" "d"+        , Reachable "b" "e", Reachable "c" "d" ]++  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 PathNoInput+        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 PathNoInput+        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")

@@ -1,173 +0,0 @@--{-# 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-import qualified Data.Vector as V--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"---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 as a list" $ 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 "can retrieve facts as a vector" $ 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` V.fromList [Edge "a" "b", Edge "b" "c"]-      reachables `shouldBe` V.fromList [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]--    it "returns no facts 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