-- | An internal module, providing a slightly higher level interface than
--   "Language.Souffle.Internal.Bindings".
--   It uses more commonly found data types instead of the low level C types
--   for easier integration with other parts of a Haskell application.
--   Also it takes care of garbage collection so other modules do not have
--   to take this into account anymore.
--
--   Used only internally, so prone to changes, use at your own risk.
module Language.Souffle.Internal
  ( Souffle
  , Relation
  , ByteBuf
  , init
  , setNumThreads
  , getNumThreads
  , run
  , loadAll
  , printAll
  , getRelation
  , pushFacts
  , popFacts
  , containsFact
  ) where

import Prelude hiding ( init )
import Data.Functor ( (<&>) )
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import qualified Language.Souffle.Internal.Bindings as Bindings
import Language.Souffle.Internal.Bindings
  ( Souffle, Relation, ByteBuf )
import Control.Exception (mask_)


{- | Initializes a Souffle program.

     The string argument is the name of the program and should be the same
     as the filename (minus the .dl extension).

     The action will return 'Nothing' if it failed to load the Souffle program.
     Otherwise it will return a pointer that can be used in other functions
     in this module.
-}
init :: String -> IO (Maybe (ForeignPtr Souffle))
init :: String -> IO (Maybe (ForeignPtr Souffle))
init String
prog = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
  Ptr Souffle
ptr <- forall a. String -> (CString -> IO a) -> IO a
withCString String
prog CString -> IO (Ptr Souffle)
Bindings.init
  if Ptr Souffle
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Souffle -> IO ())
Bindings.free Ptr Souffle
ptr
{-# INLINABLE init #-}

-- | Sets the number of CPU cores this Souffle program should use.
setNumThreads :: ForeignPtr Souffle -> Word64 -> IO ()
setNumThreads :: ForeignPtr Souffle -> Word64 -> IO ()
setNumThreads ForeignPtr Souffle
prog Word64
numThreads = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog forall a b. (a -> b) -> a -> b
$ \Ptr Souffle
ptr ->
    Ptr Souffle -> CSize -> IO ()
Bindings.setNumThreads Ptr Souffle
ptr forall a b. (a -> b) -> a -> b
$ Word64 -> CSize
CSize Word64
numThreads
{-# INLINABLE setNumThreads #-}

-- | Gets the number of CPU cores this Souffle program should use.
getNumThreads :: ForeignPtr Souffle -> IO Word64
getNumThreads :: ForeignPtr Souffle -> IO Word64
getNumThreads ForeignPtr Souffle
prog = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog forall a b. (a -> b) -> a -> b
$ \Ptr Souffle
ptr -> do
    (CSize Word64
numThreads) <- Ptr Souffle -> IO CSize
Bindings.getNumThreads Ptr Souffle
ptr
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
numThreads
{-# INLINABLE getNumThreads #-}

-- | Runs the Souffle program.
run :: ForeignPtr Souffle -> IO ()
run :: ForeignPtr Souffle -> IO ()
run ForeignPtr Souffle
prog = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog Ptr Souffle -> IO ()
Bindings.run
{-# INLINABLE run #-}

-- | Load all facts from files in a certain directory.
loadAll :: ForeignPtr Souffle -> FilePath -> IO ()
loadAll :: ForeignPtr Souffle -> String -> IO ()
loadAll ForeignPtr Souffle
prog String
inputDir = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
inputDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Souffle -> CString -> IO ()
Bindings.loadAll
{-# INLINABLE loadAll #-}

-- | Write out all facts of the program to CSV files in a certain directory
--   (as defined in the Souffle program).
printAll :: ForeignPtr Souffle -> FilePath -> IO ()
printAll :: ForeignPtr Souffle -> String -> IO ()
printAll ForeignPtr Souffle
prog String
outputDir = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
outputDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Souffle -> CString -> IO ()
Bindings.printAll
{-# INLINABLE printAll #-}

{-| Lookup a relation by name in the Souffle program.

    Note that the returned pointer can be 'nullPtr' if it is not defined
    in the Souffle program.
-}
getRelation :: ForeignPtr Souffle -> String -> IO (Ptr Relation)
getRelation :: ForeignPtr Souffle -> String -> IO (Ptr Relation)
getRelation ForeignPtr Souffle
prog String
relation = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog forall a b. (a -> b) -> a -> b
$ \Ptr Souffle
ptr ->
  forall a. String -> (CString -> IO a) -> IO a
withCString String
relation forall a b. (a -> b) -> a -> b
$ Ptr Souffle -> CString -> IO (Ptr Relation)
Bindings.getRelation Ptr Souffle
ptr
{-# INLINABLE getRelation #-}

{-| Serializes many facts from Datalog to Haskell.

    You need to check if the passed pointers are non-NULL before passing it
    to this function. Not doing so results in undefined behavior.
    Passing in a different count of objects to what is actually inside the
    byte buffer will crash.
-}
pushFacts :: Ptr Relation -> Ptr ByteBuf -> Word64 -> IO ()
pushFacts :: Ptr Relation -> Ptr ByteBuf -> Word64 -> IO ()
pushFacts Ptr Relation
relation Ptr ByteBuf
buf Word64
x =
  Ptr Relation -> Ptr ByteBuf -> CSize -> IO ()
Bindings.pushByteBuf Ptr Relation
relation Ptr ByteBuf
buf (Word64 -> CSize
CSize Word64
x)
{-# INLINABLE pushFacts #-}

{-| Serializes many facts from Haskell to Datalog.

    You need to check if the passed pointer is non-NULL before passing it
    to this function. Not doing so results in undefined behavior.

    Returns a pointer to a byte buffer that contains the serialized Datalog facts.
-}
popFacts :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)
popFacts :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)
popFacts = Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)
Bindings.popByteBuf
{-# INLINABLE popFacts #-}

{- | Checks if a relation contains a certain tuple.

     Returns True if the tuple was found in the relation; otherwise False.
-}
containsFact :: Ptr Relation -> Ptr ByteBuf -> IO Bool
containsFact :: Ptr Relation -> Ptr ByteBuf -> IO Bool
containsFact Ptr Relation
relation Ptr ByteBuf
buf =
  Ptr Relation -> Ptr ByteBuf -> IO CBool
Bindings.containsTuple Ptr Relation
relation Ptr ByteBuf
buf forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    CBool Word8
0 -> Bool
False
    CBool Word8
_ -> Bool
True
{-# INLINABLE containsFact #-}