Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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.
Synopsis
- class Program a where
- type ProgramFacts a :: [Type]
- programName :: a -> String
- newtype ProgramOptions prog progName facts = ProgramOptions prog
- class Marshal a => Fact a where
- type FactDirection a :: Direction
- factName :: Proxy a -> String
- newtype FactOptions fact factName dir = FactOptions fact
- class Marshal a where
- data Direction
- = Input
- | Output
- | InputOutput
- | Internal
- type family ContainsInputFact prog fact where ...
- type family ContainsOutputFact prog fact where ...
- data Config = Config {}
- data Handle prog
- data SouffleM a
- class Monad m => MonadSouffle m where
- type Handler m :: Type -> Type
- type CollectFacts m (c :: Type -> Type) :: Constraint
- type SubmitFacts m (a :: Type) :: Constraint
- run :: Handler m prog -> m ()
- setNumThreads :: Handler m prog -> Word64 -> m ()
- getNumThreads :: Handler m prog -> m Word64
- getFacts :: (Fact a, ContainsOutputFact prog a, CollectFacts m c) => Handler m prog -> m (c a)
- findFact :: (Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a) => Handler m prog -> a -> m (Maybe a)
- addFact :: (Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> a -> m ()
- addFacts :: (Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> t a -> m ()
- runSouffle :: Program prog => prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a
- runSouffleWith :: Program prog => Config -> prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a
- defaultConfig :: MonadIO m => m Config
- souffleStdOut :: forall prog. Program prog => Handle prog -> SouffleM (Maybe Text)
- souffleStdErr :: forall prog. Program prog => Handle prog -> SouffleM (Maybe Text)
Documentation
class Program a where Source #
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] programName = const "path"
type ProgramFacts a :: [Type] Source #
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.
programName :: a -> String Source #
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).
Instances
KnownSymbol progName => Program (ProgramOptions prog progName facts) Source # | |
Defined in Language.Souffle.Class type ProgramFacts (ProgramOptions prog progName facts) :: [Type] Source # programName :: ProgramOptions prog progName facts -> String Source # |
newtype ProgramOptions prog progName facts Source #
A helper data type, used in combination with the DerivingVia extension to automatically generate code to bind Haskell to a Souffle Datalog program.
The following is an example how to bind to a Datalog program "path" (saved as path.dl / path.cpp), that uses two facts called "edge" and "reachable" (represented with the Edge and Reachable types):
data Path = Path deriving Souffle.Program via Souffle.ProgramOptions Path "path" '[Edge, Reachable]
See also: FactOptions
.
ProgramOptions prog |
Instances
KnownSymbol progName => Program (ProgramOptions prog progName facts) Source # | |
Defined in Language.Souffle.Class type ProgramFacts (ProgramOptions prog progName facts) :: [Type] Source # programName :: ProgramOptions prog progName facts -> String Source # | |
type ProgramFacts (ProgramOptions prog progName facts) Source # | |
Defined in Language.Souffle.Class |
class Marshal a => Fact a where Source #
A typeclass for data types representing a fact in datalog.
Example usage:
instance Fact Edge where type FactDirection Edge = 'Input factName = const "edge"
type FactDirection a :: Direction Source #
The direction or "mode" a fact can be used in.
This is used to perform compile-time checks that a fact is only used
in valid situations. For more information, see the Direction
type.
factName :: Proxy a -> String Source #
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.
Instances
(Marshal fact, KnownSymbol factName) => Fact (FactOptions fact factName dir) Source # | |
Defined in Language.Souffle.Class type FactDirection (FactOptions fact factName dir) :: Direction Source # |
newtype FactOptions fact factName dir Source #
A helper data type, used in combination with the DerivingVia extension to automatically generate code to bind a Haskell datatype to a Souffle Datalog fact.
The following is an example how to bind to a Datalog fact "edge" that contains two symbols (strings in Haskell) that is an input (from the Datalog point of view):
data Edge = Edge String String deriving (Eq, Show, Generic) deriving anyclass Souffle.Marshal deriving Souffle.Fact via Souffle.FactOptions Edge "edge" 'Souffle.Input
See also: ProgramOptions
.
FactOptions fact |
Instances
(Marshal fact, KnownSymbol factName) => Fact (FactOptions fact factName dir) Source # | |
Defined in Language.Souffle.Class type FactDirection (FactOptions fact factName dir) :: Direction Source # | |
Marshal fact => Marshal (FactOptions fact name dir) Source # | |
Defined in Language.Souffle.Class push :: MonadPush m => FactOptions fact name dir -> m () Source # pop :: MonadPop m => m (FactOptions fact name dir) Source # | |
type FactDirection (FactOptions fact factName dir) Source # | |
Defined in Language.Souffle.Class |
class Marshal a where Source #
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. 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). The ordering of how nested products are serialized is the same as when the fields of the nested product types are inlined into the parent type.
Generic implementations for push
and pop
that perform the previously
described behavior are available. This makes it possible to
write very succinct code:
data Edge = Edge String String deriving Generic instance Marshal Edge
Nothing
push :: MonadPush m => a -> m () Source #
Marshals a value to the datalog side.
pop :: MonadPop m => m a Source #
Unmarshals a value from the datalog side.
Instances
Marshal Int32 Source # | |
Marshal Word32 Source # | |
Marshal Text Source # | |
Marshal Text Source # | |
Marshal String Source # | |
Marshal Float Source # | |
Marshal fact => Marshal (FactOptions fact name dir) Source # | |
Defined in Language.Souffle.Class push :: MonadPush m => FactOptions fact name dir -> m () Source # pop :: MonadPop m => m (FactOptions fact name dir) Source # |
A datatype describing which operations a certain fact supports. The direction is from the datalog perspective, so that it aligns with ".decl" statements in Souffle.
Input | Fact can only be stored in Datalog (using |
Output | Fact can only be read from Datalog (using |
InputOutput | Fact supports both reading from / writing to Datalog. |
Internal | Supports neither reading from / writing to Datalog. This is used for facts that are only visible inside Datalog itself. |
type family ContainsInputFact prog fact where ... Source #
A helper type family for checking if a specific Souffle Program
contains
a certain Fact
. Additionally, it also checks if the fact is marked as
either Input
or InputOutput
. This constraint will generate a
user-friendly type error if these conditions are not met.
ContainsInputFact prog fact = (ContainsFact prog fact, IsInput fact (FactDirection fact)) |
type family ContainsOutputFact prog fact where ... Source #
A helper type family for checking if a specific Souffle Program
contains
a certain Fact
. Additionally, it also checks if the fact is marked as
either Output
or InputOutput
. This constraint will generate a
user-friendly type error if these conditions are not met.
ContainsOutputFact prog fact = (ContainsFact prog fact, IsOutput fact (FactDirection fact)) |
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 theinit
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 fact file(s) are created. If Nothing, it will be part of the temporary directory.
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.
A monad for executing Souffle-related actions in.
Instances
class Monad m => MonadSouffle m where Source #
A mtl-style typeclass for Souffle-related actions.
type Handler m :: Type -> Type Source #
Represents a handle for interacting with a Souffle program.
The handle is used in all other functions of this typeclass to perform Souffle-related actions.
type CollectFacts m (c :: Type -> Type) :: Constraint Source #
Helper associated type constraint that allows collecting facts from Souffle in a list or vector. Only used internally.
type SubmitFacts m (a :: Type) :: Constraint Source #
Helper associated type constraint that allows submitting facts to Souffle. Only used internally.
run :: Handler m prog -> m () Source #
Runs the Souffle program.
setNumThreads :: Handler m prog -> Word64 -> m () Source #
Sets the number of CPU cores this Souffle program should use.
getNumThreads :: Handler m prog -> m Word64 Source #
Gets the number of CPU cores this Souffle program should use.
getFacts :: (Fact a, ContainsOutputFact prog a, CollectFacts m c) => Handler m prog -> m (c a) Source #
Returns all facts of a program. This function makes use of type inference to select the type of fact to return.
findFact :: (Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a) => Handler m prog -> a -> m (Maybe a) Source #
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.
addFact :: (Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> a -> m () Source #
Adds a fact to the program.
addFacts :: (Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> t a -> m () Source #
Adds multiple facts to the program. This function could be implemented
in terms of addFact
, but this is done as a minor optimization.
Instances
runSouffle :: Program prog => prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a Source #
Initializes and runs a Souffle program with default settings.
The 2nd argument is passed in a handle after initialization of the
Souffle program. The handle will contain Nothing
if it failed to
locate the souffle interpreter executable or if it failed to find the
souffle program file. In the successful case it will contain a handle
that can be used for performing Souffle related actions using the other
functions in this module.
runSouffleWith :: Program prog => Config -> prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a Source #
Initializes and runs a Souffle program with the given interpreter settings.
The 3rd argument is passed in a handle after initialization of the
Souffle program. The handle will contain Nothing
if it failed to
locate the souffle interpreter executable or if it failed to find the
souffle program file. In the successful case it will contain a handle
that can be used for performing Souffle related actions using the other
functions in this module.
If the config settings do not specify a fact or output dir, temporary directories will be created for storing files in. These directories will also be automatically cleaned up at the end of this function.
defaultConfig :: MonadIO m => m Config Source #
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.