{-# LANGUAGE Rank2Types, OverloadedStrings, 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 (Text,pack)
import Data.Default
import Data.Functor.Identity (runIdentity)
#if MIN_VERSION_pandoc(2,8,0)
import qualified Data.Map.Strict
import Text.DocTemplates (Context,ToContext(..))
#endif
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 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))
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 > 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]
#if MIN_VERSION_pandoc(2,8,0)
myWriterOpts :: WriterOptions
myWriterOpts = def {
writerTemplate = either error Just $ runIdentity (compileTemplate "" (pack provenienceTemplate)),
writerVariables = toContext (Data.Map.Strict.fromList [
("title" :: Text,"The Euclidean algorithm" :: Text),
("copyright" :: Text,"Lackmann Phymetric")]) :: Context Text
}
#else
myWriterOpts :: WriterOptions
myWriterOpts = def {
writerTemplate = Just provenienceTemplate,
writerVariables = [("title","The Euclidean algorithm" :: Text),("copyright","Lackmann Phymetric" :: Text)]
}
#endif
-- | Pandoc Template for Html output
provenienceTemplate :: String
provenienceTemplate = unlines [
"",
"",
"",
"",
"$title$",
"",
"",
"",
"$body$",
""]
-- * 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."]