provenience 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+212/−3 lines, 4 filesdep +proveniencenew-component:exe:provenienceExamplePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: provenience

API changes (from Hackage documentation)

- Control.Provenience: Variable :: Node -> a -> Variable a

- Control.Provenience: [identifier] :: Variable a -> Node

- Control.Provenience: [value] :: Variable a -> a

+ Control.Provenience: value :: Variable a -> a

Files

README.md +1/−1
example/euclidean.hs +193/−0
provenience.cabal +17/−1
src/Control/Provenience.hs +1/−1

README.md view

@@ -102,7 +102,7 @@ of each variable in addition to the Pandoc rendering,  since you might want to provide a machine-readable data flow graph  in addition to a Pandoc document. -Similarly to the <code>IHaskellDisplay</code> class, +Similarly to the `IHaskellDisplay` class,  each type used in a variable must have a type class instance  that allows automatic conversion into the alternative representation.  If you don't need this feature, simply choose () as the alternative

+ example/euclidean.hs view

@@ -0,0 +1,193 @@+{-# LANGUAGE Rank2Types, CPP #-}+{-- The ProvenienceT monad transformer in action +    in form of the Euclidean Algorithm --}+import Control.Provenience+import Control.Monad.Trans (lift)+import Control.Monad.State.Strict+import System.IO (readLn)+import Text.Pandoc+import qualified Data.Text.IO as T+import Data.Text (pack)+import Data.Default++main = do +    (store,_) <- execProvenienceT workflow 0+    putStr "Enter the filename for the html document\n> "+    writeDocumentation store =<< getLine++-- finds the greatest common divisor of two numbers+workflow :: ProvenienceT () IO Integer+workflow = do+    lift (putStr "Enter the first integer\n> ")+    x <- inputM readLn+    lift (putStr "Enter the second integer\n> ")+    y <- inputM readLn+    x `named` "x0" >> y `named` "y0"+    x <? varSym 'x' 0+    y <? varSym 'y' 0+    hoist (euclideanAlgorithm x y)++-- | The actual Euclidean algorithm.+-- The 'State' 'Int' counts the number of steps+euclideanAlgorithm :: Variable Integer -> Variable Integer -> +    ProvenienceT () (State Int) Integer+euclideanAlgorithm x y = if value x == value y+    then do+        why <- desc_result x y+        -- make result depend on x and y+        result <- func (const (const (value x))) why <%> x <%> y+        result `named` "result"+        render result+        return result+    else do+        i <- lift get -- which step is this?+        lift (put (i+1))+        desc1 <- descX x y+        desc2 <- descY x y+        xi <- (func updateX =<< (descX x y)) <%> x <%> y+        yi <- (func updateY =<< (descY x y)) <%> x <%> y+        xi `named` ("x"++(show i))+        yi `named` ("y"++(show i))+        xi <? varSym 'x' i+        yi <? varSym 'y' i+        render xi >> render yi+        euclideanAlgorithm xi yi++-- | updates the x-component+updateX :: Integer -> Integer -> Integer+updateX x y = if x > y then x-y else x++-- | updates the y-component+updateY :: Integer -> Integer -> Integer+updateY x y = if y > x then y-x else y++-- | transform the state component of 'euclideanAlgorithm' into something else+hoist :: Monad m => ProvenienceT alt (State Int) a -> ProvenienceT alt m a+hoist (StateT f) = StateT (return . flip evalState 1 . f)++-- * Pandoc helpers++#if MIN_VERSION_pandoc(2,8,0)+-- pandoc-types >= 1.20 has Str Text instead of Str String +str = Str.pack+#else+str = Str+#endif++-- | write the store as html5+writeDocumentation :: VariableStore alt -> FilePath -> IO ()+writeDocumentation store fpath = T.writeFile fpath html where+    depgraph = renderStore def store+    html = either (error.show) id $ +        runPure $ +        writeHtml5String myWriterOpts (makeDocument depgraph)++-- | embed the store rendering into a whole document+makeDocument :: Block -> Pandoc+makeDocument body = Pandoc nullMeta [Header 1 nullAttr [str "The Euclidean algorithm"],body]++myWriterOpts :: WriterOptions+myWriterOpts = def {+    writerTemplate = Just provenienceTemplate,+    writerVariables = [("title","The Euclidean algorithm"),("copyright","Lackmann Phymetric")]+    }++-- | Pandoc Template for Html output+provenienceTemplate :: String+provenienceTemplate = unlines [+    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"",+    "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">",+    "<html xmlns=\"http://www.w3.org/1999/xhtml\">",+    "<head>",+    "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\"/>",+    "<title>$title$</title>",+    "<meta name=\"copyright\" content=\"$copyright$\"/>",+    "<style type=\"text/css\">",+    "table {",+    "    border-collapse: collapse;",+    "}",+    "table, th, td {",+    "    border: 1px solid black;",+    "}",+    "div.variable{",+    "  margin-left: 40px;",+    "  border: 2px solid;",+    "  padding: 10px 40px;",+    "  width: 900px;",+    "  border-radius: 25px;",+    "}",+    "div.shortname{font-weight:bold; color:OliveDrab;}",+    "a.incoming {color:Tomato;}",+    "a.outgoing {color:DodgerBlue;}",+    "div.valueRendering {background-color:#ebebe0;}",+    "p.provenienceHeader {font-weight:bold;}",+    "div.provenienceKeyword {font-weight:bold;}",+    "</style>",+    "</head><body>",+    "$body$",+    "</body></html>"]++-- * Description generators ++-- perform some store lookups and return a 'Block'+type Description = forall m alt. Monad m => StateT (VariableStore alt) m Block++-- | helper function that renders Variable names with subscripts+varSym :: Char -> Int -> Block+varSym x i = Para [str [x],Subscript [str (show i)]]++-- | generates appropriate description of the new x value+descX :: Variable Integer -> Variable Integer -> Description +descX x y = do+    link_x <- linkto x+    link_y <- linkto y+    return $ Para $ if (value x) > (value y)+        then [+            str "The value of ",+            link_x,+            str " is larger than the value of ",+            link_y,+            str " therefore we compute ",+            link_x,+            str " minus ",+            link_y]+        else [+            str "The value of ",+            link_x,+            str " is not larger than the value of ",+            link_y,+            str " therefore the value remains the same."]++-- | generates appropriate description of the new y value+descY :: Variable Integer -> Variable Integer -> Description+descY x y = do+    link_x <- linkto x+    link_y <- linkto y+    return $ Para $ if (value y) > (value x)+        then [+            str "The value of ",+            link_y,+            str " is larger than the value of ",+            link_x,+            str " therefore we compute ",+            link_y,+            str " minus ",+            link_x]+        else [+            str "The value of ",+            link_y,+            str " is not larger than the value of ",+            link_x,+            str " therefore the value remains the same."]++-- | explain that this is the final result+desc_result :: Variable Integer -> Variable Integer -> Description+desc_result x y = do +    link_x <- linkto x+    link_y <- linkto y+    return $ Para [+        str "The values of ",+        link_x,+        str " and ",+        link_y,+        str " are equal, the algorithm terminates."]

provenience.cabal view

@@ -1,5 +1,5 @@ name:                provenience-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Computations that automatically track data dependencies description:         see README.md license:             GPL-3@@ -32,3 +32,19 @@                      , text >= 1.2.2.2 && <= 1.2.3.1   default-language:    Haskell2010   other-extensions:  CPP++Flag example+  description: Build an example executable that generates html documentation of the Euclidean algorithm+  default:     False++executable provenienceExample+  main-is:          example/euclidean.hs+  default-language: Haskell2010+  if !(flag(example))+       buildable:   False+  build-depends:   base >= 4.7 && < 5+                 , provenience+                 , mtl >= 2.2.1 && <= 2.2.2+                 , pandoc >= 1.16 && <= 2.7.3+                 , text >= 1.2.2.2 && <= 1.2.3.1+                 , data-default >= 0.5.3 && < 0.8

src/Control/Provenience.hs view

@@ -60,7 +60,7 @@ {-# LANGUAGE CPP,MultiParamTypeClasses,FlexibleInstances,FlexibleContexts,OverloadedStrings,Rank2Types,ScopedTypeVariables #-}
 module Control.Provenience (
     -- * Variables
-     Variable(..)
+     Variable,value
     ,VariableStore
     ,var
     ,varM