{-|
Module      : Control.Provenience
Description : A monad transformer for computations that automatically track data dependencies
Copyright   : (c) Olaf Klinke
License     : GPL-3
Maintainer  : olaf.klinke@phymetric.de
Stability   : experimental

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. 
-}

{-# LANGUAGE CPP,MultiParamTypeClasses,FlexibleInstances,FlexibleContexts,OverloadedStrings,Rank2Types,ScopedTypeVariables #-}
module Control.Provenience (
    -- * Variables

     Variable,value
    ,VariableStore
    ,var
    ,varM
    ,input
    ,inputM
    ,func
    -- ** Modifiers

    ,StoreUpdate
    ,(<?)
    ,named
    -- ** Rendering

    ,linkto
    ,render
    ,renderWith
    ,renderShow
    ,DefaultRender(..)
    ,Proveniencei18n(..)
    ,enProveniencei18n
    ,deProveniencei18n
    ,renderStore
    ,renderSheet
    ,graphAltReps
    ,graphShortnames
    -- * The Provenience monad

    ,ProvenienceT(..)
    ,Provenience
    ,(<%>)
    ,(<%?>)
    ,(<%%>)
    ,runProvenienceT
    ,execProvenienceT
    ,execProvenience
    ,evalProvenienceT
    ,evalProvenience
    ,sequenceProvenienceT
    ,traverseProvenienceT) where
import Control.Monad
import Control.Monad.State.Strict -- package mtl

import Control.Arrow
import Data.Functor.Identity
import Data.Graph.Inductive.Graph -- package fgl

import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Query.DFS (topsort)
import Data.Default --package data-default

import Data.Ratio
import Data.Monoid
import Data.Word (Word64)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Representation
import Data.Spreadsheet
import qualified Data.Set as Set --package containers

import Data.Text (Text,pack,unpack)
import Text.Pandoc -- package pandoc

import Numeric (showHex)

-- * Types


-- | The representation of a variable in the data dependency graph. 

-- Only a dependent or existential type could hold the actual values.

-- Hence the graph only stores renderings of the variables 

-- along with user-supplied descriptions. 

-- The type parameter defines an alternative value description, 

-- which could be a String, JSON or XML representation. 

data VariableDesc alt = VariableDesc {
    VariableDesc alt -> Maybe String
shortname :: Maybe String, -- ^ a symbol referring to the 'Variable'

    VariableDesc alt -> Block
description :: Block, -- ^ a description explaining the content

    VariableDesc alt -> Block
valueRendering :: Block, -- ^ a rendering of the 'Variable's 'value'

    VariableDesc alt -> alt
altRep :: alt -- ^ alternative representation

    }
-- | Variables are internally numbered by 'Node' = 'Int' 

-- and have an alternative value 'Representation' @alt@. 

-- Further each variable has a Pandoc 'description' (set by '<?') 

-- and optionally a 'shortname' set by 'named' which is a 'String' 

-- to be used in hyperlinks. 

data VariableStore alt = VariableStore {
    VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph :: Gr (VariableDesc alt) Block,
    VariableStore alt -> Node
nextFreeNode :: Node}

-- | Obtain a graph of all the 'Variable's alternative representations

graphAltReps :: VariableStore alt -> Gr alt Block
graphAltReps :: VariableStore alt -> Gr alt Block
graphAltReps = (VariableDesc alt -> alt)
-> Gr (VariableDesc alt) Block -> Gr alt Block
forall (gr :: * -> * -> *) a c b.
DynGraph gr =>
(a -> c) -> gr a b -> gr c b
nmap VariableDesc alt -> alt
forall alt. VariableDesc alt -> alt
altRep (Gr (VariableDesc alt) Block -> Gr alt Block)
-> (VariableStore alt -> Gr (VariableDesc alt) Block)
-> VariableStore alt
-> Gr alt Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph

-- | Obtain a graph of all the 'Variable's short names

graphShortnames :: VariableStore alt -> Gr String Block
graphShortnames :: VariableStore alt -> Gr String Block
graphShortnames = (VariableDesc alt -> String)
-> Gr (VariableDesc alt) Block -> Gr String Block
forall (gr :: * -> * -> *) a c b.
DynGraph gr =>
(a -> c) -> gr a b -> gr c b
nmap (String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id (Maybe String -> String)
-> (VariableDesc alt -> Maybe String) -> VariableDesc alt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableDesc alt -> Maybe String
forall alt. VariableDesc alt -> Maybe String
shortname) (Gr (VariableDesc alt) Block -> Gr String Block)
-> (VariableStore alt -> Gr (VariableDesc alt) Block)
-> VariableStore alt
-> Gr String Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph

getDescription :: Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription :: Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription Node
i VariableStore alt
store = case Node
-> Gr (VariableDesc alt) Block
-> Decomp Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
i (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
store) of
    (Maybe (Context (VariableDesc alt) Block)
Nothing,Gr (VariableDesc alt) Block
_) -> Maybe (VariableDesc alt)
forall a. Maybe a
Nothing
    (Just (Adj Block
_,Node
_,VariableDesc alt
desc,Adj Block
_),Gr (VariableDesc alt) Block
_) -> VariableDesc alt -> Maybe (VariableDesc alt)
forall a. a -> Maybe a
Just VariableDesc alt
desc
getShortname :: Node -> VariableStore alt -> Maybe String
getShortname :: Node -> VariableStore alt -> Maybe String
getShortname Node
i = Node -> VariableStore alt -> Maybe (VariableDesc alt)
forall alt. Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription Node
i (VariableStore alt -> Maybe (VariableDesc alt))
-> (VariableDesc alt -> Maybe String)
-> VariableStore alt
-> Maybe String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> VariableDesc alt -> Maybe String
forall alt. VariableDesc alt -> Maybe String
shortname

-- | Every 'Variable' has an 'identifier' in the data flow graph. 

data Variable a = Variable {
    Variable a -> Node
identifier :: Node,
    Variable a -> a
value :: a -- ^ dereference

    }
instance Functor Variable where
    fmap :: (a -> b) -> Variable a -> Variable b
fmap a -> b
f Variable a
x = Variable a
x {value :: b
value = a -> b
f (Variable a -> a
forall a. Variable a -> a
value Variable a
x)}
instance Show a => Show (Variable a) where
    show :: Variable a -> String
show Variable a
v = a -> String
forall a. Show a => a -> String
show (Variable a -> a
forall a. Variable a -> a
value Variable a
v)
linkname :: Variable a -> String
linkname :: Variable a -> String
linkname = Node -> String
linknode (Node -> String) -> (Variable a -> Node) -> Variable a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable a -> Node
forall a. Variable a -> Node
identifier
linknode :: Node -> String
linknode :: Node -> String
linknode Node
n = String
"provenienceVar" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Node -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Node
n String
""

-- | A 'Monad' transformer that keeps track of data dependencies

type ProvenienceT alt m a = StateT (VariableStore alt) m (Variable a)
-- TODO: This does not parallelize well. Use Parallel-Arrow-Multicore

-- to define an arrow isomorphic to 

-- (a -> b, a -> VariableStore alt -> VariableStore alt)

-- so that the pure computation can be parallelized.



-- | @'Provenience' = 'ProvenienceT' () 'Identity'@

type Provenience a = State (VariableStore ()) (Variable a)
-- | Action on the 'VariableStore'

type StoreUpdate = forall m alt. Monad m => StateT (VariableStore alt) m ()

-- * Rendering 


-- | Class of types with a default rendering method. 

-- For the basic types 'renderDefault' equals 'renderShow'. 

class DefaultRender a where
    renderDefault :: a -> Block
-- | 'render' 'String's as plain text. 

instance DefaultRender String where
    renderDefault :: String -> Block
renderDefault = [Inline] -> Block
Para ([Inline] -> Block) -> (String -> [Inline]) -> String -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Inline]
inlinesString 
instance DefaultRender Block where
    renderDefault :: Block -> Block
renderDefault = Block -> Block
forall a. a -> a
id
#if MIN_VERSION_pandoc(2,8,0)
-- pandoc.types >= 1.20 has Str Text so the instances for Text and String must be swapped

instance DefaultRender Text where
    renderDefault :: Text -> Block
renderDefault = [Inline] -> Block
Para ([Inline] -> Block) -> (Text -> [Inline]) -> Text -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (Text -> Inline) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str 
#else
instance DefaultRender Text where
    renderDefault = Para . pure . Str . unpack
#endif
instance DefaultRender Char where
    renderDefault :: Char -> Block
renderDefault = String -> Block
forall a. DefaultRender a => a -> Block
renderDefault (String -> Block) -> (Char -> String) -> Char -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure :: Char -> String)
instance DefaultRender Int where
    renderDefault :: Node -> Block
renderDefault = Node -> Block
forall a. Show a => a -> Block
renderShow
instance DefaultRender Integer where
    renderDefault :: Integer -> Block
renderDefault = Integer -> Block
forall a. Show a => a -> Block
renderShow
instance DefaultRender Double where
    renderDefault :: Double -> Block
renderDefault = Double -> Block
forall a. Show a => a -> Block
renderShow
#if MIN_VERSION_pandoc(2,8,0)
-- Math expects Text when pandoc-types >= 1.20

instance DefaultRender (Ratio Integer) where
    renderDefault :: Ratio Integer -> Block
renderDefault Ratio Integer
x = [Inline] -> Block
Plain [MathType -> Text -> Inline
Math MathType
InlineMath (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"\\frac{"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Integer -> String
forall a. Show a => a -> String
show (Ratio Integer -> Integer
forall a. Ratio a -> a
numerator Ratio Integer
x))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}{"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Integer -> String
forall a. Show a => a -> String
show (Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
x))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}")] 
#else
instance DefaultRender (Ratio Integer) where
    renderDefault x = Plain [Math InlineMath ("\\frac{"++(show (numerator x))++"}{"++(show (denominator x))++"}")] 
#endif

-- | Supply the 'valueRendering' and 'altRep' for the variable.  

renderWith :: (Representation a alt, Monad m) => (a -> Block) -> Variable a -> StateT (VariableStore alt) m ()
renderWith :: (a -> Block) -> Variable a -> StateT (VariableStore alt) m ()
renderWith a -> Block
method Variable a
v = (VariableStore alt -> VariableStore alt)
-> StateT (VariableStore alt) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\VariableStore alt
vs -> Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
forall alt.
Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
changeLabel (Variable a -> Node
forall a. Variable a -> Node
identifier Variable a
v) (\VariableDesc alt
desc -> VariableDesc alt
desc {valueRendering :: Block
valueRendering = a -> Block
method (Variable a -> a
forall a. Variable a -> a
value Variable a
v), altRep :: alt
altRep = a -> alt
forall a b. Representation a b => a -> b
representation (Variable a -> a
forall a. Variable a -> a
value Variable a
v)}) VariableStore alt
vs)

-- pandoc.types >= 1.20 has Str Text

#if MIN_VERSION_pandoc(2,8,0)
inlinesString :: String -> [Inline]
inlinesString :: String -> [Inline]
inlinesString = Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (String -> Inline) -> String -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
#else
inlinesString :: String -> [Inline]
inlinesString = pure . Str
#endif

-- pandoc.types >= 1.20 uses Text in Link

#if MIN_VERSION_pandoc(2,8,0)
localLink :: VariableStore alt -> Node -> (Text,Text)
localLink :: VariableStore alt -> Node -> (Text, Text)
localLink VariableStore alt
variables Node
i = let txt :: String
txt = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> String
forall a. Show a => a -> String
show Node
i) String -> String
forall a. a -> a
id (Node -> VariableStore alt -> Maybe String
forall alt. Node -> VariableStore alt -> Maybe String
getShortname Node
i VariableStore alt
variables)
    in (String -> Text
pack (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:Node -> String
linknode Node
i), String -> Text
pack String
txt)
#else
localLink :: VariableStore alt -> Node -> (String,String)
localLink variables i = let txt = maybe (show i) id (getShortname i variables)
    in ('#':linknode i,txt)
#endif

-- pandoc.types >= 1.20 uses Text in Attr 

#if MIN_VERSION_pandoc(2,8,0)
divVar :: Node -> [Block] -> Block
divVar :: Node -> [Block] -> Block
divVar Node
i = Attr -> [Block] -> Block
Div (String -> Text
pack (Node -> String
linknode Node
i),[String -> Text
pack String
"variable"],[])
divVars :: (Node,Node) -> [Block] -> Block
divVars :: (Node, Node) -> [Block] -> Block
divVars (Node
n0,Node
n1) = Attr -> [Block] -> Block
Div (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"variables"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Node -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Node
n0 (String
"To"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Node -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Node
n1 String
""))),[Text
"provenienceVariables"],[])
#else
divVar :: Node -> [Block] -> Block
divVar i = Div (linknode i,["variable"],[])
divVars :: (Node,Node) -> [Block] -> Block
divVars (n0,n1) = Div ("variables"++(showHex n0 ("To"++(showHex n1 ""))),["provenienceVariables"],[])
#endif

-- | Use the 'show' method to render a 'value' as 'Plain' text. 

renderShow :: Show a => a -> Block
renderShow :: a -> Block
renderShow = [Inline] -> Block
Plain ([Inline] -> Block) -> (a -> [Inline]) -> a -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Inline]
inlinesString (String -> [Inline]) -> (a -> String) -> a -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | @'render' = 'renderWith' 'renderDefault'@. 

-- You can use this function without providing a 'DefaultRender' instance 

-- by using a conversion function to a type that is member of 'DefaultRender':

-- 

-- @

-- \\f -> 'render' . 'fmap' f

-- @

render :: (Representation a alt, Monad m, DefaultRender a) => Variable a -> StateT (VariableStore alt) m ()
render :: Variable a -> StateT (VariableStore alt) m ()
render = (a -> Block) -> Variable a -> StateT (VariableStore alt) m ()
forall a alt (m :: * -> *).
(Representation a alt, Monad m) =>
(a -> Block) -> Variable a -> StateT (VariableStore alt) m ()
renderWith a -> Block
forall a. DefaultRender a => a -> Block
renderDefault

-- | Internationalization of the keywords used in 'renderStore'. 

data Proveniencei18n = Proveniencei18n {
    Proveniencei18n -> Inline
i18n_construction :: Inline, -- ^ keyword for the edge labels

    Proveniencei18n -> Inline
i18n_incoming :: Inline, -- ^ keyword for the nodes upstream

    Proveniencei18n -> Inline
i18n_outgoing :: Inline -- ^ keyword for the nodes downstream

} deriving (Node -> Proveniencei18n -> String -> String
[Proveniencei18n] -> String -> String
Proveniencei18n -> String
(Node -> Proveniencei18n -> String -> String)
-> (Proveniencei18n -> String)
-> ([Proveniencei18n] -> String -> String)
-> Show Proveniencei18n
forall a.
(Node -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Proveniencei18n] -> String -> String
$cshowList :: [Proveniencei18n] -> String -> String
show :: Proveniencei18n -> String
$cshow :: Proveniencei18n -> String
showsPrec :: Node -> Proveniencei18n -> String -> String
$cshowsPrec :: Node -> Proveniencei18n -> String -> String
Show)

-- | English version

enProveniencei18n :: Proveniencei18n
enProveniencei18n :: Proveniencei18n
enProveniencei18n= Proveniencei18n :: Inline -> Inline -> Inline -> Proveniencei18n
Proveniencei18n {
    i18n_construction :: Inline
i18n_construction = Text -> Inline
Str Text
"Construction:",
    i18n_incoming :: Inline
i18n_incoming = Text -> Inline
Str Text
"Sources:",
    i18n_outgoing :: Inline
i18n_outgoing = Text -> Inline
Str Text
"Used in:"
}

-- | German version

deProveniencei18n :: Proveniencei18n
deProveniencei18n :: Proveniencei18n
deProveniencei18n = Proveniencei18n :: Inline -> Inline -> Inline -> Proveniencei18n
Proveniencei18n {
    i18n_construction :: Inline
i18n_construction = Text -> Inline
Str Text
"Erzeugung:",
    i18n_incoming :: Inline
i18n_incoming = Text -> Inline
Str Text
"Quellen:",
    i18n_outgoing :: Inline
i18n_outgoing = Text -> Inline
Str Text
"Verwendet in:"
}

-- | default is 'enProveniencei18n'

instance Default Proveniencei18n where
    def :: Proveniencei18n
def = Proveniencei18n
enProveniencei18n

-- | Render the store with Pandoc. For each 'Variable' the following data is written: 

-- 

-- (1) The variable name given with 'named',

-- 2. The variables linking to this one (if any),

-- 3. The edge labels linking to this variable,

-- 4. The variables depending on this one (if any),

-- 5. The description provided with '<?',

-- 6. A rendering of the value as provided by one of the 'render' family functions.

renderStore :: Proveniencei18n -> VariableStore alt -> Block
renderStore :: Proveniencei18n -> VariableStore alt -> Block
renderStore Proveniencei18n
i18n VariableStore alt
variables = let
    nodelist :: [Node]
nodelist = Gr (VariableDesc alt) Block -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables) :: [Node]
    renderIncoming :: Node -> Inline
renderIncoming Node
i = let l :: (Text, Text)
l@(Text
_,Text
txt) = VariableStore alt -> Node -> (Text, Text)
forall alt. VariableStore alt -> Node -> (Text, Text)
localLink VariableStore alt
variables Node
i
        in Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
"",[Text
"incoming"],[]) [Text -> Inline
Str Text
txt] (Text, Text)
l
    renderOutgoing :: Node -> Inline
renderOutgoing Node
i = let l :: (Text, Text)
l@(Text
_,Text
txt) = VariableStore alt -> Node -> (Text, Text)
forall alt. VariableStore alt -> Node -> (Text, Text)
localLink VariableStore alt
variables Node
i
        in Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
"",[Text
"outgoing"],[]) [Text -> Inline
Str Text
txt] (Text, Text)
l
    renderVariable :: Node -> Block
renderVariable Node
i = let 
        Just VariableDesc alt
desc = Node -> VariableStore alt -> Maybe (VariableDesc alt)
forall alt. Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription Node
i VariableStore alt
variables
        how :: Set Block
how = ((Node, Node, Block) -> Set Block)
-> [(Node, Node, Block)] -> Set Block
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Node
_,Node
_,Block
f) -> Block -> Set Block
forall a. a -> Set a
Set.singleton Block
f) (Gr (VariableDesc alt) Block -> Node -> [(Node, Node, Block)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [LEdge b]
inn (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables) Node
i)
        sayhow :: [Block]
sayhow = if Set Block -> Bool
forall a. Set a -> Bool
Set.null Set Block
how then [] else [Attr -> [Block] -> Block
Div (Text
"",[Text
"edges"],[]) ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ (Attr -> [Block] -> Block
Div (Text
"",[Text
"provenienceKeyword"],[]) [[Inline] -> Block
Para [Proveniencei18n -> Inline
i18n_construction Proveniencei18n
i18n]])Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:(Set Block -> [Block]
forall a. Set a -> [a]
Set.toList Set Block
how)]
        short :: [Block]
short = case VariableDesc alt -> Maybe String
forall alt. VariableDesc alt -> Maybe String
shortname VariableDesc alt
desc of
            Maybe String
Nothing -> []
            Just String
name -> [Node -> Attr -> [Inline] -> Block
Header Node
3 (Text
"",[Text
"shortname"],[]) (String -> [Inline]
inlinesString String
name)]
        sources :: [Block]
sources = case Gr (VariableDesc alt) Block -> Node -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [Node]
pre (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables) Node
i of
            [] -> []
            js :: [Node]
js@(Node
_:[Node]
_) -> [Attr -> [Block] -> Block
Div (Text
"",[Text
"provenienceKeyword"],[]) [[Inline] -> Block
Para [Proveniencei18n -> Inline
i18n_incoming Proveniencei18n
i18n]],[[Block]] -> Block
BulletList ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ (Node -> [Block]) -> [Node] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map (Block -> [Block]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> (Node -> Block) -> Node -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Node -> [Inline]) -> Node -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (Node -> Inline) -> Node -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Inline
renderIncoming) [Node]
js]
        sinks :: [Block]
sinks = case Gr (VariableDesc alt) Block -> Node -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [Node]
suc (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables) Node
i of
            [] -> []
            js :: [Node]
js@(Node
_:[Node]
_) -> [Attr -> [Block] -> Block
Div (Text
"",[Text
"provenienceKeyword"],[]) [[Inline] -> Block
Para [Proveniencei18n -> Inline
i18n_outgoing Proveniencei18n
i18n]],[[Block]] -> Block
BulletList ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ (Node -> [Block]) -> [Node] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map (Block -> [Block]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> (Node -> Block) -> Node -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Node -> [Inline]) -> Node -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (Node -> Inline) -> Node -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Inline
renderOutgoing) [Node]
js]
        in Node -> [Block] -> Block
divVar Node
i ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ [Block]
short[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++[Block]
sources[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++[Block]
sayhow[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++[Block]
sinks[Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++[
            Block
HorizontalRule,
            Attr -> [Block] -> Block
Div (Text
"",[Text
"description"],[]) [VariableDesc alt -> Block
forall alt. VariableDesc alt -> Block
description VariableDesc alt
desc],
            Attr -> [Block] -> Block
Div (Text
"",[Text
"valueRendering"],[]) [VariableDesc alt -> Block
forall alt. VariableDesc alt -> Block
valueRendering VariableDesc alt
desc]]
    (Node
n0,Node
n1) = Gr (VariableDesc alt) Block -> (Node, Node)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Node, Node)
nodeRange (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables) 
    in (Node, Node) -> [Block] -> Block
divVars (Gr (VariableDesc alt) Block -> (Node, Node)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Node, Node)
nodeRange (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
variables)) ((Node -> Block) -> [Node] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Block
renderVariable [Node]
nodelist)

-- | 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. 

renderSheet :: forall row sheet. (ToSheet row sheet, ToRow StaticCellValue row) => 
    Proveniencei18n -> VariableStore (Seq row) -> sheet
renderSheet :: Proveniencei18n -> VariableStore (Seq row) -> sheet
renderSheet Proveniencei18n
i18n VariableStore (Seq row)
variables = let
    nodelist :: [Node]
nodelist = Gr (VariableDesc (Seq row)) Block -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort (VariableStore (Seq row) -> Gr (VariableDesc (Seq row)) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore (Seq row)
variables) :: [Node]
    emptyRow :: row
emptyRow = [StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList ([] :: [StaticCellValue])
    renderVariable :: Node -> Seq row
    renderVariable :: Node -> Seq row
renderVariable Node
i = let
        Just VariableDesc (Seq row)
desc = Node -> VariableStore (Seq row) -> Maybe (VariableDesc (Seq row))
forall alt. Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription Node
i VariableStore (Seq row)
variables
        short :: Seq row
short = case VariableDesc (Seq row) -> Maybe String
forall alt. VariableDesc alt -> Maybe String
shortname VariableDesc (Seq row)
desc of 
                Maybe String
Nothing -> Seq row
forall a. Seq a
Seq.empty
                Just String
name -> row -> Seq row
forall a. a -> Seq a
Seq.singleton ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [String -> StaticCellValue
CellText String
name])
        in Seq row
short Seq row -> Seq row -> Seq row
forall a. Semigroup a => a -> a -> a
<> VariableDesc (Seq row) -> Seq row
forall alt. VariableDesc alt -> alt
altRep VariableDesc (Seq row)
desc Seq row -> Seq row -> Seq row
forall a. Semigroup a => a -> a -> a
<> row -> Seq row
forall a. a -> Seq a
Seq.singleton row
emptyRow
    in [Seq row] -> sheet
forall (f :: * -> *) (chunk :: * -> *) row sheet.
(Traversable f, Traversable chunk, Monoid (chunk (Word64, row)),
 ToSheet row sheet) =>
f (chunk row) -> sheet
chunksToSheet ((Node -> Seq row) -> [Node] -> [Seq row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> Seq row
renderVariable [Node]
nodelist)

-- * Graph helper functions

changeLabel :: Node -> (VariableDesc alt -> VariableDesc alt) -> VariableStore alt -> VariableStore alt
changeLabel :: Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
changeLabel Node
n VariableDesc alt -> VariableDesc alt
f VariableStore alt
vs = VariableStore alt
vs {dependencyGraph :: Gr (VariableDesc alt) Block
dependencyGraph = Node
-> (VariableDesc alt -> VariableDesc alt)
-> Gr (VariableDesc alt) Block
-> Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Node -> (a -> a) -> gr a b -> gr a b
chl Node
n VariableDesc alt -> VariableDesc alt
f (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
vs)} where
    chl :: Node -> (a -> a) -> gr a b -> gr a b
chl Node
i a -> a
f gr a b
gr = let (MContext a b
mcntxt,gr a b
gr') = Node -> gr a b -> (MContext a b, gr a b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
i gr a b
gr in case MContext a b
mcntxt of
        MContext a b
Nothing -> gr a b
gr
        Just (Adj b
incoming,Node
_,a
l,Adj b
outgoing) -> (Adj b
incoming,Node
i,a -> a
f a
l,Adj b
outgoing) (Adj b, Node, a, Adj b) -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
gr'


-- | Register a new variable with content 

-- from a monadic action in the 'VariableStore'. 

-- This variable has neither 'description', 'shortname' nor 'valueRendering'.  

varM :: Monad m => m a -> ProvenienceT alt m a
varM :: m a -> ProvenienceT alt m a
varM m a
a = (VariableStore alt -> m (Variable a, VariableStore alt))
-> ProvenienceT alt m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((VariableStore alt -> m (Variable a, VariableStore alt))
 -> ProvenienceT alt m a)
-> (VariableStore alt -> m (Variable a, VariableStore alt))
-> ProvenienceT alt m a
forall a b. (a -> b) -> a -> b
$ \VariableStore alt
vs -> do
    let i :: Node
i = VariableStore alt -> Node
forall alt. VariableStore alt -> Node
nextFreeNode VariableStore alt
vs
    Variable a
v <- (a -> Variable a) -> m a -> m (Variable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node -> a -> Variable a
forall a. Node -> a -> Variable a
Variable Node
i) m a
a
    let desc :: VariableDesc alt
desc = VariableDesc :: forall alt.
Maybe String -> Block -> Block -> alt -> VariableDesc alt
VariableDesc {
            shortname :: Maybe String
shortname = Maybe String
forall a. Maybe a
Nothing,
            description :: Block
description = Block
Null,
            valueRendering :: Block
valueRendering = Block
Null,
            altRep :: alt
altRep = String -> alt
forall a. HasCallStack => String -> a
error String
"no alternative representation supplied"
            }
    (Variable a, VariableStore alt)
-> m (Variable a, VariableStore alt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Variable a
v,VariableStore alt
vs {dependencyGraph :: Gr (VariableDesc alt) Block
dependencyGraph = LNode (VariableDesc alt)
-> Gr (VariableDesc alt) Block -> Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Node
i,VariableDesc alt
forall alt. VariableDesc alt
desc) (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
vs), nextFreeNode :: Node
nextFreeNode = Node -> Node
forall a. Enum a => a -> a
succ Node
i})

-- | Register a new variable in the 'VariableStore'. 

-- This variable has neither 'description', 'shortname' nor 'valueRendering'. 

-- 

-- @

-- 'var' = 'varM' . 'pure' 

-- @

var :: Monad m => a -> ProvenienceT alt m a
var :: a -> ProvenienceT alt m a
var = m a -> ProvenienceT alt m a
forall (m :: * -> *) a alt. Monad m => m a -> ProvenienceT alt m a
varM (m a -> ProvenienceT alt m a)
-> (a -> m a) -> a -> ProvenienceT alt m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Register a static input variable 

-- with content from a monad action 

-- which is immediately 'render'ed.

inputM :: (Monad m, Representation a alt, DefaultRender a) => m a -> ProvenienceT alt m a
inputM :: m a -> ProvenienceT alt m a
inputM m a
a = do
    Variable a
x <- m a -> ProvenienceT alt m a
forall (m :: * -> *) a alt. Monad m => m a -> ProvenienceT alt m a
varM m a
a
    Variable a -> StateT (VariableStore alt) m ()
forall a alt (m :: * -> *).
(Representation a alt, Monad m, DefaultRender a) =>
Variable a -> StateT (VariableStore alt) m ()
render Variable a
x
    Variable a -> ProvenienceT alt m a
forall (m :: * -> *) a. Monad m => a -> m a
return Variable a
x

-- | Register a static input variable which is immediately 'render'ed. 

input :: (Monad m, Representation a alt, DefaultRender a) => a -> ProvenienceT alt m a
input :: a -> ProvenienceT alt m a
input a
a = do
    Variable a
x <- a -> ProvenienceT alt m a
forall (m :: * -> *) a alt. Monad m => a -> ProvenienceT alt m a
var a
a
    Variable a -> StateT (VariableStore alt) m ()
forall a alt (m :: * -> *).
(Representation a alt, Monad m, DefaultRender a) =>
Variable a -> StateT (VariableStore alt) m ()
render Variable a
x
    Variable a -> ProvenienceT alt m a
forall (m :: * -> *) a. Monad m => a -> m a
return Variable a
x

-- | Combination of 'var' and '<?' that can be used for immediate function application, e.g.

-- 

-- @

-- x  \<- 'input' 1

-- y  \<- 'input' 2

-- xy \<- 'func' (*) ('renderDefault' "*") '<%>' x '<%>' y

-- @

func :: (Monad m, Default alt) => a -> Block -> ProvenienceT alt m a
func :: a -> Block -> ProvenienceT alt m a
func a
f Block
what = do
    Variable a
v <- a -> ProvenienceT alt m a
forall (m :: * -> *) a alt. Monad m => a -> ProvenienceT alt m a
var a
f
    Variable a
v Variable a -> Block -> StoreUpdate
forall a. Variable a -> Block -> StoreUpdate
<? Block
what
    Variable a -> ProvenienceT alt m a
forall (m :: * -> *) a. Monad m => a -> m a
return Variable a
v 

infixl 3 <? 
-- | The /what is this?/-operator. Changes the 'description' of the computation's result. 

-- 

-- >>> v <- var 99 

-- >>> v <? renderDefault "bottles of beer on the wall"

(<?) :: Variable a -> Block -> StoreUpdate
Variable a
v <? :: Variable a -> Block -> StoreUpdate
<? Block
about = (VariableStore alt -> VariableStore alt)
-> StateT (VariableStore alt) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\VariableStore alt
vs -> Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
forall alt.
Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
changeLabel (Variable a -> Node
forall a. Variable a -> Node
identifier Variable a
v) (\VariableDesc alt
desc -> VariableDesc alt
desc {description :: Block
description=Block
about}) VariableStore alt
vs)

-- | Provides a 'shortname' symbol for the 'Variable', for use in hyperlinks and other references.  

--

-- >>> v <- var 99

-- >>> v `named` "beer"

named :: Variable a -> String -> StoreUpdate
Variable a
v named :: Variable a -> String -> StoreUpdate
`named` String
name = (VariableStore alt -> VariableStore alt)
-> StateT (VariableStore alt) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\VariableStore alt
vs -> Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
forall alt.
Node
-> (VariableDesc alt -> VariableDesc alt)
-> VariableStore alt
-> VariableStore alt
changeLabel (Variable a -> Node
forall a. Variable a -> Node
identifier Variable a
v) (\VariableDesc alt
desc -> VariableDesc alt
desc {shortname :: Maybe String
shortname = String -> Maybe String
forall a. a -> Maybe a
Just String
name}) VariableStore alt
vs)

infixl 4 <%>, <%?>, <%%>
-- | '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 -> b) -> Variable a -> ProvenienceT alt m b
ProvenienceT alt m (a -> b)
pf <%> :: ProvenienceT alt m (a -> b) -> Variable a -> ProvenienceT alt m b
<%> Variable a
x = (((Variable (a -> b) -> Variable (a -> m b))
-> ProvenienceT alt m (a -> b)
-> StateT (VariableStore alt) m (Variable (a -> m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Variable (a -> b) -> Variable (a -> m b))
 -> ProvenienceT alt m (a -> b)
 -> StateT (VariableStore alt) m (Variable (a -> m b)))
-> (((a -> b) -> a -> m b)
    -> Variable (a -> b) -> Variable (a -> m b))
-> ((a -> b) -> a -> m b)
-> ProvenienceT alt m (a -> b)
-> StateT (VariableStore alt) m (Variable (a -> m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((a -> b) -> a -> m b) -> Variable (a -> b) -> Variable (a -> m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure(b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ProvenienceT alt m (a -> b)
pf) StateT (VariableStore alt) m (Variable (a -> m b))
-> Variable a -> ProvenienceT alt m b
forall (m :: * -> *) alt a b.
Monad m =>
ProvenienceT alt m (a -> m b) -> Variable a -> ProvenienceT alt m b
<%%> Variable a
x

-- | Conditional use of a 'Variable'. 

-- The @'Left' a@ could be a default parameter to the function 

-- which is not worth registering a 'Variable' for. 

(<%?>) :: Monad m => ProvenienceT alt m (a -> b) -> Either a (Variable a) -> ProvenienceT alt m b
ProvenienceT alt m (a -> b)
pf <%?> :: ProvenienceT alt m (a -> b)
-> Either a (Variable a) -> ProvenienceT alt m b
<%?> (Right Variable a
px) = ProvenienceT alt m (a -> b)
pf ProvenienceT alt m (a -> b) -> Variable a -> ProvenienceT alt m b
forall (m :: * -> *) alt a b.
Monad m =>
ProvenienceT alt m (a -> b) -> Variable a -> ProvenienceT alt m b
<%> Variable a
px
ProvenienceT alt m (a -> b)
pf <%?> (Left   a
x) = ((Variable (a -> b) -> Variable b)
-> ProvenienceT alt m (a -> b) -> ProvenienceT alt m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Variable (a -> b) -> Variable b)
 -> ProvenienceT alt m (a -> b) -> ProvenienceT alt m b)
-> (((a -> b) -> b) -> Variable (a -> b) -> Variable b)
-> ((a -> b) -> b)
-> ProvenienceT alt m (a -> b)
-> ProvenienceT alt m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((a -> b) -> b) -> Variable (a -> b) -> Variable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$a
x) ProvenienceT alt m (a -> b)
pf

-- | Like above but permit side-effects in the base monad. 

(<%%>) :: Monad m => ProvenienceT alt m (a -> m b) -> Variable a -> ProvenienceT alt m b
ProvenienceT alt m (a -> m b)
pf <%%> :: ProvenienceT alt m (a -> m b) -> Variable a -> ProvenienceT alt m b
<%%> Variable a
x = do
    Variable (a -> m b)
f <- ProvenienceT alt m (a -> m b)
pf
    (VariableStore alt -> m (Variable b, VariableStore alt))
-> ProvenienceT alt m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((VariableStore alt -> m (Variable b, VariableStore alt))
 -> ProvenienceT alt m b)
-> (VariableStore alt -> m (Variable b, VariableStore alt))
-> ProvenienceT alt m b
forall a b. (a -> b) -> a -> b
$ \VariableStore alt
store -> case Node -> VariableStore alt -> Maybe (VariableDesc alt)
forall alt. Node -> VariableStore alt -> Maybe (VariableDesc alt)
getDescription (Variable (a -> m b) -> Node
forall a. Variable a -> Node
identifier Variable (a -> m b)
f) VariableStore alt
store of
        Maybe (VariableDesc alt)
Nothing -> String -> m (Variable b, VariableStore alt)
forall a. HasCallStack => String -> a
error (String
"Node "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Node -> String
forall a. Show a => a -> String
show (Variable (a -> m b) -> Node
forall a. Variable a -> Node
identifier Variable (a -> m b)
f))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" not element of the store.")
        Just VariableDesc alt
desc -> let
            modification :: VariableStore alt -> VariableStore alt
modification = \VariableStore alt
vs -> VariableStore alt
vs {dependencyGraph :: Gr (VariableDesc alt) Block
dependencyGraph = (Node, Node, Block)
-> Gr (VariableDesc alt) Block -> Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Variable a -> Node
forall a. Variable a -> Node
identifier Variable a
x, Variable (a -> m b) -> Node
forall a. Variable a -> Node
identifier Variable (a -> m b)
f, VariableDesc alt -> Block
forall alt. VariableDesc alt -> Block
description VariableDesc alt
desc) (VariableStore alt -> Gr (VariableDesc alt) Block
forall alt. VariableStore alt -> Gr (VariableDesc alt) Block
dependencyGraph VariableStore alt
vs)}
            in do
                b
y <- (Variable (a -> m b) -> a -> m b
forall a. Variable a -> a
value Variable (a -> m b)
f) (Variable a -> a
forall a. Variable a -> a
value Variable a
x)
                (Variable b, VariableStore alt)
-> m (Variable b, VariableStore alt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Variable (a -> m b)
f {value :: b
value = b
y},VariableStore alt -> VariableStore alt
forall alt. VariableStore alt -> VariableStore alt
modification VariableStore alt
store)

-- | Render a hyperlink to a 'Variable', 

-- to be used e.g. in descriptions of downstream variables. 

-- Make sure to provide a short name via 'named' before calling 'linkto'.  

linkto :: Monad m => Variable a -> StateT (VariableStore alt) m Inline
linkto :: Variable a -> StateT (VariableStore alt) m Inline
linkto Variable a
v = do
    VariableStore alt
store <- StateT (VariableStore alt) m (VariableStore alt)
forall s (m :: * -> *). MonadState s m => m s
get
    let l :: (Text, Text)
l@(Text
_,Text
linktext) = VariableStore alt -> Node -> (Text, Text)
forall alt. VariableStore alt -> Node -> (Text, Text)
localLink VariableStore alt
store (Variable a -> Node
forall a. Variable a -> Node
identifier Variable a
v)
    Inline -> StateT (VariableStore alt) m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT (VariableStore alt) m Inline)
-> Inline -> StateT (VariableStore alt) m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
nullAttr [Text -> Inline
Str Text
linktext] (Text, Text)
l

-- | 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. 

runProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m ((a,VariableStore alt),Node)
runProvenienceT :: ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
runProvenienceT ProvenienceT alt m a
p Node
n = ((Variable a, VariableStore alt) -> ((a, VariableStore alt), Node))
-> m (Variable a, VariableStore alt)
-> m ((a, VariableStore alt), Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Variable a -> a)
-> (Variable a, VariableStore alt) -> (a, VariableStore alt)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Variable a -> a
forall a. Variable a -> a
value) ((Variable a, VariableStore alt) -> (a, VariableStore alt))
-> ((Variable a, VariableStore alt) -> Node)
-> (Variable a, VariableStore alt)
-> ((a, VariableStore alt), Node)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (VariableStore alt -> Node
forall alt. VariableStore alt -> Node
nextFreeNode(VariableStore alt -> Node)
-> ((Variable a, VariableStore alt) -> VariableStore alt)
-> (Variable a, VariableStore alt)
-> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Variable a, VariableStore alt) -> VariableStore alt
forall a b. (a, b) -> b
snd)) (ProvenienceT alt m a
-> VariableStore alt -> m (Variable a, VariableStore alt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ProvenienceT alt m a
p VariableStore alt
forall alt. VariableStore alt
st) where
    st :: VariableStore alt
st = VariableStore :: forall alt.
Gr (VariableDesc alt) Block -> Node -> VariableStore alt
VariableStore {
        dependencyGraph :: Gr (VariableDesc alt) Block
dependencyGraph = Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty,
        nextFreeNode :: Node
nextFreeNode = Node
n}

-- | Run the 'ProvenienceT' actions using a fresh pool of 'Node's, 

-- collecting the results in a single 'VariableStore'. 

traverseProvenienceT :: (Traversable t, Monad m) => (a -> ProvenienceT alt m b) -> 
    t a -> m (t b,VariableStore alt)
traverseProvenienceT :: (a -> ProvenienceT alt m b) -> t a -> m (t b, VariableStore alt)
traverseProvenienceT a -> ProvenienceT alt m b
f = (StateT (VariableStore alt) m (t b)
 -> VariableStore alt -> m (t b, VariableStore alt))
-> VariableStore alt
-> StateT (VariableStore alt) m (t b)
-> m (t b, VariableStore alt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (VariableStore alt) m (t b)
-> VariableStore alt -> m (t b, VariableStore alt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT VariableStore alt
forall alt. VariableStore alt
st0 (StateT (VariableStore alt) m (t b) -> m (t b, VariableStore alt))
-> (t a -> StateT (VariableStore alt) m (t b))
-> t a
-> m (t b, VariableStore alt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StateT (VariableStore alt) m b)
-> t a -> StateT (VariableStore alt) m (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Variable b -> b)
-> ProvenienceT alt m b -> StateT (VariableStore alt) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Variable b -> b
forall a. Variable a -> a
value (ProvenienceT alt m b -> StateT (VariableStore alt) m b)
-> (a -> ProvenienceT alt m b)
-> a
-> StateT (VariableStore alt) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ProvenienceT alt m b
f) where
    st0 :: VariableStore alt
st0 = VariableStore :: forall alt.
Gr (VariableDesc alt) Block -> Node -> VariableStore alt
VariableStore {
        dependencyGraph :: Gr (VariableDesc alt) Block
dependencyGraph = Gr (VariableDesc alt) Block
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty,
        nextFreeNode :: Node
nextFreeNode = Node
0}

-- | 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. 

sequenceProvenienceT :: (Traversable t, Monad m) => t (ProvenienceT alt m a) -> m (t (a,VariableStore alt))
sequenceProvenienceT :: t (ProvenienceT alt m a) -> m (t (a, VariableStore alt))
sequenceProvenienceT t (ProvenienceT alt m a)
ps = StateT Node m (t (a, VariableStore alt))
-> Node -> m (t (a, VariableStore alt))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((ProvenienceT alt m a -> StateT Node m (a, VariableStore alt))
-> t (ProvenienceT alt m a)
-> StateT Node m (t (a, VariableStore alt))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Node -> m ((a, VariableStore alt), Node))
-> StateT Node m (a, VariableStore alt)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Node -> m ((a, VariableStore alt), Node))
 -> StateT Node m (a, VariableStore alt))
-> (ProvenienceT alt m a
    -> Node -> m ((a, VariableStore alt), Node))
-> ProvenienceT alt m a
-> StateT Node m (a, VariableStore alt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
forall (m :: * -> *) alt a.
Monad m =>
ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
runProvenienceT) t (ProvenienceT alt m a)
ps) Node
0 where

-- | run the Provenience monad and return the data dependency graph

execProvenienceT :: Monad m => ProvenienceT alt m a -> Node -> m (VariableStore alt,Node)
execProvenienceT :: ProvenienceT alt m a -> Node -> m (VariableStore alt, Node)
execProvenienceT ProvenienceT alt m a
computation Node
n = (((a, VariableStore alt), Node) -> (VariableStore alt, Node))
-> m ((a, VariableStore alt), Node) -> m (VariableStore alt, Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, VariableStore alt) -> VariableStore alt
forall a b. (a, b) -> b
snd ((a, VariableStore alt) -> VariableStore alt)
-> (Node -> Node)
-> ((a, VariableStore alt), Node)
-> (VariableStore alt, Node)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Node -> Node
forall a. a -> a
id) (ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
forall (m :: * -> *) alt a.
Monad m =>
ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
runProvenienceT ProvenienceT alt m a
computation Node
n)
-- | run the Provenience monad and return the data dependency graph

execProvenience :: Provenience a -> Node -> (VariableStore (),Node)
execProvenience :: Provenience a -> Node -> (VariableStore (), Node)
execProvenience Provenience a
computation Node
n = Identity (VariableStore (), Node) -> (VariableStore (), Node)
forall a. Identity a -> a
runIdentity (Provenience a -> Node -> Identity (VariableStore (), Node)
forall (m :: * -> *) alt a.
Monad m =>
ProvenienceT alt m a -> Node -> m (VariableStore alt, Node)
execProvenienceT Provenience a
computation Node
n)

-- | run the Provenience monad and return the resulting value.

evalProvenienceT :: Monad m => ProvenienceT alt m a -> m a
evalProvenienceT :: ProvenienceT alt m a -> m a
evalProvenienceT ProvenienceT alt m a
computation = (((a, VariableStore alt), Node) -> a)
-> m ((a, VariableStore alt), Node) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, VariableStore alt) -> a
forall a b. (a, b) -> a
fst((a, VariableStore alt) -> a)
-> (((a, VariableStore alt), Node) -> (a, VariableStore alt))
-> ((a, VariableStore alt), Node)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((a, VariableStore alt), Node) -> (a, VariableStore alt)
forall a b. (a, b) -> a
fst) (ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
forall (m :: * -> *) alt a.
Monad m =>
ProvenienceT alt m a -> Node -> m ((a, VariableStore alt), Node)
runProvenienceT ProvenienceT alt m a
computation Node
0)
-- | run the Provenience monad and return the resulting value.

evalProvenience :: Provenience a -> a
evalProvenience :: Provenience a -> a
evalProvenience Provenience a
computation = Identity a -> a
forall a. Identity a -> a
runIdentity (Provenience a -> Identity a
forall (m :: * -> *) alt a. Monad m => ProvenienceT alt m a -> m a
evalProvenienceT Provenience a
computation)


{-- style für HTML-Ausgabe:
<style type="text/css">
div.variable{
  margin-left: 40px;
  border: 2px solid;
  padding: 10px 40px;
  width: 300px;
  border-radius: 25px;
}
div.shortname{font-weight:bold; color:OliveDrab;}
a.incoming {color:Tomato;}
a.outgoing {color:DodgerBlue;}
div.valueRendering {background-color:#ebebe0;}
div.provenienceKeyword {font-weight:bold;}
</style>
--}