{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE 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
  , souffleStdOut
  , souffleStdErr
  ) where

import Prelude hiding (init)

import Control.DeepSeq (deepseq)
import Control.Exception (ErrorCall(..), throwIO)
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.Text as T
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, hClose)
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 (a -> SouffleM b -> SouffleM a
(a -> b) -> SouffleM a -> SouffleM b
(forall a b. (a -> b) -> SouffleM a -> SouffleM b)
-> (forall a b. a -> SouffleM b -> SouffleM a) -> Functor SouffleM
forall a b. a -> SouffleM b -> SouffleM a
forall a b. (a -> b) -> SouffleM a -> SouffleM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SouffleM b -> SouffleM a
$c<$ :: forall a b. a -> SouffleM b -> SouffleM a
fmap :: (a -> b) -> SouffleM a -> SouffleM b
$cfmap :: forall a b. (a -> b) -> SouffleM a -> SouffleM b
Functor, Functor SouffleM
a -> SouffleM a
Functor SouffleM =>
(forall a. a -> SouffleM a)
-> (forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b)
-> (forall a b c.
    (a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM b)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM a)
-> Applicative SouffleM
SouffleM a -> SouffleM b -> SouffleM b
SouffleM a -> SouffleM b -> SouffleM a
SouffleM (a -> b) -> SouffleM a -> SouffleM b
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
forall a. a -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM b
forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b
forall a b c.
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SouffleM a -> SouffleM b -> SouffleM a
$c<* :: forall a b. SouffleM a -> SouffleM b -> SouffleM a
*> :: SouffleM a -> SouffleM b -> SouffleM b
$c*> :: forall a b. SouffleM a -> SouffleM b -> SouffleM b
liftA2 :: (a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
<*> :: SouffleM (a -> b) -> SouffleM a -> SouffleM b
$c<*> :: forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b
pure :: a -> SouffleM a
$cpure :: forall a. a -> SouffleM a
$cp1Applicative :: Functor SouffleM
Applicative, Applicative SouffleM
a -> SouffleM a
Applicative SouffleM =>
(forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM b)
-> (forall a. a -> SouffleM a)
-> Monad SouffleM
SouffleM a -> (a -> SouffleM b) -> SouffleM b
SouffleM a -> SouffleM b -> SouffleM b
forall a. a -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM b
forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SouffleM a
$creturn :: forall a. a -> SouffleM a
>> :: SouffleM a -> SouffleM b -> SouffleM b
$c>> :: forall a b. SouffleM a -> SouffleM b -> SouffleM b
>>= :: SouffleM a -> (a -> SouffleM b) -> SouffleM b
$c>>= :: forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b
$cp1Monad :: Applicative SouffleM
Monad, Monad SouffleM
Monad SouffleM =>
(forall a. IO a -> SouffleM a) -> MonadIO SouffleM
IO a -> SouffleM a
forall a. IO a -> SouffleM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SouffleM a
$cliftIO :: forall a. IO a -> SouffleM a
$cp1MonadIO :: Monad SouffleM
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.
--   - __cfgFactDir__: The directory where the initial input fact file(s) can be found
--   if present. If Nothing, then a temporary directory will be used, during the
--   souffle session.
--   - __cfgOutputDir__: The directory where the output facts file(s) are created.
--   If Nothing, it will be part of the temporary directory.
data Config
  = Config
  { Config -> FilePath
cfgDatalogDir   :: FilePath
  , Config -> Maybe FilePath
cfgSouffleBin   :: Maybe FilePath
  , Config -> Maybe FilePath
cfgFactDir      :: Maybe FilePath
  , Config -> Maybe FilePath
cfgOutputDir    :: Maybe FilePath
  } deriving Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
(Int -> Config -> ShowS)
-> (Config -> FilePath) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
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.
--   - __cfgFactDir__: Will make use of a temporary directory.
--   - __cfgOutputDir__: Will make use of a temporary directory.
defaultConfig :: MonadIO m => m Config
defaultConfig :: m Config
defaultConfig = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
  Maybe FilePath
dlDir <- FilePath -> IO (Maybe FilePath)
lookupEnv "DATALOG_DIR"
  Maybe (Last FilePath)
envSouffleBin <- (FilePath -> Last FilePath)
-> Maybe FilePath -> Maybe (Last FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Last FilePath
forall a. a -> Last a
Last (Maybe FilePath -> Maybe (Last FilePath))
-> IO (Maybe FilePath) -> IO (Maybe (Last FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv "SOUFFLE_BIN"
  Maybe (Last FilePath)
locatedBin <- (FilePath -> Last FilePath)
-> Maybe FilePath -> Maybe (Last FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Last FilePath
forall a. a -> Last a
Last (Maybe FilePath -> Maybe (Last FilePath))
-> IO (Maybe FilePath) -> IO (Maybe (Last FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath)
locateSouffle
  let souffleBin :: Maybe FilePath
souffleBin = Last FilePath -> FilePath
forall a. Last a -> a
getLast (Last FilePath -> FilePath)
-> Maybe (Last FilePath) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Last FilePath)
locatedBin Maybe (Last FilePath)
-> Maybe (Last FilePath) -> Maybe (Last FilePath)
forall a. Semigroup a => a -> a -> a
<> Maybe (Last FilePath)
envSouffleBin
  Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> Config
Config (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe "." Maybe FilePath
dlDir) Maybe FilePath
souffleBin Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
{-# INLINABLE defaultConfig #-}

-- | Returns an IO action that will run the Souffle interpreter with
--   default settings (see `defaultConfig`).
runSouffle :: SouffleM a -> IO a
runSouffle :: SouffleM a -> IO a
runSouffle m :: SouffleM a
m = do
  Config
cfg <- IO Config
forall (m :: * -> *). MonadIO m => m Config
defaultConfig
  Config -> SouffleM a -> IO a
forall a. Config -> SouffleM a -> IO a
runSouffleWith Config
cfg SouffleM a
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 :: Config -> SouffleM a -> IO a
runSouffleWith cfg :: Config
cfg (SouffleM m :: ReaderT Config IO a
m) = ReaderT Config IO a -> Config -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Config IO a
m Config
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.
data Handle prog = Handle
  { Handle prog -> IORef HandleData
handleData   :: IORef HandleData
  , Handle prog -> IORef (Maybe Text)
stdoutResult :: IORef (Maybe T.Text)
  , Handle prog -> IORef (Maybe Text)
stderrResult :: IORef (Maybe T.Text)
  }

-- | 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
  { HandleData -> FilePath
soufflePath :: FilePath
  , HandleData -> FilePath
basePath    :: FilePath
  , HandleData -> FilePath
factPath    :: FilePath
  , HandleData -> FilePath
outputPath  :: FilePath
  , HandleData -> FilePath
datalogExec :: FilePath
  , HandleData -> Word64
noOfThreads :: Word64
  }

newtype IMarshal a = IMarshal (State [String] a)
  deriving (a -> IMarshal b -> IMarshal a
(a -> b) -> IMarshal a -> IMarshal b
(forall a b. (a -> b) -> IMarshal a -> IMarshal b)
-> (forall a b. a -> IMarshal b -> IMarshal a) -> Functor IMarshal
forall a b. a -> IMarshal b -> IMarshal a
forall a b. (a -> b) -> IMarshal a -> IMarshal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IMarshal b -> IMarshal a
$c<$ :: forall a b. a -> IMarshal b -> IMarshal a
fmap :: (a -> b) -> IMarshal a -> IMarshal b
$cfmap :: forall a b. (a -> b) -> IMarshal a -> IMarshal b
Functor, Functor IMarshal
a -> IMarshal a
Functor IMarshal =>
(forall a. a -> IMarshal a)
-> (forall a b. IMarshal (a -> b) -> IMarshal a -> IMarshal b)
-> (forall a b c.
    (a -> b -> c) -> IMarshal a -> IMarshal b -> IMarshal c)
-> (forall a b. IMarshal a -> IMarshal b -> IMarshal b)
-> (forall a b. IMarshal a -> IMarshal b -> IMarshal a)
-> Applicative IMarshal
IMarshal a -> IMarshal b -> IMarshal b
IMarshal a -> IMarshal b -> IMarshal a
IMarshal (a -> b) -> IMarshal a -> IMarshal b
(a -> b -> c) -> IMarshal a -> IMarshal b -> IMarshal c
forall a. a -> IMarshal a
forall a b. IMarshal a -> IMarshal b -> IMarshal a
forall a b. IMarshal a -> IMarshal b -> IMarshal b
forall a b. IMarshal (a -> b) -> IMarshal a -> IMarshal b
forall a b c.
(a -> b -> c) -> IMarshal a -> IMarshal b -> IMarshal c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: IMarshal a -> IMarshal b -> IMarshal a
$c<* :: forall a b. IMarshal a -> IMarshal b -> IMarshal a
*> :: IMarshal a -> IMarshal b -> IMarshal b
$c*> :: forall a b. IMarshal a -> IMarshal b -> IMarshal b
liftA2 :: (a -> b -> c) -> IMarshal a -> IMarshal b -> IMarshal c
$cliftA2 :: forall a b c.
(a -> b -> c) -> IMarshal a -> IMarshal b -> IMarshal c
<*> :: IMarshal (a -> b) -> IMarshal a -> IMarshal b
$c<*> :: forall a b. IMarshal (a -> b) -> IMarshal a -> IMarshal b
pure :: a -> IMarshal a
$cpure :: forall a. a -> IMarshal a
$cp1Applicative :: Functor IMarshal
Applicative, Applicative IMarshal
a -> IMarshal a
Applicative IMarshal =>
(forall a b. IMarshal a -> (a -> IMarshal b) -> IMarshal b)
-> (forall a b. IMarshal a -> IMarshal b -> IMarshal b)
-> (forall a. a -> IMarshal a)
-> Monad IMarshal
IMarshal a -> (a -> IMarshal b) -> IMarshal b
IMarshal a -> IMarshal b -> IMarshal b
forall a. a -> IMarshal a
forall a b. IMarshal a -> IMarshal b -> IMarshal b
forall a b. IMarshal a -> (a -> IMarshal b) -> IMarshal b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> IMarshal a
$creturn :: forall a. a -> IMarshal a
>> :: IMarshal a -> IMarshal b -> IMarshal b
$c>> :: forall a b. IMarshal a -> IMarshal b -> IMarshal b
>>= :: IMarshal a -> (a -> IMarshal b) -> IMarshal b
$c>>= :: forall a b. IMarshal a -> (a -> IMarshal b) -> IMarshal b
$cp1Monad :: Applicative IMarshal
Monad, MonadState [String])
  via (State [String])

instance MonadPush IMarshal where
  pushInt :: Int32 -> IMarshal ()
pushInt int :: Int32
int = ([FilePath] -> [FilePath]) -> IMarshal ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int32 -> FilePath
forall a. Show a => a -> FilePath
show Int32
intFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)
  {-# INLINABLE pushInt #-}

  pushString :: FilePath -> IMarshal ()
pushString str :: FilePath
str = ([FilePath] -> [FilePath]) -> IMarshal ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FilePath
strFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)
  {-# INLINABLE pushString #-}

instance MonadPop IMarshal where
  popInt :: IMarshal Int32
popInt = ([FilePath] -> (Int32, [FilePath])) -> IMarshal Int32
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (([FilePath] -> (Int32, [FilePath])) -> IMarshal Int32)
-> ([FilePath] -> (Int32, [FilePath])) -> IMarshal Int32
forall a b. (a -> b) -> a -> b
$ \case
    [] -> FilePath -> (Int32, [FilePath])
forall a. HasCallStack => FilePath -> a
error "Empty fact stack"
    (h :: FilePath
h:t :: [FilePath]
t) -> (FilePath -> Int32
forall a. Read a => FilePath -> a
read FilePath
h, [FilePath]
t)
  {-# INLINABLE popInt #-}

  popString :: IMarshal FilePath
popString = ([FilePath] -> (FilePath, [FilePath])) -> IMarshal FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (([FilePath] -> (FilePath, [FilePath])) -> IMarshal FilePath)
-> ([FilePath] -> (FilePath, [FilePath])) -> IMarshal FilePath
forall a b. (a -> b) -> a -> b
$ \case
    [] -> FilePath -> (FilePath, [FilePath])
forall a. HasCallStack => FilePath -> a
error "Empty fact stack"
    (h :: FilePath
h:t :: [FilePath]
t) -> (FilePath
h, [FilePath]
t)
  {-# INLINABLE popString #-}

popMarshalT :: IMarshal a -> [String] -> a
popMarshalT :: IMarshal a -> [FilePath] -> a
popMarshalT (IMarshal m :: State [FilePath] a
m) = State [FilePath] a -> [FilePath] -> a
forall s a. State s a -> s -> a
evalState State [FilePath] a
m
{-# INLINABLE popMarshalT #-}

pushMarshalT :: IMarshal a -> [String]
pushMarshalT :: IMarshal a -> [FilePath]
pushMarshalT (IMarshal m :: State [FilePath] a
m) = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ State [FilePath] a -> [FilePath] -> [FilePath]
forall s a. State s a -> s -> s
execState State [FilePath] a
m []
{-# INLINABLE pushMarshalT #-}

class Collect c where
  collect :: Marshal a => FilePath -> IO (c a)

instance Collect [] where
  collect :: FilePath -> IO [a]
collect factFile :: FilePath
factFile = do
    [[FilePath]]
factLines <- FilePath -> IO [[FilePath]]
readCSVFile FilePath
factFile
    let facts :: [a]
facts = ([FilePath] -> a) -> [[FilePath]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (IMarshal a -> [FilePath] -> a
forall a. IMarshal a -> [FilePath] -> a
popMarshalT IMarshal a
forall a (m :: * -> *). (Marshal a, MonadPop m) => m a
pop) [[FilePath]]
factLines
    [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$! [a]
facts
  {-# INLINABLE collect #-}

instance Collect V.Vector where
  collect :: FilePath -> IO (Vector a)
collect factFile :: FilePath
factFile = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> IO [a] -> IO (Vector a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> FilePath -> IO [a]
forall (c :: * -> *) a.
(Collect c, Marshal a) =>
FilePath -> IO (c a)
collect FilePath
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 :: prog -> SouffleM (Maybe (Handle prog))
init prg :: prog
prg = ReaderT Config IO (Maybe (Handle prog))
-> SouffleM (Maybe (Handle prog))
forall a. ReaderT Config IO a -> SouffleM a
SouffleM (ReaderT Config IO (Maybe (Handle prog))
 -> SouffleM (Maybe (Handle prog)))
-> ReaderT Config IO (Maybe (Handle prog))
-> SouffleM (Maybe (Handle prog))
forall a b. (a -> b) -> a -> b
$ prog -> ReaderT Config IO (Maybe FilePath)
forall prog.
Program prog =>
prog -> ReaderT Config IO (Maybe FilePath)
datalogProgramFile prog
prg ReaderT Config IO (Maybe FilePath)
-> (Maybe FilePath -> ReaderT Config IO (Maybe (Handle prog)))
-> ReaderT Config IO (Maybe (Handle prog))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nothing -> Maybe (Handle prog) -> ReaderT Config IO (Maybe (Handle prog))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Handle prog)
forall a. Maybe a
Nothing
    Just datalogExecutable :: FilePath
datalogExecutable -> do
      FilePath
souffleTempDir <- IO FilePath -> ReaderT Config IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ReaderT Config IO FilePath)
-> IO FilePath -> ReaderT Config IO FilePath
forall a b. (a -> b) -> a -> b
$ do
        FilePath
tmpDir <- IO FilePath
getCanonicalTemporaryDirectory
        FilePath -> FilePath -> IO FilePath
createTempDirectory FilePath
tmpDir "souffle-haskell"

      FilePath
factDir <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
souffleTempDir FilePath -> ShowS
</> "fact") (Maybe FilePath -> FilePath)
-> ReaderT Config IO (Maybe FilePath) -> ReaderT Config IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Config -> Maybe FilePath) -> ReaderT Config IO (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe FilePath
cfgFactDir
      FilePath
outDir <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
souffleTempDir FilePath -> ShowS
</> "out") (Maybe FilePath -> FilePath)
-> ReaderT Config IO (Maybe FilePath) -> ReaderT Config IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Config -> Maybe FilePath) -> ReaderT Config IO (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe FilePath
cfgOutputDir
      IO () -> ReaderT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Config IO ()) -> IO () -> ReaderT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
factDir
        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
outDir
      Maybe FilePath
mSouffleBin <- (Config -> Maybe FilePath) -> ReaderT Config IO (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe FilePath
cfgSouffleBin
      IO (Maybe (Handle prog)) -> ReaderT Config IO (Maybe (Handle prog))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Handle prog))
 -> ReaderT Config IO (Maybe (Handle prog)))
-> IO (Maybe (Handle prog))
-> ReaderT Config IO (Maybe (Handle prog))
forall a b. (a -> b) -> a -> b
$ Maybe FilePath
-> (FilePath -> IO (Handle prog)) -> IO (Maybe (Handle prog))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe FilePath
mSouffleBin ((FilePath -> IO (Handle prog)) -> IO (Maybe (Handle prog)))
-> (FilePath -> IO (Handle prog)) -> IO (Maybe (Handle prog))
forall a b. (a -> b) -> a -> b
$ \souffleBin :: FilePath
souffleBin ->
        IORef HandleData
-> IORef (Maybe Text) -> IORef (Maybe Text) -> Handle prog
forall prog.
IORef HandleData
-> IORef (Maybe Text) -> IORef (Maybe Text) -> Handle prog
Handle
          (IORef HandleData
 -> IORef (Maybe Text) -> IORef (Maybe Text) -> Handle prog)
-> IO (IORef HandleData)
-> IO (IORef (Maybe Text) -> IORef (Maybe Text) -> Handle prog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandleData -> IO (IORef HandleData)
forall a. a -> IO (IORef a)
newIORef (HandleData -> IO (IORef HandleData))
-> HandleData -> IO (IORef HandleData)
forall a b. (a -> b) -> a -> b
$ HandleData :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Word64
-> HandleData
HandleData
                { soufflePath :: FilePath
soufflePath = FilePath
souffleBin
                , basePath :: FilePath
basePath    = FilePath
souffleTempDir
                , factPath :: FilePath
factPath    = FilePath
factDir
                , outputPath :: FilePath
outputPath  = FilePath
outDir
                , datalogExec :: FilePath
datalogExec = FilePath
datalogExecutable
                , noOfThreads :: Word64
noOfThreads = 1
                })
          IO (IORef (Maybe Text) -> IORef (Maybe Text) -> Handle prog)
-> IO (IORef (Maybe Text))
-> IO (IORef (Maybe Text) -> Handle prog)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef Maybe Text
forall a. Maybe a
Nothing
          IO (IORef (Maybe Text) -> Handle prog)
-> IO (IORef (Maybe Text)) -> IO (Handle prog)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef Maybe Text
forall a. Maybe a
Nothing
  {-# INLINABLE init #-}

  run :: Handler SouffleM prog -> SouffleM ()
run (Handle refHandleData refHandleStdOut refHandleStdErr) = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
    HandleData
handle <- IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef IORef HandleData
refHandleData
    -- Invoke the souffle binary using parameters, supposing that the facts
    -- are placed in the factPath, rendering the output into the outputPath.
    let processToRun :: CreateProcess
processToRun =
          (FilePath -> CreateProcess
shell
            (FilePath -> FilePath -> FilePath -> FilePath -> Word64 -> ShowS
forall r. PrintfType r => FilePath -> r
printf "%s -F%s -D%s -j%d %s"
              (HandleData -> FilePath
soufflePath HandleData
handle)
              (HandleData -> FilePath
factPath HandleData
handle)
              (HandleData -> FilePath
outputPath HandleData
handle)
              (HandleData -> Word64
noOfThreads HandleData
handle)
              (HandleData -> FilePath
datalogExec HandleData
handle)))
            { std_in :: StdStream
std_in  = StdStream
NoStream
            , std_out :: StdStream
std_out = StdStream
CreatePipe
            , std_err :: StdStream
std_err = StdStream
CreatePipe
            }
    (_, mStdOutHandle :: Maybe Handle
mStdOutHandle, mStdErrHandle :: Maybe Handle
mStdErrHandle, processHandle :: ProcessHandle
processHandle) <- FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ "souffle-haskell" CreateProcess
processToRun
    ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processHandle IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ExitSuccess   -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ExitFailure c :: Int
c -> ErrorCall -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ErrorCall -> IO ()) -> ErrorCall -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$ "Souffle exited with: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c
    Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Handle
mStdOutHandle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stdoutHandle :: Handle
stdoutHandle -> do
      Text
stdout <- FilePath -> Text
T.pack (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO FilePath
hGetContents Handle
stdoutHandle
      IORef (Maybe Text) -> Maybe Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Text)
refHandleStdOut (Maybe Text -> IO ()) -> Maybe Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Text
stdout
      Handle -> IO ()
hClose Handle
stdoutHandle
    Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Handle
mStdErrHandle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stderrHandle :: Handle
stderrHandle -> do
      Text
stderr <- FilePath -> Text
T.pack (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO FilePath
hGetContents Handle
stderrHandle
      IORef (Maybe Text) -> Maybe Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Text)
refHandleStdErr (Maybe Text -> IO ()) -> Maybe Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Text
stderr
      Handle -> IO ()
hClose Handle
stderrHandle
  {-# INLINABLE run #-}

  setNumThreads :: Handler SouffleM prog -> Word64 -> SouffleM ()
setNumThreads handle :: Handler SouffleM prog
handle n :: Word64
n = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$
    IORef HandleData -> (HandleData -> HandleData) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handler SouffleM prog
Handle prog
handle) (\h :: HandleData
h -> HandleData
h { noOfThreads :: Word64
noOfThreads = Word64
n })
  {-# INLINABLE setNumThreads #-}

  getNumThreads :: Handler SouffleM prog -> SouffleM Word64
getNumThreads handle :: Handler SouffleM prog
handle = IO Word64 -> SouffleM Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> SouffleM Word64) -> IO Word64 -> SouffleM Word64
forall a b. (a -> b) -> a -> b
$
    HandleData -> Word64
noOfThreads (HandleData -> Word64) -> IO HandleData -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef (Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handler SouffleM prog
Handle prog
handle)
  {-# INLINABLE getNumThreads #-}

  getFacts :: forall a c prog. (Marshal a, Fact a, ContainsFact prog a, Collect c)
           => Handle prog -> SouffleM (c a)
  getFacts :: Handle prog -> SouffleM (c a)
getFacts h :: Handle prog
h = IO (c a) -> SouffleM (c a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (c a) -> SouffleM (c a)) -> IO (c a) -> SouffleM (c a)
forall a b. (a -> b) -> a -> b
$ do
    HandleData
handle <- IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef (IORef HandleData -> IO HandleData)
-> IORef HandleData -> IO HandleData
forall a b. (a -> b) -> a -> b
$ Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handle prog
h
    let relationName :: FilePath
relationName = Proxy a -> FilePath
forall a. Fact a => Proxy a -> FilePath
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    let factFile :: FilePath
factFile = HandleData -> FilePath
outputPath HandleData
handle FilePath -> ShowS
</> FilePath
relationName FilePath -> ShowS
<.> "csv"
    c a
facts <- FilePath -> IO (c a)
forall (c :: * -> *) a.
(Collect c, Marshal a) =>
FilePath -> IO (c a)
collect FilePath
factFile
    c a -> IO (c a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c a -> IO (c a)) -> c a -> IO (c a)
forall a b. (a -> b) -> a -> b
$! c a
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 :: Handle prog -> a -> SouffleM (Maybe a)
findFact prog :: Handle prog
prog fact :: a
fact = do
    [a]
facts :: [a] <- Handler SouffleM prog -> SouffleM [a]
forall (m :: * -> *) a prog (c :: * -> *).
(MonadSouffle m, Fact a, ContainsFact prog a, CollectFacts m c) =>
Handler m prog -> m (c a)
getFacts Handler SouffleM prog
Handle prog
prog
    Maybe a -> SouffleM (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> SouffleM (Maybe a)) -> Maybe a -> SouffleM (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
fact) [a]
facts
  {-# INLINABLE findFact #-}

  addFact :: forall a prog. (Fact a, ContainsFact prog a, Marshal a)
          => Handle prog -> a -> SouffleM ()
  addFact :: Handle prog -> a -> SouffleM ()
addFact h :: Handle prog
h fact :: a
fact = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
    HandleData
handle <- IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef (IORef HandleData -> IO HandleData)
-> IORef HandleData -> IO HandleData
forall a b. (a -> b) -> a -> b
$ Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handle prog
h
    let relationName :: FilePath
relationName = Proxy a -> FilePath
forall a. Fact a => Proxy a -> FilePath
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    let factFile :: FilePath
factFile = HandleData -> FilePath
factPath HandleData
handle FilePath -> ShowS
</> FilePath
relationName FilePath -> ShowS
<.> "facts"
    let line :: [FilePath]
line = IMarshal () -> [FilePath]
forall a. IMarshal a -> [FilePath]
pushMarshalT (a -> IMarshal ()
forall a (m :: * -> *). (Marshal a, MonadPush m) => a -> m ()
push a
fact)
    FilePath -> FilePath -> IO ()
appendFile FilePath
factFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "\t" [FilePath]
line FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
  {-# INLINABLE addFact #-}

  addFacts :: forall a prog f. (Fact a, ContainsFact prog a, Marshal a, Foldable f)
           => Handle prog -> f a -> SouffleM ()
  addFacts :: Handle prog -> f a -> SouffleM ()
addFacts h :: Handle prog
h facts :: f a
facts = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
    HandleData
handle <- IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef (IORef HandleData -> IO HandleData)
-> IORef HandleData -> IO HandleData
forall a b. (a -> b) -> a -> b
$ Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handle prog
h
    let relationName :: FilePath
relationName = Proxy a -> FilePath
forall a. Fact a => Proxy a -> FilePath
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    let factFile :: FilePath
factFile = HandleData -> FilePath
factPath HandleData
handle FilePath -> ShowS
</> FilePath
relationName FilePath -> ShowS
<.> "facts"
    let factLines :: [[FilePath]]
factLines = (a -> [FilePath]) -> [a] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (IMarshal () -> [FilePath]
forall a. IMarshal a -> [FilePath]
pushMarshalT (IMarshal () -> [FilePath])
-> (a -> IMarshal ()) -> a -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IMarshal ()
forall a (m :: * -> *). (Marshal a, MonadPush m) => a -> m ()
push) ((a -> [a]) -> f a -> [a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
facts)
    ([FilePath] -> IO ()) -> [[FilePath]] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\line :: [FilePath]
line -> FilePath -> FilePath -> IO ()
appendFile FilePath
factFile (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "\t" [FilePath]
line FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")) [[FilePath]]
factLines
  {-# INLINABLE addFacts #-}

datalogProgramFile :: forall prog. Program prog => prog -> ReaderT Config IO (Maybe FilePath)
datalogProgramFile :: prog -> ReaderT Config IO (Maybe FilePath)
datalogProgramFile _ = do
  FilePath
dir <- (Config -> FilePath) -> ReaderT Config IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> FilePath
cfgDatalogDir
  let dlFile :: FilePath
dlFile = FilePath
dir FilePath -> ShowS
</> Proxy prog -> FilePath
forall a. Program a => Proxy a -> FilePath
programName (Proxy prog
forall k (t :: k). Proxy t
Proxy :: Proxy prog) FilePath -> ShowS
<.> "dl"
  IO (Maybe FilePath) -> ReaderT Config IO (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> ReaderT Config IO (Maybe FilePath))
-> IO (Maybe FilePath) -> ReaderT Config IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
dlFile IO Bool -> (Bool -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    False -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    True -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dlFile
{-# INLINABLE datalogProgramFile #-}

locateSouffle :: IO (Maybe FilePath)
locateSouffle :: IO (Maybe FilePath)
locateSouffle = do
  let locateCmd :: CreateProcess
locateCmd = (FilePath -> CreateProcess
shell "which souffle") { std_out :: StdStream
std_out = StdStream
CreatePipe }
  (_, Just hout :: Handle
hout, _, locateCmdHandle :: ProcessHandle
locateCmdHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
locateCmd
  ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
locateCmdHandle IO ExitCode
-> (ExitCode -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ExitFailure _ -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    ExitSuccess ->
      FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO FilePath
hGetContents Handle
hout IO [FilePath]
-> ([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [souffleBin :: FilePath
souffleBin] -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
souffleBin
        _ -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
{-# INLINABLE locateSouffle #-}

readCSVFile :: FilePath -> IO [[String]]
readCSVFile :: FilePath -> IO [[FilePath]]
readCSVFile path :: FilePath
path = FilePath -> IO Bool
doesFileExist FilePath
path IO Bool -> (Bool -> IO [[FilePath]]) -> IO [[FilePath]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  False -> [[FilePath]] -> IO [[FilePath]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  True -> do
    FilePath
contents <- FilePath -> IO FilePath
readFile FilePath
path
    -- deepseq needed to avoid issues with lazy IO
    [[FilePath]] -> IO [[FilePath]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FilePath]] -> IO [[FilePath]])
-> [[FilePath]] -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath
contents FilePath -> [[FilePath]] -> [[FilePath]]
forall a b. NFData a => a -> b -> b
`deepseq` ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> FilePath -> [FilePath]
splitOn '\t') ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines) FilePath
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 prog -> SouffleM ()
cleanup h :: Handle prog
h  = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
  HandleData
handle <- IORef HandleData -> IO HandleData
forall a. IORef a -> IO a
readIORef (IORef HandleData -> IO HandleData)
-> IORef HandleData -> IO HandleData
forall a b. (a -> b) -> a -> b
$ Handle prog -> IORef HandleData
forall prog. Handle prog -> IORef HandleData
handleData Handle prog
h
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
removeDirectoryRecursive [HandleData -> FilePath
factPath HandleData
handle, HandleData -> FilePath
outputPath HandleData
handle, HandleData -> FilePath
basePath HandleData
handle]
{-# INLINABLE cleanup #-}

-- | Returns the handle of stdout from the souffle interpreter.
souffleStdOut :: forall prog. Program prog => Handle prog -> SouffleM (Maybe T.Text)
souffleStdOut :: Handle prog -> SouffleM (Maybe Text)
souffleStdOut = IO (Maybe Text) -> SouffleM (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> SouffleM (Maybe Text))
-> (Handle prog -> IO (Maybe Text))
-> Handle prog
-> SouffleM (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Text) -> IO (Maybe Text))
-> (Handle prog -> IORef (Maybe Text))
-> Handle prog
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle prog -> IORef (Maybe Text)
forall prog. Handle prog -> IORef (Maybe Text)
stdoutResult

-- | Returns the content of stderr from the souffle interpreter.
souffleStdErr :: forall prog. Program prog => Handle prog -> SouffleM (Maybe T.Text)
souffleStdErr :: Handle prog -> SouffleM (Maybe Text)
souffleStdErr = IO (Maybe Text) -> SouffleM (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> SouffleM (Maybe Text))
-> (Handle prog -> IO (Maybe Text))
-> Handle prog
-> SouffleM (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Text) -> IO (Maybe Text))
-> (Handle prog -> IORef (Maybe Text))
-> Handle prog
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle prog -> IORef (Maybe Text)
forall prog. Handle prog -> IORef (Maybe Text)
stderrResult

splitOn :: Char -> String -> [String]
splitOn :: Char -> FilePath -> [FilePath]
splitOn c :: Char
c s :: FilePath
s =
  let (x :: FilePath
x, rest :: FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) FilePath
s
      rest' :: FilePath
rest' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 FilePath
rest
   in FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Char -> FilePath -> [FilePath]
splitOn Char
c FilePath
rest'
{-# INLINABLE splitOn #-}