Copyright | (c) Olaf Klinke |
---|---|
License | GPL-3 |
Maintainer | olaf.klinke@phymetric.de |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
The Provenience system lets you execute a function on particular input data while automatically recording the intermediate results together with a graph of the data flow. It is inspired by the Javelin software of the 80s which pre-dates Excel spreadsheets.
Intermediate results are stored in Variable
s,
which decorate the data with a description.
Instead of binding data to a Haskell identifier,
you bind data to a Variable
and provide a description of
what the data is.
Instead of applying a logical part to intermediate data,
you apply the logical part to intermediate variables. So instead of writing code like
workflow x y z = let a = f x y b = g a z in h b
with Provenience
you write
workflow x y z = do x' <-input
x y' <-input
y z' <-input
z a <-var
f<%>
x'<%>
y' b <-var
g<%>
a z'return
(var
h<%>
b)
In addition to the above you should provide decoration for the variables which is
used when rendering the data dependency graph. See <?
and named
.
If and how the value
of the variable is rendered is controlled
with the render
family functions and the DefaultRender
class.
The ProvenienceT
transformer has an additional type parameter
for a machine-readable representation of a value.
If you don't care about this, just use the unit type () here
as in the Provenience
type.
Otherwise, all calls to render
must be done on Variable
s of types which
have a Representation
in the chosen alternative type.
After running the ProvenienceT
computation you can extract
the graph containing the alternative representations using graphAltReps
.
If the target representation is a spreadsheet, use renderSheet
to obtain a spreadsheet where Variable
s are blocks of rows
separated by blank rows.
Synopsis
- data Variable a = Variable {
- identifier :: Node
- value :: a
- data VariableStore alt
- var :: Monad m => a -> ProvenienceT alt m a
- varM :: Monad m => m a -> ProvenienceT alt m a
- input :: (Monad m, Representation a alt, DefaultRender a) => a -> ProvenienceT alt m a
- inputM :: (Monad m, Representation a alt, DefaultRender a) => m a -> ProvenienceT alt m a
- func :: (Monad m, Default alt) => a -> Block -> ProvenienceT alt m a
- type StoreUpdate = forall m alt. Monad m => StateT (VariableStore alt) m ()
- (<?) :: Variable a -> Block -> StoreUpdate
- named :: Variable a -> String -> StoreUpdate
- linkto :: Monad m => Variable a -> StateT (VariableStore alt) m Inline
- render :: (Representation a alt, Monad m, DefaultRender a) => Variable a -> StateT (VariableStore alt) m ()
- renderWith :: (Representation a alt, Monad m) => (a -> Block) -> Variable a -> StateT (VariableStore alt) m ()
- renderShow :: Show a => a -> Block
- class DefaultRender a where
- renderDefault :: a -> Block
- data Proveniencei18n = Proveniencei18n {}
- enProveniencei18n :: Proveniencei18n
- deProveniencei18n :: Proveniencei18n
- renderStore :: Proveniencei18n -> VariableStore alt -> Block
- renderSheet :: forall row sheet. (ToSheet row sheet, ToRow StaticCellValue row) => Proveniencei18n -> VariableStore (Seq row) -> sheet
- graphAltReps :: VariableStore alt -> Gr alt Block
- graphShortnames :: VariableStore alt -> Gr String Block
- type ProvenienceT alt m a = StateT (VariableStore alt) m (Variable a)
- type Provenience a = State (VariableStore ()) (Variable a)
- (<%>) :: Monad m => ProvenienceT alt m (a -> b) -> Variable a -> ProvenienceT alt m b
- (<%%>) :: Monad m => ProvenienceT alt m (a -> m b) -> Variable a -> ProvenienceT alt m b
- runProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
- execProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m (VariableStore alt, Node)
- execProvenience :: Provenience a -> Node -> (VariableStore (), Node)
- evalProvenienceT :: Monad m => ProvenienceT alt m a -> m a
- evalProvenience :: Provenience a -> a
- sequenceProvenienceT :: (Traversable t, Monad m) => t (ProvenienceT alt m a) -> m (t (a, VariableStore alt))
Variables
Every Variable
has an identifier
in the data flow graph.
Variable | |
|
data VariableStore alt Source #
var :: Monad m => a -> ProvenienceT alt m a Source #
Register a new variable in the VariableStore
.
This variable has neither description
, shortname
nor valueRendering
.
var
=varM
.pure
varM :: Monad m => m a -> ProvenienceT alt m a Source #
Register a new variable with content
from a monadic action in the VariableStore
.
This variable has neither description
, shortname
nor valueRendering
.
input :: (Monad m, Representation a alt, DefaultRender a) => a -> ProvenienceT alt m a Source #
Register a static input variable which is immediately render
ed.
inputM :: (Monad m, Representation a alt, DefaultRender a) => m a -> ProvenienceT alt m a Source #
Register a static input variable
with content from a monad action
which is immediately render
ed.
Modifiers
type StoreUpdate = forall m alt. Monad m => StateT (VariableStore alt) m () Source #
Action on the VariableStore
(<?) :: Variable a -> Block -> StoreUpdate infixl 3 Source #
The what is this?-operator. Changes the description
of the computation's result.
>>>
v <- var 99
>>>
v <? renderDefault "bottles of beer on the wall"
named :: Variable a -> String -> StoreUpdate Source #
Provides a shortname
symbol for the Variable
, for use in hyperlinks and other references.
>>>
v <- var 99
>>>
v `named` "beer"
Rendering
render :: (Representation a alt, Monad m, DefaultRender a) => Variable a -> StateT (VariableStore alt) m () Source #
.
You can use this function without providing a render
= renderWith
renderDefault
DefaultRender
instance
by using a conversion function to a type that is member of DefaultRender
:
\f ->render
.fmap
f
renderWith :: (Representation a alt, Monad m) => (a -> Block) -> Variable a -> StateT (VariableStore alt) m () Source #
Supply the valueRendering
and altRep
for the variable.
class DefaultRender a where Source #
Class of types with a default rendering method.
For the basic types renderDefault
equals renderShow
.
renderDefault :: a -> Block Source #
Instances
DefaultRender Char Source # | |
Defined in Control.Provenience renderDefault :: Char -> Block Source # | |
DefaultRender Double Source # | |
Defined in Control.Provenience renderDefault :: Double -> Block Source # | |
DefaultRender Int Source # | |
Defined in Control.Provenience renderDefault :: Int -> Block Source # | |
DefaultRender Integer Source # | |
Defined in Control.Provenience renderDefault :: Integer -> Block Source # | |
DefaultRender String Source # | |
Defined in Control.Provenience renderDefault :: String -> Block Source # | |
DefaultRender Text Source # | |
Defined in Control.Provenience renderDefault :: Text -> Block Source # | |
DefaultRender Block Source # | |
Defined in Control.Provenience renderDefault :: Block -> Block Source # | |
DefaultRender (Ratio Integer) Source # | |
Defined in Control.Provenience |
data Proveniencei18n Source #
Internationalization of the keywords used in renderStore
.
Proveniencei18n | |
|
Instances
Show Proveniencei18n Source # | |
Defined in Control.Provenience showsPrec :: Int -> Proveniencei18n -> ShowS # show :: Proveniencei18n -> String # showList :: [Proveniencei18n] -> ShowS # | |
Default Proveniencei18n Source # | default is |
Defined in Control.Provenience def :: Proveniencei18n # |
enProveniencei18n :: Proveniencei18n Source #
English version
deProveniencei18n :: Proveniencei18n Source #
German version
renderStore :: Proveniencei18n -> VariableStore alt -> Block Source #
Render the store with Pandoc. For each Variable
the following data is written:
renderSheet :: forall row sheet. (ToSheet row sheet, ToRow StaticCellValue row) => Proveniencei18n -> VariableStore (Seq row) -> sheet Source #
When the alternative representation is in terms of spreadsheet rows,
we can assemble the VariableStore
into a spreadheet.
This is analogous to renderStore
but only places the data underneath
the shortname
, thus omitting any formatted descriptions.
graphAltReps :: VariableStore alt -> Gr alt Block Source #
Obtain a graph of all the Variable
s alternative representations
graphShortnames :: VariableStore alt -> Gr String Block Source #
Obtain a graph of all the Variable
s short names
The Provenience monad
type ProvenienceT alt m a = StateT (VariableStore alt) m (Variable a) Source #
A Monad
transformer that keeps track of data dependencies
type Provenience a = State (VariableStore ()) (Variable a) Source #
(<%>) :: Monad m => ProvenienceT alt m (a -> b) -> Variable a -> ProvenienceT alt m b infixl 4 Source #
Applicative
-style application operator.
Replaces the function Variable
with its (partial) application
and creates an edge from the argument to the result Variable
that is labeled with the function description.
f <-func
succ
(renderDefault
"successor") x <-input
(5 :: Int) y <-pure
f<%>
x x<?
renderDefault
"input data" y<?
renderDefault
"The successor of 5"render
y
The above creates the following graph.
"input data" "successor" "The successor of 5" 5 -----------> 6
If you want to re-use a function in several applications then
bind f
to the Provenience
action rather the Variable
like below.
let f =func
succ
(renderDefault
"successor") x <-input
(5 :: Int) y <- f<%>
x z <- f<%>
y
(<%%>) :: Monad m => ProvenienceT alt m (a -> m b) -> Variable a -> ProvenienceT alt m b infixl 4 Source #
Like above but permit side-effects in the base monad.
runProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node) Source #
Run the Provenience monad and return the value of the result variable
together with the VariableStore
and its next unused Node
.
Initialize the VariableStore
with an empty graph and start with
the given Node
identifier.
execProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m (VariableStore alt, Node) Source #
run the Provenience monad and return the data dependency graph
execProvenience :: Provenience a -> Node -> (VariableStore (), Node) Source #
run the Provenience monad and return the data dependency graph
evalProvenienceT :: Monad m => ProvenienceT alt m a -> m a Source #
run the Provenience monad and return the resulting value.
evalProvenience :: Provenience a -> a Source #
run the Provenience monad and return the resulting value.
sequenceProvenienceT :: (Traversable t, Monad m) => t (ProvenienceT alt m a) -> m (t (a, VariableStore alt)) Source #
Run multiple ProvenienceT
actions using the same pool of Node
s
but returning seperate VariableStore
s.
This is useful when several data flow graphs get
embedded into the same document, where hyperlink targets must be unique.