{-# 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 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)) 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] #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 [ "", "", "
", "", "