r
/
bookshelf-doc
mirror of https://github.com/jrpotter/bookshelf-doc
1
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix: mess of monad transformers in LeanInk adapter

main
Henrik Böving 2022-07-27 20:11:41 +02:00
parent 0ac64f0873
commit 5bae061b54
3 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DocGen4/LeanInk/Output.lean
View File

@ -209,7 +209,7 @@ def annotationsToFragments (as : List Annotation.Annotation) : AnalysisM (List F
-- TODO: rework monad mess -- TODO: rework monad mess
def renderAnnotations (as : List Annotation.Annotation) : HtmlT AnalysisM Html := do def renderAnnotations (as : List Annotation.Annotation) : HtmlT AnalysisM Html := do
let fs ← annotationsToFragments as let fs ← annotationsToFragments as
let (html, _) := fs.mapM Fragment.toHtml >>= (baseHtml ∘ List.toArray) |>.run { counter := 0 } |>.run (←readThe SiteContext) (←readThe SiteBaseContext) let (html, _) ← fs.mapM Fragment.toHtml >>= (baseHtml ∘ List.toArray) |>.run { counter := 0 }
pure html pure html
end LeanInk.Annotation.Alectryon end LeanInk.Annotation.Alectryon

8
DocGen4/LeanInk/Process.lean
View File

@ -13,10 +13,10 @@ namespace DocGen4.Process.LeanInk
open Lean open Lean
open DocGen4.Output open DocGen4.Output
-- TODO: rework monad mess
def docGenOutput (as : List LeanInk.Annotation.Annotation) : HtmlT LeanInk.AnalysisM UInt32 := do def docGenOutput (as : List LeanInk.Annotation.Annotation) : HtmlT LeanInk.AnalysisM UInt32 := do
let some modName := getCurrentName |>.run (←readThe SiteBaseContext) | unreachable! let some modName ← getCurrentName | unreachable!
let srcHtml ← LeanInk.Annotation.Alectryon.renderAnnotations as |>.run (←readThe SiteContext) (←readThe SiteBaseContext) let srcHtml ← LeanInk.Annotation.Alectryon.renderAnnotations as
let srcDir := moduleNameToDirectory srcBasePath modName let srcDir := moduleNameToDirectory srcBasePath modName
let srcPath := moduleNameToFile srcBasePath modName let srcPath := moduleNameToFile srcBasePath modName
IO.FS.createDirAll srcDir IO.FS.createDirAll srcDir
@ -26,7 +26,7 @@ def docGenOutput (as : List LeanInk.Annotation.Annotation) : HtmlT LeanInk.Analy
def execAuxM : HtmlT LeanInk.AnalysisM UInt32 := do def execAuxM : HtmlT LeanInk.AnalysisM UInt32 := do
let ctx ← readThe SiteContext let ctx ← readThe SiteContext
let baseCtx ← readThe SiteBaseContext let baseCtx ← readThe SiteBaseContext
let outputFn := (λ as => docGenOutput as |>.run ctx baseCtx) let outputFn := (docGenOutput · |>.run ctx baseCtx)
return ← LeanInk.Analysis.runAnalysis { return ← LeanInk.Analysis.runAnalysis {
name := "doc-gen4" name := "doc-gen4"
genOutput := outputFn genOutput := outputFn

6
DocGen4/Output/Base.lean
View File

@ -66,6 +66,12 @@ def HtmlT.run (x : HtmlT m α) (ctx : SiteContext) (baseCtx : SiteBaseContext) :
def HtmlM.run (x : HtmlM α) (ctx : SiteContext) (baseCtx : SiteBaseContext) : α := def HtmlM.run (x : HtmlM α) (ctx : SiteContext) (baseCtx : SiteBaseContext) : α :=
ReaderT.run x ctx |>.run baseCtx |>.run ReaderT.run x ctx |>.run baseCtx |>.run
instance [Monad m] : MonadLift HtmlM (HtmlT m) where
monadLift x := do pure <| x.run (←readThe SiteContext) (←readThe SiteBaseContext)
instance [Monad m] : MonadLift BaseHtmlM (BaseHtmlT m) where
monadLift x := do pure <| x.run (←readThe SiteBaseContext)
/-- /--
Obtains the root URL as a relative one to the current depth. Obtains the root URL as a relative one to the current depth.
-/ -/