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

import Prelude hiding ( init )
import Data.Functor ( (<&>) )
import Data.Word
import Data.Int
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import qualified Language.Souffle.Internal.Bindings as Bindings
import Language.Souffle.Internal.Bindings
  ( Souffle, Relation, RelationIterator, Tuple )


{- | Initializes a Souffle program.

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

     The action will return 'Nothing' if it failed to load the Souffle program.
     Otherwise it will return a pointer that can be used in other functions
     in this module.
-}
init :: String -> IO (Maybe (ForeignPtr Souffle))
init :: String -> IO (Maybe (ForeignPtr Souffle))
init prog :: String
prog = do
  Ptr Souffle
ptr <- String -> (CString -> IO (Ptr Souffle)) -> IO (Ptr Souffle)
forall a. String -> (CString -> IO a) -> IO a
withCString String
prog CString -> IO (Ptr Souffle)
Bindings.init
  if Ptr Souffle
ptr Ptr Souffle -> Ptr Souffle -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Souffle
forall a. Ptr a
nullPtr
    then Maybe (ForeignPtr Souffle) -> IO (Maybe (ForeignPtr Souffle))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ForeignPtr Souffle)
forall a. Maybe a
Nothing
    else ForeignPtr Souffle -> Maybe (ForeignPtr Souffle)
forall a. a -> Maybe a
Just (ForeignPtr Souffle -> Maybe (ForeignPtr Souffle))
-> IO (ForeignPtr Souffle) -> IO (Maybe (ForeignPtr Souffle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr Souffle -> Ptr Souffle -> IO (ForeignPtr Souffle)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Souffle
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 prog :: ForeignPtr Souffle
prog numThreads :: Word64
numThreads = ForeignPtr Souffle -> (Ptr Souffle -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog ((Ptr Souffle -> IO ()) -> IO ())
-> (Ptr Souffle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Souffle
ptr ->
    Ptr Souffle -> CSize -> IO ()
Bindings.setNumThreads Ptr Souffle
ptr (CSize -> IO ()) -> CSize -> IO ()
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 prog :: ForeignPtr Souffle
prog = ForeignPtr Souffle -> (Ptr Souffle -> IO Word64) -> IO Word64
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog ((Ptr Souffle -> IO Word64) -> IO Word64)
-> (Ptr Souffle -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Souffle
ptr -> do
    (CSize numThreads :: Word64
numThreads) <- Ptr Souffle -> IO CSize
Bindings.getNumThreads Ptr Souffle
ptr
    Word64 -> IO Word64
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 prog :: ForeignPtr Souffle
prog = ForeignPtr Souffle -> (Ptr Souffle -> IO ()) -> IO ()
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 prog :: ForeignPtr Souffle
prog inputDir :: String
inputDir = ForeignPtr Souffle -> (Ptr Souffle -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog ((Ptr Souffle -> IO ()) -> IO ())
-> (Ptr Souffle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
inputDir ((CString -> IO ()) -> IO ())
-> (Ptr Souffle -> CString -> IO ()) -> Ptr Souffle -> IO ()
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 prog :: ForeignPtr Souffle
prog outputDir :: String
outputDir = ForeignPtr Souffle -> (Ptr Souffle -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog ((Ptr Souffle -> IO ()) -> IO ())
-> (Ptr Souffle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
outputDir ((CString -> IO ()) -> IO ())
-> (Ptr Souffle -> CString -> IO ()) -> Ptr Souffle -> IO ()
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 prog :: ForeignPtr Souffle
prog relation :: String
relation = ForeignPtr Souffle
-> (Ptr Souffle -> IO (Ptr Relation)) -> IO (Ptr Relation)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Souffle
prog ((Ptr Souffle -> IO (Ptr Relation)) -> IO (Ptr Relation))
-> (Ptr Souffle -> IO (Ptr Relation)) -> IO (Ptr Relation)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Souffle
ptr ->
  String -> (CString -> IO (Ptr Relation)) -> IO (Ptr Relation)
forall a. String -> (CString -> IO a) -> IO a
withCString String
relation ((CString -> IO (Ptr Relation)) -> IO (Ptr Relation))
-> (CString -> IO (Ptr Relation)) -> IO (Ptr Relation)
forall a b. (a -> b) -> a -> b
$ Ptr Souffle -> CString -> IO (Ptr Relation)
Bindings.getRelation Ptr Souffle
ptr
{-# INLINABLE getRelation #-}

-- | Returns the amount of facts found in a relation.
countFacts :: Ptr Relation -> IO Int
countFacts :: Ptr Relation -> IO Int
countFacts relation :: Ptr Relation
relation =
  Ptr Relation -> IO CSize
Bindings.getTupleCount Ptr Relation
relation IO CSize -> (CSize -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(CSize count :: Word64
count) ->
    -- TODO: check what happens for really large sizes?
    Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
count)

-- | Create an iterator for iterating over the facts of a relation.
getRelationIterator :: Ptr Relation -> IO (ForeignPtr RelationIterator)
getRelationIterator :: Ptr Relation -> IO (ForeignPtr RelationIterator)
getRelationIterator relation :: Ptr Relation
relation =
  Ptr Relation -> IO (Ptr RelationIterator)
Bindings.getRelationIterator Ptr Relation
relation IO (Ptr RelationIterator)
-> (Ptr RelationIterator -> IO (ForeignPtr RelationIterator))
-> IO (ForeignPtr RelationIterator)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr RelationIterator
-> Ptr RelationIterator -> IO (ForeignPtr RelationIterator)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr RelationIterator
Bindings.freeRelationIterator
{-# INLINABLE getRelationIterator #-}

{-| Advances the relation iterator by 1 position.

    Calling this function when there are no more results to be returned
    will result in a crash.
-}
relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple)
relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple)
relationIteratorNext iter :: ForeignPtr RelationIterator
iter = ForeignPtr RelationIterator
-> (Ptr RelationIterator -> IO (Ptr Tuple)) -> IO (Ptr Tuple)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr RelationIterator
iter Ptr RelationIterator -> IO (Ptr Tuple)
Bindings.relationIteratorNext
{-# INLINABLE relationIteratorNext #-}

-- | Allocates memory for a tuple (fact) to be added to a relation.
allocTuple :: Ptr Relation -> IO (ForeignPtr Tuple)
allocTuple :: Ptr Relation -> IO (ForeignPtr Tuple)
allocTuple relation :: Ptr Relation
relation =
  Ptr Relation -> IO (Ptr Tuple)
Bindings.allocTuple Ptr Relation
relation IO (Ptr Tuple)
-> (Ptr Tuple -> IO (ForeignPtr Tuple)) -> IO (ForeignPtr Tuple)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr Tuple -> Ptr Tuple -> IO (ForeignPtr Tuple)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Tuple
Bindings.freeTuple
{-# INLINABLE allocTuple #-}

-- | Adds a tuple (fact) to a relation.
addTuple :: Ptr Relation -> ForeignPtr Tuple -> IO ()
addTuple :: Ptr Relation -> ForeignPtr Tuple -> IO ()
addTuple relation :: Ptr Relation
relation tuple :: ForeignPtr Tuple
tuple =
  ForeignPtr Tuple -> (Ptr Tuple -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tuple
tuple ((Ptr Tuple -> IO ()) -> IO ()) -> (Ptr Tuple -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Relation -> Ptr Tuple -> IO ()
Bindings.addTuple Ptr Relation
relation
{-# INLINABLE addTuple #-}

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

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

-- | Pushes an integer value into a tuple.
tuplePushInt :: Ptr Tuple -> Int32 -> IO ()
tuplePushInt :: Ptr Tuple -> Int32 -> IO ()
tuplePushInt tuple :: Ptr Tuple
tuple i :: Int32
i = Ptr Tuple -> CInt -> IO ()
Bindings.tuplePushInt Ptr Tuple
tuple (Int32 -> CInt
CInt Int32
i)
{-# INLINABLE tuplePushInt #-}

-- | Pushes a string value into a tuple.
tuplePushString :: Ptr Tuple -> String -> IO ()
tuplePushString :: Ptr Tuple -> String -> IO ()
tuplePushString tuple :: Ptr Tuple
tuple str :: String
str =
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Tuple -> CString -> IO ()
Bindings.tuplePushString Ptr Tuple
tuple
{-# INLINABLE tuplePushString #-}

-- | Extracts an integer value from a tuple.
tuplePopInt :: Ptr Tuple -> IO Int32
tuplePopInt :: Ptr Tuple -> IO Int32
tuplePopInt tuple :: Ptr Tuple
tuple = (Ptr CInt -> IO Int32) -> IO Int32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Int32) -> IO Int32)
-> (Ptr CInt -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do
  Ptr Tuple -> Ptr CInt -> IO ()
Bindings.tuplePopInt Ptr Tuple
tuple Ptr CInt
ptr
  (CInt res :: Int32
res) <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
  Int32 -> IO Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
res
{-# INLINABLE tuplePopInt #-}

-- | Extracts a string value from a tuple.
tuplePopString :: Ptr Tuple -> IO String
tuplePopString :: Ptr Tuple -> IO String
tuplePopString tuple :: Ptr Tuple
tuple = (Ptr CString -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO String) -> IO String)
-> (Ptr CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CString
ptr -> do
  Ptr Tuple -> Ptr CString -> IO ()
Bindings.tuplePopString Ptr Tuple
tuple Ptr CString
ptr
  CString
cstr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
ptr
  String
str <- CString -> IO String
peekCString CString
cstr
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cstr
  String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str
{-# INLINABLE tuplePopString #-}