souffle-haskell 0.0.1 → 0.1.0

raw patch · 11 files changed

+149/−98 lines, 11 filesdep +textdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: text, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +5/−2
• cbits/souffle.cpp +9/−10
• cbits/souffle.h +11/−11
• lib/Language/Souffle.hs +48/−21
• lib/Language/Souffle/Internal.hs +10/−14
• lib/Language/Souffle/Internal/Bindings.hs +13/−13
• lib/Language/Souffle/Internal/Constraints.hs +5/−1
• lib/Language/Souffle/Marshal.hs +13/−0
• souffle-haskell.cabal +10/−2
• tests/Test/TestSuiteSpec.hs +13/−24

@@ -5,6 +5,18 @@ The CHANGELOG is available on [Github](https://github.com/luc-tielen/souffle-haskell.git/CHANGELOG.md).  +## [0.1.0] - 2019-12-21+### Added++- Added Marshal instance for lazy and strict Text++### Changed++- getFacts can now return a vector instead of a list, based on type inference.+  This allows for a more efficient representation in memory as well+  as being able to allocate all needed memory once before collecting facts.++ ## [0.0.1] - 2019-10-23 ### Added 

@@ -2,6 +2,7 @@ # Souffle-haskell  [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://github.com/luc-tielen/souffle-haskell/blob/master/LICENSE)+[![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).@@ -52,6 +53,7 @@ import Data.Foldable ( traverse_ ) import Control.Monad.IO.Class import GHC.Generics+import Data.Vector import qualified Language.Souffle.TH as Souffle import qualified Language.Souffle as Souffle @@ -65,7 +67,7 @@ data Path = Path  -- Facts are represent in Haskell as simple product types,--- Numbers map to Int32, Strings to symbols.+-- Numbers map to Int32, symbols to Strings / Text.  data Edge = Edge String String   deriving (Eq, Show, Generic)@@ -114,7 +116,8 @@       --       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+      --       A list of facts can also be returned here.+      results :: Vector Reachable <- Souffle.getFacts prog       liftIO $ traverse_ print results        -- We can also look for a specific fact:

@@ -54,31 +54,30 @@         return reinterpret_cast<relation_t*>(relation);     } +    size_t souffle_relation_tuple_count(relation_t* relation) {+        auto rel = reinterpret_cast<souffle::Relation*>(relation);+        assert(rel);+        return rel->size();+    }+     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(const iterator_t& it)+            : iterator(it) {}     };      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());+        relation_iterator_t* it = new relation_iterator_t(rel->begin());         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) {

@@ -83,6 +83,15 @@     relation_t* souffle_relation(souffle_t* program, const char* relation_name);      /*+     * Gets the amount of tuples found in 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 the amount of tuples found in a relation.+     */+    size_t souffle_relation_tuple_count(relation_t* relation);++    /*      * 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.@@ -100,20 +109,11 @@     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.+     * Calling this function when there are no more tuples to be returned+     * will result in a crash.      *      * Returns a pointer to the next record. This pointer is not allowed to be freed.      */

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, DataKinds #-} {-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators #-}-{-# LANGUAGE DerivingVia, InstanceSigs, UndecidableInstances #-}+{-# 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@@ -16,6 +16,7 @@   , Fact(..)   , Marshal.Marshal(..)   , Handle+  , CollectFacts   , MonadSouffle(..)   , SouffleM   , runSouffle@@ -34,6 +35,8 @@ 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 @@ -103,6 +106,38 @@   { 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.@@ -131,12 +166,14 @@    -- | 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]+  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.+  --   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) @@ -190,34 +227,24 @@     traverse_ (addFact' relation) facts   {-# INLINABLE addFacts #-} -  getFacts :: forall a prog. (Fact a, ContainsFact prog a)-           => Handle prog -> SouffleM [a]+  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-    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+    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)+           => 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+    pure $ if found then Just a else Nothing   {-# INLINABLE findFact #-}  addFact' :: Fact a => Ptr Internal.Relation -> a -> IO ()

@@ -21,8 +21,8 @@   , loadAll   , printAll   , getRelation+  , countFacts   , getRelationIterator-  , relationIteratorHasNext   , relationIteratorNext   , allocTuple   , addTuple@@ -104,27 +104,23 @@   withCString relation $ Bindings.getRelation ptr {-# INLINABLE getRelation #-} +-- | Returns the amount of facts found in a relation.+countFacts :: Ptr Relation -> IO Int+countFacts relation =+  Bindings.getTupleCount relation >>= \(CSize count) ->+    -- TODO: check what happens for really large sizes?+    pure (fromIntegral count)+ -- | 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.+    Calling this function when there are no more results to be returned+    will result in a crash. -} relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple) relationIteratorNext iter = withForeignPtr iter Bindings.relationIteratorNext

@@ -15,9 +15,9 @@   , loadAll   , printAll   , getRelation+  , getTupleCount   , getRelationIterator   , freeRelationIterator-  , relationIteratorHasNext   , relationIteratorNext   , allocTuple   , freeTuple@@ -124,6 +124,16 @@ foreign import ccall unsafe "souffle_relation" getRelation   :: Ptr Souffle -> CString -> IO (Ptr Relation) +{-| Gets the amount of tuples found in 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++).++    Returns the amount of tuples found in a relation.+-}+foreign import ccall unsafe "souffle_relation_tuple_count" getTupleCount+  :: Ptr Relation -> IO CSize+ {-| 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@@ -143,23 +153,13 @@ 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.+    Calling this function when there are no more tuples to be returned+    will result in a crash.      Returns a pointer to the next tuple. This pointer is not allowed to be freed     as it is managed by the Souffle program already.

@@ -12,6 +12,8 @@ import GHC.Generics import Data.Kind import Data.Int+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL   -- | A helper type family used for generating a more user-friendly type error@@ -54,10 +56,12 @@   OnlySimpleField t (K1 _ a) = DirectlyMarshallable t a  type family DirectlyMarshallable (a :: Type) (b :: Type) :: Constraint where+  DirectlyMarshallable _ T.Text = ()+  DirectlyMarshallable _ TL.Text = ()   DirectlyMarshallable _ Int32 = ()   DirectlyMarshallable _ String = ()   DirectlyMarshallable t a =     TypeError ( "Error while generating marshalling code for " <> t <> ":"-              % "Can only marshal values of Int32 and String directly"+              % "Can only marshal values of Int32, String and Text directly"              <> ", but found " <> a <> " type instead.") 

@@ -24,6 +24,8 @@ 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 @@ -100,6 +102,17 @@     liftIO $ Internal.tuplePopString tuple   {-# INLINABLE pop #-} +instance Marshal T.Text where+  push = push . T.unpack+  {-# INLINABLE push #-}+  pop = T.pack <$> pop+  {-# INLINABLE pop #-}++instance Marshal TL.Text where+  push = push . TL.unpack+  {-# INLINABLE push #-}+  pop = TL.pack <$> pop+  {-# INLINABLE pop #-}  class GMarshal f where   gpush :: MonadIO m => f a -> MarshalT m ()

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a74bc91fd3ca58647ff0b218a4aec49ebe837c8af230504def1bf57726751265+-- hash: 16e962a64944c83557da55c667cc898e3e27687753e1f4439a658668e50b015b  name:           souffle-haskell-version:        0.0.1+version:        0.1.0 synopsis:       Souffle Datalog bindings for Haskell description:    Souffle Datalog bindings for Haskell. category:       Logic Programming, Foreign Binding, Bindings@@ -53,8 +53,12 @@       base >=4.12 && <5     , mtl >=2.0 && <3     , template-haskell >=2 && <3+    , text >=1.0 && <2     , type-errors-pretty >=0.0.1.0 && <1+    , vector <=1.0   default-language: Haskell2010+  build-tools:+      souffle  test-suite souffle-haskell-test   type: exitcode-stdio-1.0@@ -69,11 +73,15 @@   cpp-options: -std=c++17 -D__EMBEDDED_SOUFFLE__   extra-libraries:       c+++  build-tools:+      souffle   build-depends:       base >=4.12 && <5     , hspec >=2.6.1 && <3.0.0     , mtl >=2.0 && <3     , souffle-haskell     , template-haskell >=2 && <3+    , text >=1.0 && <2     , type-errors-pretty >=0.0.1.0 && <1+    , vector <=1.0   default-language: Haskell2010

@@ -9,6 +9,7 @@ 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" @@ -40,29 +41,7 @@   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@@ -75,7 +54,7 @@       isJust prog `shouldBe` True    describe "getFacts" $ parallel $ do-    it "can retrieve facts" $ do+    it "can retrieve facts as a list" $ do       (edges, reachables) <- Souffle.runSouffle $ do         prog <- fromJust <$> Souffle.init Path         Souffle.run prog@@ -85,7 +64,17 @@       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+    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